Mercurial > hg > xemacs-beta
annotate lisp/next-error.el @ 5652:cc6f0266bc36
Avoid #'delq in core Lisp, for the sake of style, a very slightly smaller binary
lisp/ChangeLog addition:
2012-05-01 Aidan Kehoe <kehoea@parhasard.net>
Avoid #'delq in core code, for the sake of style and a (very
slightly) smaller binary.
* behavior.el (disable-behavior):
* behavior.el (compute-behavior-group-children):
* buff-menu.el (buffers-tab-items):
* byte-optimize.el (byte-optimize-delay-constants-math):
* byte-optimize.el (byte-optimize-logmumble):
* byte-optimize.el (byte-decompile-bytecode-1):
* byte-optimize.el (byte-optimize-lapcode):
* bytecomp.el:
* bytecomp.el (byte-compile-arglist-warn):
* bytecomp.el (byte-compile-warn-about-unresolved-functions):
* bytecomp.el (byte-compile-lambda):
* bytecomp.el (byte-compile-out-toplevel):
* bytecomp.el (byte-compile-insert):
* bytecomp.el (byte-compile-defalias-warn):
* cl-macs.el (cl-upcase-arg):
* cl-macs.el (cl-transform-lambda):
* cl-macs.el (cl-do-proclaim):
* cl-macs.el (defstruct):
* cl-macs.el (cl-make-type-test):
* cl-macs.el (define-compiler-macro):
* cl-macs.el (delete-duplicates):
* cus-edit.el (widget-face-value-delete):
* cus-edit.el (face-history):
* easymenu.el (easy-menu-remove):
* files.el (files-fetch-hook-value):
* files.el (file-expand-wildcards):
* font-lock.el (font-lock-update-removed-keyword-alist):
* font-lock.el (font-lock-remove-keywords):
* frame.el (frame-initialize):
* frame.el (frame-notice-user-settings):
* frame.el (set-frame-font):
* frame.el (delete-other-frames):
* frame.el (get-frame-for-buffer-noselect):
* gnuserv.el (gnuserv-kill-buffer-function):
* gnuserv.el (gnuserv-check-device):
* gnuserv.el (gnuserv-kill-client):
* gnuserv.el (gnuserv-buffer-done-1):
* gtk-font-menu.el (gtk-reset-device-font-menus):
* gutter-items.el (buffers-tab-items):
* gutter.el (set-gutter-element-visible-p):
* info.el (Info-find-file-node):
* info.el (Info-history-add):
* info.el (Info-build-annotation-completions):
* info.el (Info-index):
* info.el (Info-reannotate-node):
* itimer.el (delete-itimer):
* itimer.el (start-itimer):
* lib-complete.el (lib-complete:cache-completions):
* loadhist.el (unload-feature):
* menubar-items.el (build-buffers-menu-internal):
* menubar.el (delete-menu-item):
* menubar.el (relabel-menu-item):
* msw-font-menu.el (mswindows-reset-device-font-menus):
* mule/make-coding-system.el (fixed-width-generate-helper):
* next-error.el (next-error-find-buffer):
* obsolete.el:
* obsolete.el (find-non-ascii-charset-string):
* obsolete.el (find-non-ascii-charset-region):
* occur.el (multi-occur-by-filename-regexp):
* occur.el (occur-1):
* packages.el (packages-package-hierarchy-directory-names):
* packages.el (package-get-key-1):
* process.el (setenv):
* simple.el (undo):
* simple.el (handle-pre-motion-command-current-command-is-motion):
* sound.el (load-sound-file):
* wid-edit.el (widget-field-value-delete):
* wid-edit.el (widget-checklist-match-inline):
* wid-edit.el (widget-checklist-match-find):
* wid-edit.el (widget-editable-list-delete-at):
* wid-edit.el (widget-editable-list-entry-create):
* window.el (quit-window):
* x-font-menu.el (x-reset-device-font-menus-core):
1. Replace (delq nil (mapcar ....)) with analogous (mapcan ...)
forms; this is in non-dumped files, it was done previously in
dumped files.
2. Replace (delq FOO (copy-sequence BAR)) with (remove* FOO BAR),
where #'eq and #'eql are equivalent
3. Replace (delq FOO BAR) with (delete* FOO BAR), where FOO is not
a non-fixnum number. Saves a little space in the dumped file
(since the compiler macro adds :test #'eq to the delete* call if
it's not clear that FOO is not a non-fixnum number).
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Tue, 01 May 2012 16:17:42 +0100 |
| parents | 308d34e9f07d |
| 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) |