Mercurial > hg > xemacs-beta
annotate lisp/next-error.el @ 5905:85fd1ab80057
Fix a bug in #'parse-integer with negative bignums and non-nil JUNK-ALLOWED
src/ChangeLog addition:
2015-05-08 Aidan Kehoe <kehoea@parhasard.net>
* data.c (parse_integer):
Fix a bug here with the interaction of negative bignums and a
non-zero JUNK-ALLOWED argument.
tests/ChangeLog addition:
2015-05-08 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Check for a bug just fixed with the interaction of negative
bignums and :junk-allowed non-nil.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Fri, 08 May 2015 16:24:57 +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) |