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