PageRenderTime 55ms CodeModel.GetById 25ms RepoModel.GetById 1ms app.codeStats 0ms

/lisp/next-error.el

https://bitbucket.org/kehoea/unicode-internal
Emacs Lisp | 285 lines | 206 code | 42 blank | 37 comment | 17 complexity | 37d0f366b61356b6ba84879e757948dc MD5 | raw file
Possible License(s): GPL-3.0, BSD-3-Clause
  1. ;;; next-error.el --- Next error support framework
  2. ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
  3. ;; 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
  4. ;; Maintainer: XEmacs Development Team
  5. ;; Keywords: internal
  6. ;; This file is part of XEmacs.
  7. ;; XEmacs is free software: you can redistribute it and/or modify it
  8. ;; under the terms of the GNU General Public License as published by the
  9. ;; Free Software Foundation, either version 3 of the License, or (at your
  10. ;; option) any later version.
  11. ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12. ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
  14. ;; for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>.
  17. ;;; Synched up with: FSF 22.0.50.1 (CVS)
  18. ;;; Some functions renamed with the next-error-framework prefix to avoid
  19. ;;; clashes with the next-error code in compile.el. One day compile.el
  20. ;;; will use this framework.
  21. (defgroup next-error nil
  22. "`next-error' support framework."
  23. :group 'compilation
  24. :version "22.1")
  25. (defface next-error
  26. '((t (:inherit region)))
  27. "Face used to highlight next error locus."
  28. :group 'next-error
  29. :version "22.1")
  30. (defcustom next-error-highlight 0.1
  31. "*Highlighting of locations in selected source buffers.
  32. If number, highlight the locus in `next-error' face for given time in seconds.
  33. If t, use persistent overlays fontified in `next-error' face.
  34. If nil, don't highlight the locus in the source buffer.
  35. If `fringe-arrow', indicate the locus by the fringe arrow."
  36. :type '(choice (number :tag "Delay")
  37. (const :tag "Persistent overlay" t)
  38. (const :tag "No highlighting" nil)
  39. (const :tag "Fringe arrow" 'fringe-arrow))
  40. :group 'next-error
  41. :version "22.1")
  42. (defcustom next-error-highlight-no-select 0.1
  43. "*Highlighting of locations in non-selected source buffers.
  44. If number, highlight the locus in `next-error' face for given time in seconds.
  45. If t, use persistent overlays fontified in `next-error' face.
  46. If nil, don't highlight the locus in the source buffer.
  47. If `fringe-arrow', indicate the locus by the fringe arrow."
  48. :type '(choice (number :tag "Delay")
  49. (const :tag "Persistent overlay" t)
  50. (const :tag "No highlighting" nil)
  51. (const :tag "Fringe arrow" 'fringe-arrow))
  52. :group 'next-error
  53. :version "22.1")
  54. (defcustom next-error-hook nil
  55. "*List of hook functions run by `next-error' after visiting source file."
  56. :type 'hook
  57. :group 'next-error)
  58. (defvar next-error-highlight-timer nil)
  59. ;(defvar next-error-overlay-arrow-position nil)
  60. ;(put 'next-error-overlay-arrow-position 'overlay-arrow-string "=>")
  61. ;(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)
  62. (defvar next-error-last-buffer nil
  63. "The most recent `next-error' buffer.
  64. A buffer becomes most recent when its compilation, grep, or
  65. similar mode is started, or when it is used with \\[next-error]
  66. or \\[compile-goto-error].")
  67. (defvar next-error-function nil
  68. "Function to use to find the next error in the current buffer.
  69. The function is called with 2 parameters:
  70. ARG is an integer specifying by how many errors to move.
  71. RESET is a boolean which, if non-nil, says to go back to the beginning
  72. of the errors before moving.
  73. Major modes providing compile-like functionality should set this variable
  74. to indicate to `next-error' that this is a candidate buffer and how
  75. to navigate in it.")
  76. (make-variable-buffer-local 'next-error-function)
  77. (defsubst next-error-buffer-p (buffer
  78. &optional avoid-current
  79. extra-test-inclusive
  80. extra-test-exclusive)
  81. "Test if BUFFER is a `next-error' capable buffer.
  82. If AVOID-CURRENT is non-nil, treat the current buffer
  83. as an absolute last resort only.
  84. The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
  85. that normally would not qualify. If it returns t, the buffer
  86. in question is treated as usable.
  87. The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer
  88. that would normally be considered usable. If it returns nil,
  89. that buffer is rejected."
  90. (and (buffer-name buffer) ;First make sure it's live.
  91. (not (and avoid-current (eq buffer (current-buffer))))
  92. (with-current-buffer buffer
  93. (if next-error-function ; This is the normal test.
  94. ;; Optionally reject some buffers.
  95. (if extra-test-exclusive
  96. (funcall extra-test-exclusive)
  97. t)
  98. ;; Optionally accept some other buffers.
  99. (and extra-test-inclusive
  100. (funcall extra-test-inclusive))))))
  101. (defun next-error-find-buffer (&optional avoid-current
  102. extra-test-inclusive
  103. extra-test-exclusive)
  104. "Return a `next-error' capable buffer.
  105. If AVOID-CURRENT is non-nil, treat the current buffer
  106. as an absolute last resort only.
  107. The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
  108. that normally would not qualify. If it returns t, the buffer
  109. in question is treated as usable.
  110. The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer
  111. that would normally be considered usable. If it returns nil,
  112. that buffer is rejected."
  113. (or
  114. ;; 1. If one window on the selected frame displays such buffer, return it.
  115. (let ((window-buffers
  116. (delete-duplicates
  117. (mapcan #'(lambda (w)
  118. (if (next-error-buffer-p
  119. (window-buffer w)
  120. avoid-current
  121. extra-test-inclusive extra-test-exclusive)
  122. (list (window-buffer w))))
  123. (window-list)))))
  124. (if (eq (length window-buffers) 1)
  125. (car window-buffers)))
  126. ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
  127. (if (and next-error-last-buffer
  128. (next-error-buffer-p next-error-last-buffer avoid-current
  129. extra-test-inclusive extra-test-exclusive))
  130. next-error-last-buffer)
  131. ;; 3. If the current buffer is acceptable, choose it.
  132. (if (next-error-buffer-p (current-buffer) avoid-current
  133. extra-test-inclusive extra-test-exclusive)
  134. (current-buffer))
  135. ;; 4. Look for any acceptable buffer.
  136. (let ((buffers (buffer-list)))
  137. (while (and buffers
  138. (not (next-error-buffer-p
  139. (car buffers) avoid-current
  140. extra-test-inclusive extra-test-exclusive)))
  141. (setq buffers (cdr buffers)))
  142. (car buffers))
  143. ;; 5. Use the current buffer as a last resort if it qualifies,
  144. ;; even despite AVOID-CURRENT.
  145. (and avoid-current
  146. (next-error-buffer-p (current-buffer) nil
  147. extra-test-inclusive extra-test-exclusive)
  148. (progn
  149. (message "This is the only next-error capable buffer")
  150. (current-buffer)))
  151. ;; 6. Give up.
  152. (error "No next-error capable buffer found")))
  153. ;;;###autoload
  154. (defun next-error-framework-next-error (&optional arg reset)
  155. "Visit next `next-error-framework-next-error' message and corresponding source code.
  156. If all the error messages parsed so far have been processed already,
  157. the message buffer is checked for new ones.
  158. A prefix ARG specifies how many error messages to move;
  159. negative means move back to previous error messages.
  160. Just \\[universal-argument] as a prefix means reparse the error message buffer
  161. and start at the first error.
  162. The RESET argument specifies that we should restart from the beginning.
  163. \\[next-error-framework-next-error] normally uses the most recently started
  164. compilation, grep, or occur buffer. It can also operate on any
  165. buffer with output from the \\[compile], \\[grep] commands, or,
  166. more generally, on any buffer in Compilation mode or with
  167. Compilation Minor mode enabled, or any buffer in which
  168. `next-error-function' is bound to an appropriate function.
  169. To specify use of a particular buffer for error messages, type
  170. \\[next-error-framework-next-error] in that buffer when it is the only one displayed
  171. in the current frame.
  172. Once \\[next-error-framework-next-error] has chosen the buffer for error messages, it
  173. runs `next-error-hook' with `run-hooks', and stays with that buffer
  174. until you use it in some other buffer which uses Compilation mode
  175. or Compilation Minor mode.
  176. See variables `compilation-parse-errors-function' and
  177. \`compilation-error-regexp-alist' for customization ideas."
  178. (interactive "P")
  179. (if (consp arg) (setq reset t arg nil))
  180. (when (setq next-error-last-buffer (next-error-find-buffer))
  181. ;; we know here that next-error-function is a valid symbol we can funcall
  182. (with-current-buffer next-error-last-buffer
  183. (funcall next-error-function (prefix-numeric-value arg) reset)
  184. (run-hooks 'next-error-hook))))
  185. (defalias 'goto-next-locus 'next-error-framework-next-error)
  186. (defalias 'next-match 'next-error-framework-next-error)
  187. (defun next-error-framework-previous-error (&optional n)
  188. "Visit previous `next-error-framework-next-error' message and corresponding source code.
  189. Prefix arg N says how many error messages to move backwards (or
  190. forwards, if negative).
  191. This operates on the output from the \\[compile] and \\[grep] commands."
  192. (interactive "p")
  193. (next-error-framework-next-error (- (or n 1))))
  194. (defun next-error-framework-first-error (&optional n)
  195. "Restart at the first error.
  196. Visit corresponding source code.
  197. With prefix arg N, visit the source code of the Nth error.
  198. This operates on the output from the \\[compile] command, for instance."
  199. (interactive "p")
  200. (next-error-framework-next-error n t))
  201. (defun next-error-no-select (&optional n)
  202. "Move point to the next error in the `next-error' buffer and highlight match.
  203. Prefix arg N says how many error messages to move forwards (or
  204. backwards, if negative).
  205. Finds and highlights the source line like \\[next-error], but does not
  206. select the source buffer."
  207. (interactive "p")
  208. (let ((next-error-highlight next-error-highlight-no-select))
  209. (next-error-framework-next-error n))
  210. (pop-to-buffer next-error-last-buffer))
  211. (defun previous-error-no-select (&optional n)
  212. "Move point to the previous error in the `next-error' buffer and highlight match.
  213. Prefix arg N says how many error messages to move backwards (or
  214. forwards, if negative).
  215. Finds and highlights the source line like \\[previous-error], but does not
  216. select the source buffer."
  217. (interactive "p")
  218. (next-error-no-select (- (or n 1))))
  219. ;;; Internal variable for `next-error-follow-mode-post-command-hook'.
  220. (defvar next-error-follow-last-line nil)
  221. (define-minor-mode next-error-follow-minor-mode
  222. "Minor mode for compilation, occur and diff modes.
  223. When turned on, cursor motion in the compilation, grep, occur or diff
  224. buffer causes automatic display of the corresponding source code
  225. location."
  226. :group 'next-error :init-value nil :lighter " Fol"
  227. (if (not next-error-follow-minor-mode)
  228. (remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t)
  229. (add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t)
  230. (make-local-variable 'next-error-follow-last-line)))
  231. ;;; Used as a `post-command-hook' by `next-error-follow-mode'
  232. ;;; for the *Compilation* *grep* and *Occur* buffers.
  233. (defvar compilation-current-error)
  234. (defvar compilation-context-lines)
  235. (defun next-error-follow-mode-post-command-hook ()
  236. (unless (equal next-error-follow-last-line (line-number-at-pos))
  237. (setq next-error-follow-last-line (line-number-at-pos))
  238. (condition-case nil
  239. (let ((compilation-context-lines nil))
  240. (setq compilation-current-error (point))
  241. (next-error-no-select 0))
  242. (error t))))
  243. (provide 'next-error)