From 71873e2b335b721e0b3c585e88211c9564f4c743 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 4 May 2012 19:16:47 -0400 Subject: [PATCH] Add new error and function `user-error'. * lisp/subr.el (user-error): New function. * lisp/window.el (switch-to-buffer): * lisp/vc/smerge-mode.el (smerge-resolve-function, smerge-resolve) (smerge-match-conflict): * lisp/simple.el (previous-matching-history-element) (next-matching-history-element, goto-history-element, undo-more) (undo-start): * lisp/progmodes/etags.el (visit-tags-table-buffer, find-tag-tag) (find-tag-noselect, find-tag-in-order, etags-goto-tag-location) (next-file, tags-loop-scan, list-tags, complete-tag): * lisp/progmodes/compile.el (compilation-loop): * lisp/mouse.el (mouse-minibuffer-check): * lisp/man.el (Man-bgproc-sentinel, Man-goto-page): * lisp/info.el (Info-find-node-2, Info-extract-pointer, Info-history-back) (Info-history-forward, Info-follow-reference, Info-menu) (Info-extract-menu-item, Info-extract-menu-counting) (Info-forward-node, Info-backward-node, Info-next-menu-item) (Info-last-menu-item, Info-next-preorder, Info-last-preorder) (Info-next-reference, Info-prev-reference, Info-index) (Info-index-next, Info-follow-nearest-node) (Info-copy-current-node-name): * lisp/imenu.el (imenu--make-index-alist) (imenu-default-create-index-function, imenu-add-to-menubar): * lisp/files.el (basic-save-buffer, recover-file): * lisp/emacs-lisp/easy-mmode.el (easy-mmode-define-navigation): * lisp/emacs-lisp/checkdoc.el (checkdoc-continue, checkdoc-comments) (checkdoc-message-text, checkdoc-defun): * lisp/dabbrev.el (dabbrev-completion, dabbrev--abbrev-at-point): * lisp/cus-edit.el (customize-changed-options, customize-rogue) (customize-saved, custom-variable-set, custom-variable-mark-to-save) (custom-variable-mark-to-reset-standard) (custom-variable-reset-backup, custom-face-mark-to-reset-standard) (custom-file): * lisp/completion.el (check-completion-length): * lisp/comint.el (comint-search-arg) (comint-previous-matching-input-string-position) (comint-previous-matching-input) (comint-replace-by-expanded-history-before-point, comint-send-input) (comint-copy-old-input, comint-backward-matching-input) (comint-goto-process-mark, comint-set-process-mark): * lisp/calendar/calendar.el (calendar-cursor-to-date): Use it. * lisp/bindings.el (debug-ignored-errors): Remove regexps, add `user-error'. * src/data.c (PUT_ERROR): New macro. (syms_of_data): Use it. Add new error type `user-error'. * src/undo.c (user_error): New function. (Fprimitive_undo): Use it. * src/print.c (print_error_message): Adjust print style for `user-error'. * src/keyboard.c (user_error): New function. (Fexit_recursive_edit, Fabort_recursive_edit): Use it. --- doc/emacs/ChangeLog | 90 +++++++++---------- etc/NEWS | 1 + lisp/ChangeLog | 45 ++++++++++ lisp/bindings.el | 19 +--- lisp/calendar/calendar.el | 4 +- lisp/comint.el | 28 +++--- lisp/completion.el | 8 +- lisp/cus-edit.el | 35 +++----- lisp/dabbrev.el | 17 ++-- lisp/emacs-lisp/checkdoc.el | 33 +++---- lisp/emacs-lisp/easy-mmode.el | 6 +- lisp/files.el | 4 +- lisp/imenu.el | 14 +-- lisp/info.el | 74 ++++++--------- lisp/man.el | 9 +- lisp/mouse.el | 2 +- lisp/progmodes/compile.el | 7 +- lisp/progmodes/etags.el | 56 +++++------- lisp/simple.el | 28 +++--- lisp/subr.el | 11 +++ lisp/vc/smerge-mode.el | 9 +- lisp/window.el | 4 +- src/ChangeLog | 14 ++- src/data.c | 164 ++++++++++------------------------ src/fileio.c | 10 +-- src/keyboard.c | 10 ++- src/lisp.h | 2 +- src/print.c | 40 +++++---- src/undo.c | 15 +++- 29 files changed, 335 insertions(+), 424 deletions(-) diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index a2bae546f1..a6d9ea6a8b 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -438,7 +438,7 @@ 2012-01-09 Chong Yidong - * custom.texi (Custom Themes): Switched custom-safe-themes to use + * custom.texi (Custom Themes): Switch custom-safe-themes to use SHA-256. 2012-01-07 Chong Yidong @@ -455,8 +455,8 @@ (Screen Garbled): Don't refer to terminal "manufacturers". (Total Frustration): Node deleted. Eliza is documented in Amusements now. - (Known Problems): More info about using the bug tracker. Mention - debbugs package. + (Known Problems): More info about using the bug tracker. + Mention debbugs package. (Bug Criteria): Copyedits. (Understanding Bug Reporting): Mention emacs -Q. @@ -519,8 +519,8 @@ Document browse-url-mailto-function. (Goto Address mode): Add index entries. Add xref to Browse-URL. (FFAP): FFAP is not a minor mode. - (Amusements): M-x lm was renamed to M-x landmark. Document - nato-region. + (Amusements): M-x lm was renamed to M-x landmark. + Document nato-region. 2012-01-01 Chong Yidong @@ -558,8 +558,8 @@ 2011-12-26 Chong Yidong - * dired.texi (Dired Enter, Misc Dired Features): Document - dired-use-ls-dired changes. Mention quit-window. + * dired.texi (Dired Enter, Misc Dired Features): + Document dired-use-ls-dired changes. Mention quit-window. (Dired Navigation): Add index entries. (Dired Visiting): Fix View Mode xref. (Marks vs Flags): Prefer C-/ binding for undo. @@ -602,8 +602,8 @@ * vc1-xtra.texi (Version Headers): Note that these are for Subversion, CVS, etc. only. - (General VC Options): De-document vc-keep-workfiles. Fix - RCS-isms. + (General VC Options): De-document vc-keep-workfiles. + Fix RCS-isms. 2011-12-22 Eli Zaretskii @@ -619,8 +619,8 @@ * vc1-xtra.texi (Remote Repositories): Update introduction. (Local Version Control): Node deleted (obsolete with DVCSes). - (Remote Repositories, Version Backups): Node deleted. Move - documentation of vc-cvs-stay-local to CVS Options. + (Remote Repositories, Version Backups): Node deleted. + Move documentation of vc-cvs-stay-local to CVS Options. (CVS Options): Reduce verbosity of description of obscure CVS locking feature. (Making Revision Tags, Revision Tag Caveats): Merge into Revision @@ -673,11 +673,11 @@ less CVS-specific. (VC With A Merging VCS, VC With A Locking VCS): Add xref to Registering node. - (Secondary VC Commands): Deleted. Promote subnodes. + (Secondary VC Commands): Delete. Promote subnodes. (Log Buffer): Add command name for C-c C-c. Fix the name of the log buffer. Add index entries. - (VCS Changesets, Types of Log File, VC With A Merging VCS): Use - "commit" terminology. + (VCS Changesets, Types of Log File, VC With A Merging VCS): + Use "commit" terminology. (Old Revisions): Move it to just before VC Change Log. "Tag" here doesn't refer to tags tables. Note other possible forms of the revision ID. C-x v = does not save. @@ -702,8 +702,8 @@ (Lisp Eval): Note that listed commands are available globally. Explain the meaning of "defun" in the C-M-x context. (Lisp Interaction): Copyedits. - (External Lisp): Fix name of inferior Lisp buffer. Mention - Scheme. + (External Lisp): Fix name of inferior Lisp buffer. + Mention Scheme. (Compilation): Define "inferior process". 2011-12-10 Eli Zaretskii @@ -718,8 +718,8 @@ (Compilation Mode): Add xref for grep, occur, and mouse references. Define "locus". (Grep Searching): Use @command. - (Debuggers, Commands of GUD, GDB Graphical Interface): Clarify - intro. + (Debuggers, Commands of GUD, GDB Graphical Interface): + Clarify intro. (Starting GUD): Clarify how arguments are specified. (Debugger Operation): Index entry for "GUD interaction buffer", and move basic description here from Commands of GUD node. @@ -727,8 +727,8 @@ (Source Buffers): Remove gdb-find-source-frame, which is not in gdb-mi.el. (Other GDB Buffers): Remove gdb-use-separate-io-buffer and - toggle-gdb-all-registers, which are not in gdb-mi.el. Don't - re-document GUD interaction buffers. + toggle-gdb-all-registers, which are not in gdb-mi.el. + Don't re-document GUD interaction buffers. * programs.texi (Symbol Completion): M-TAB can now use Semantic. (Semantic): Add cindex entries for Semantic. @@ -758,8 +758,8 @@ * programs.texi (Program Modes): Mention modes that are not included with Emacs. Fix references to other manuals for tex. - Add index entry for backward-delete-char-untabify. Mention - prog-mode-hook. + Add index entry for backward-delete-char-untabify. + Mention prog-mode-hook. (Which Function): Use "global minor mode" terminology. (Basic Indent, Multi-line Indent): Refer to previous descriptions in Indentation chapter to avoid duplication. @@ -791,12 +791,12 @@ (TeX Editing): Add xref to documentation for Occur. (LaTeX Editing): Add xref to Completion node. (TeX Print): Fix description of tex-directory. - (Enriched Text): Renamed from Formatted Text. Make this node and + (Enriched Text): Rename from Formatted Text. Make this node and its subnodes less verbose, since text/enriched files are practically unused. - (Enriched Mode): Renamed from Requesting Formatted Text. + (Enriched Mode): Rename from Requesting Formatted Text. (Format Colors): Node deleted. - (Enriched Faces): Renamed from Format Faces. Describe commands + (Enriched Faces): Rename from Format Faces. Describe commands for applying colors too. (Forcing Enriched Mode): Node deleted; merged into Enriched Mode. @@ -1031,12 +1031,12 @@ 2011-10-18 Chong Yidong * display.texi (Faces): Simplify discussion. Move documentation - of list-faces-display here, from Standard Faces node. Note - special role of `default' background. - (Standard Faces): Note special role of `default' background. Note - that region face may be taken fom GTK. Add xref to Text Display. - (Text Scale): Rename from "Temporary Face Changes". Callers - changed. Don't bother documenting variable-pitch-mode. + of list-faces-display here, from Standard Faces node. + Note special role of `default' background. + (Standard Faces): Note special role of `default' background. + Note that region face may be taken fom GTK. Add xref to Text Display. + (Text Scale): Rename from "Temporary Face Changes". + Callers changed. Don't bother documenting variable-pitch-mode. (Font Lock): Copyedits. Remove font-lock-maximum-size. (Useless Whitespace): Simplify description of delete-trailing-whitespace. Note active region case. @@ -1058,8 +1058,8 @@ 2011-10-13 Chong Yidong - * killing.texi (Deletion): Add xref to Using Region. Document - delete-forward-char. + * killing.texi (Deletion): Add xref to Using Region. + Document delete-forward-char. (Yanking): Move yank-excluded-properties to Lisp manual. Move C-y description here. Recommend C-u C-SPC for jumping to mark. (Kill Ring): Move kill ring variable documentation here. @@ -1079,10 +1079,10 @@ selection changes. Mention that commands like C-y set the mark. (Marking Objects): Add xref to Words node. Note that mark-word and mark-sexp also have the "extend region" behavior. - (Using Region): Mention M-$ in the table. Document - mark-even-if-inactive here instead of in Mark Ring. - (Mark Ring): Move mark-even-if-inactive to Using Region. Take - note of the "Mark Set" behavior. + (Using Region): Mention M-$ in the table. + Document mark-even-if-inactive here instead of in Mark Ring. + (Mark Ring): Move mark-even-if-inactive to Using Region. + Take note of the "Mark Set" behavior. (Disabled Transient Mark): Rename from "Persistent Mark" (Bug#9688). Callers changed. @@ -1097,8 +1097,8 @@ (Name Help): Remove an over-long joke. (Apropos): Document prefix args. Remove duplicated descriptions. (Help Mode): Add C-c C-b to table. Update TAB binding. - (Package Keywords): Rename from "Library by Keyword". Describe - new package menu interface. + (Package Keywords): Rename from "Library by Keyword". + Describe new package menu interface. (Help Files, Help Echo): Tweak description. * mini.texi (Completion Options): Add completion-cycle-threshold. @@ -1110,8 +1110,8 @@ 2011-10-08 Chong Yidong - * basic.texi (Position Info): Omit page commands. Document - count-words-region and count-words. + * basic.texi (Position Info): Omit page commands. + Document count-words-region and count-words. * text.texi (Pages): Move what-page documentation here. @@ -1134,8 +1134,8 @@ 2011-10-07 Chong Yidong - * basic.texi (Inserting Text): Add xref to Completion. Add - ucs-insert example, and document prefix argument. + * basic.texi (Inserting Text): Add xref to Completion. + Add ucs-insert example, and document prefix argument. (Moving Point): Fix introduction; C-f/C-b are no longer equivalent to left/right. Tweak left-char and right-char descriptions. M-left and M-right are now bound to left-word/right-word. @@ -1539,8 +1539,8 @@ 2011-04-24 Chong Yidong - * maintaining.texi (List Tags): Document next-file. Suggested by - Uday S Reddy. + * maintaining.texi (List Tags): Document next-file. + Suggested by Uday S Reddy. 2011-04-23 Juanma Barranquero diff --git a/etc/NEWS b/etc/NEWS index 71e6bce9b7..ca9b018a2f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -199,6 +199,7 @@ still be supported for Emacs 24.x. * Lisp changes in Emacs 24.2 +** New error type and new function `user-error'. Doesn't trigger the debugger. ** Completion *** New function `completion-table-with-quoting' to handle completion diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0c5c205075..5c38eb86fa 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,48 @@ +2012-05-04 Stefan Monnier + + * subr.el (user-error): New function. + * window.el (switch-to-buffer): + * vc/smerge-mode.el (smerge-resolve-function, smerge-resolve) + (smerge-match-conflict): + * simple.el (previous-matching-history-element) + (next-matching-history-element, goto-history-element, undo-more) + (undo-start): + * progmodes/etags.el (visit-tags-table-buffer, find-tag-tag) + (find-tag-noselect, find-tag-in-order, etags-goto-tag-location) + (next-file, tags-loop-scan, list-tags, complete-tag): + * progmodes/compile.el (compilation-loop): + * mouse.el (mouse-minibuffer-check): + * man.el (Man-bgproc-sentinel, Man-goto-page): + * info.el (Info-find-node-2, Info-extract-pointer, Info-history-back) + (Info-history-forward, Info-follow-reference, Info-menu) + (Info-extract-menu-item, Info-extract-menu-counting) + (Info-forward-node, Info-backward-node, Info-next-menu-item) + (Info-last-menu-item, Info-next-preorder, Info-last-preorder) + (Info-next-reference, Info-prev-reference, Info-index) + (Info-index-next, Info-follow-nearest-node) + (Info-copy-current-node-name): + * imenu.el (imenu--make-index-alist) + (imenu-default-create-index-function, imenu-add-to-menubar): + * files.el (basic-save-buffer, recover-file): + * emacs-lisp/easy-mmode.el (easy-mmode-define-navigation): + * emacs-lisp/checkdoc.el (checkdoc-continue, checkdoc-comments) + (checkdoc-message-text, checkdoc-defun): + * dabbrev.el (dabbrev-completion, dabbrev--abbrev-at-point): + * cus-edit.el (customize-changed-options, customize-rogue) + (customize-saved, custom-variable-set, custom-variable-mark-to-save) + (custom-variable-mark-to-reset-standard) + (custom-variable-reset-backup, custom-face-mark-to-reset-standard) + (custom-file): + * completion.el (check-completion-length): + * comint.el (comint-search-arg) + (comint-previous-matching-input-string-position) + (comint-previous-matching-input) + (comint-replace-by-expanded-history-before-point, comint-send-input) + (comint-copy-old-input, comint-backward-matching-input) + (comint-goto-process-mark, comint-set-process-mark): + * calendar/calendar.el (calendar-cursor-to-date): Use it. + * bindings.el (debug-ignored-errors): Remove regexps, add `user-error'. + 2012-05-04 Stefan Monnier * dabbrev.el (dabbrev--ignore-case-p): New function. diff --git a/lisp/bindings.el b/lisp/bindings.el index 8cfeecf5b4..f04ee72322 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -623,24 +623,13 @@ is okay. See `mode-line-format'.") ;; Packages should add to this list appropriately when they are ;; loaded, rather than listing everything here. (setq debug-ignored-errors + ;; FIXME: Maybe beginning-of-line, beginning-of-buffer, end-of-line, + ;; end-of-buffer, end-of-file, buffer-read-only, and + ;; file-supersession should all be user-errors! `(beginning-of-line beginning-of-buffer end-of-line end-of-buffer end-of-file buffer-read-only file-supersession - ,(purecopy "^Previous command was not a yank$") - ,(purecopy "^Minibuffer window is not active$") - ,(purecopy "^No previous history search regexp$") - ,(purecopy "^No later matching history item$") - ,(purecopy "^No earlier matching history item$") - ,(purecopy "^End of history; no default available$") - ,(purecopy "^End of defaults; no next item$") - ,(purecopy "^Beginning of history; no preceding item$") - ,(purecopy "^No recursive edit is in progress$") - ,(purecopy "^Changes to be undone are outside visible portion of buffer$") - ,(purecopy "^No undo information in this buffer$") - ,(purecopy "^No further undo information") - ,(purecopy "^Save not confirmed$") - ,(purecopy "^Recover-file cancelled\\.$") - ,(purecopy "^Cannot switch buffers in a dedicated window$") + user-error ;; That's the main one! )) diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index d9ec27b4f8..4d4f7e1418 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1888,7 +1888,7 @@ use instead of point." ;; or on or before the digit of a 1-digit date. (if (not (and (looking-at "[ 0-9]?[0-9][^0-9]") (get-text-property (point) 'date))) - (if error (error "Not on a date!")) + (if error (user-error "Not on a date!")) ;; Convert segment to real month and year. (if (zerop month) (setq month 12)) ;; Go back to before the first date digit. @@ -1903,8 +1903,6 @@ use instead of point." ((and (= 1 month) (= segment 2)) (1+ displayed-year)) (t displayed-year)))))))) -(add-to-list 'debug-ignored-errors "Not on a date!") - ;; The following version of calendar-gregorian-from-absolute is preferred for ;; reasons of clarity, BUT it's much slower than the version that follows it. diff --git a/lisp/comint.el b/lisp/comint.el index 8103db0e9b..43e42c87be 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1076,10 +1076,10 @@ See also `comint-read-input-ring'." (defun comint-search-arg (arg) ;; First make sure there is a ring and that we are after the process mark (cond ((not (comint-after-pmark-p)) - (error "Not at command line")) + (user-error "Not at command line")) ((or (null comint-input-ring) (ring-empty-p comint-input-ring)) - (error "Empty input ring")) + (user-error "Empty input ring")) ((zerop arg) ;; arg of zero resets search from beginning, and uses arg of 1 (setq comint-input-ring-index nil) @@ -1146,7 +1146,7 @@ Moves relative to `comint-input-ring-index'." Moves relative to START, or `comint-input-ring-index'." (if (or (not (ring-p comint-input-ring)) (ring-empty-p comint-input-ring)) - (error "No history")) + (user-error "No history")) (let* ((len (ring-length comint-input-ring)) (motion (if (> arg 0) 1 -1)) (n (mod (- (or start (comint-search-start arg)) motion) len)) @@ -1186,7 +1186,7 @@ If N is negative, find the next or Nth next match." (let ((pos (comint-previous-matching-input-string-position regexp n))) ;; Has a match been found? (if (null pos) - (error "Not found") + (user-error "Not found") ;; If leaving the edit line, save partial input (if (null comint-input-ring-index) ;not yet on ring (setq comint-stored-incomplete-input @@ -1372,7 +1372,7 @@ actual side-effect." (goto-char (match-beginning 0)) (if (not (search-forward old pos t)) (or silent - (error "Not found")) + (user-error "Not found")) (replace-match new t t) (message "History item: substituted")))) (t @@ -1777,7 +1777,7 @@ Similarly for Soar, Scheme, etc." (interactive) ;; Note that the input string does not include its terminal newline. (let ((proc (get-buffer-process (current-buffer)))) - (if (not proc) (error "Current buffer has no process") + (if (not proc) (user-error "Current buffer has no process") (widen) (let* ((pmark (process-mark proc)) (intxt (if (>= (point) (marker-position pmark)) @@ -2201,7 +2201,7 @@ Calls `comint-get-old-input' to get old input." (let ((input (funcall comint-get-old-input)) (process (get-buffer-process (current-buffer)))) (if (not process) - (error "Current buffer has no process") + (user-error "Current buffer has no process") (goto-char (process-mark process)) (insert input)))) @@ -2508,7 +2508,7 @@ If N is negative, find the next or Nth next match." (save-excursion (while (/= n 0) (unless (re-search-backward regexp nil t dir) - (error "Not found")) + (user-error "Not found")) (unless (get-char-property (point) 'field) (setq n (- n dir)))) (field-beginning)))) @@ -3364,7 +3364,7 @@ The process mark separates output, and input already sent, from input that has not yet been sent." (interactive) (let ((proc (or (get-buffer-process (current-buffer)) - (error "Current buffer has no process")))) + (user-error "Current buffer has no process")))) (goto-char (process-mark proc)) (when (called-interactively-p 'interactive) (message "Point is now at the process mark")))) @@ -3389,7 +3389,7 @@ the process mark is at the beginning of the accumulated input." "Set the process mark at point." (interactive) (let ((proc (or (get-buffer-process (current-buffer)) - (error "Current buffer has no process")))) + (user-error "Current buffer has no process")))) (set-marker (process-mark proc) (point)) (message "Process mark set"))) @@ -3741,14 +3741,6 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." (match-end regexp-group)) results)) results))) - -(dolist (x '("^Not at command line$" - "^Empty input ring$" - "^No history$" - "^Not found$" ; Too common? - "^Current buffer has no process$")) - (add-to-list 'debug-ignored-errors x)) - ;; Converting process modes to use comint mode ;; =========================================================================== diff --git a/lisp/completion.el b/lisp/completion.el index 9c6cd60c96..75f8920920 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -1301,8 +1301,8 @@ String must be longer than `completion-prefix-min-length'." (defun check-completion-length (string) (if (< (length string) completion-min-length) - (error "The string `%s' is too short to be saved as a completion" - string) + (user-error "The string `%s' is too short to be saved as a completion" + string) (list string))) (defun add-completion (string &optional num-uses last-use-time) @@ -2467,10 +2467,6 @@ if ARG is omitted or nil." (defvaralias 'cmpl-syntax-table 'completion-syntax-table) (defalias 'initialize-completions 'completion-initialize) -(dolist (x '("^To complete, the point must be after a symbol at least [0-9]* character long\\.$" - "^The string \".*\" is too short to be saved as a completion\\.$")) - (add-to-list 'debug-ignored-errors x)) - (provide 'completion) ;;; completion.el ends here diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 4458bb7b56..52308319f1 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1254,8 +1254,8 @@ that were added or redefined since that version." (if found (custom-buffer-create (custom-sort-items found t 'first) "*Customize Changed Options*") - (error "No user option defaults have been changed since Emacs %s" - since-version)))) + (user-error "No user option defaults have been changed since Emacs %s" + since-version)))) (defun customize-package-emacs-version (symbol package-version) "Return the Emacs version in which SYMBOL's meaning last changed. @@ -1386,7 +1386,7 @@ suggest to customize that face, if it's customizable." (default-value symbol)))) (push (list symbol 'custom-variable) found))))) (if (not found) - (error "No rogue user options") + (user-error "No rogue user options") (custom-buffer-create (custom-sort-items found t nil) "*Customize Rogue*")))) ;;;###autoload @@ -1403,8 +1403,8 @@ suggest to customize that face, if it's customizable." (get symbol 'saved-variable-comment)) (boundp symbol) (push (list symbol 'custom-variable) found)))) - (if (not found ) - (error "No saved user options") + (if (not found) + (user-error "No saved user options") (custom-buffer-create (custom-sort-items found t nil) "*Customize Saved*")))) @@ -2879,7 +2879,7 @@ Optional EVENT is the location for the menu." (comment (widget-value comment-widget)) val) (cond ((eq state 'hidden) - (error "Cannot set hidden variable")) + (user-error "Cannot set hidden variable")) ((setq val (widget-apply child :validate)) (goto-char (widget-get val :from)) (error "%s" (widget-get val :error))) @@ -2921,7 +2921,7 @@ Optional EVENT is the location for the menu." (comment (widget-value comment-widget)) val) (cond ((eq state 'hidden) - (error "Cannot set hidden variable")) + (user-error "Cannot set hidden variable")) ((setq val (widget-apply child :validate)) (goto-char (widget-get val :from)) (error "Saving %s: %s" symbol (widget-get val :error))) @@ -2995,7 +2995,7 @@ redraw the widget immediately." (let* ((symbol (widget-value widget))) (if (get symbol 'standard-value) (custom-variable-backup-value widget) - (error "No standard setting known for %S" symbol)) + (user-error "No standard setting known for %S" symbol)) (put symbol 'variable-comment nil) (put symbol 'customized-value nil) (put symbol 'customized-variable-comment nil) @@ -3057,7 +3057,7 @@ to switch between two values." (condition-case nil (funcall set symbol (car value)) (error nil))) - (error "No backup value for %s" symbol)) + (user-error "No backup value for %s" symbol)) (put symbol 'customized-value (list (custom-quote (car value)))) (put symbol 'variable-comment comment) (put symbol 'customized-variable-comment comment) @@ -3795,7 +3795,7 @@ redraw the widget immediately." (value (get symbol 'face-defface-spec)) (comment-widget (widget-get widget :comment-widget))) (unless value - (error "No standard setting for this face")) + (user-error "No standard setting for this face")) (put symbol 'customized-face nil) (put symbol 'customized-face-comment nil) (custom-push-theme 'theme-face symbol 'user 'reset) @@ -4414,7 +4414,7 @@ if only the first line of the docstring is shown.")) ;; sense. (if no-error nil - (error "Saving settings from \"emacs -q\" would overwrite existing customizations")) + (user-error "Saving settings from \"emacs -q\" would overwrite existing customizations")) (file-chase-links (or custom-file user-init-file)))) ;; If recentf-mode is non-nil, this is defined. @@ -4875,18 +4875,7 @@ if that value is non-nil." (put 'custom-mode 'mode-class 'special) (define-obsolete-variable-alias 'custom-mode-hook 'Custom-mode-hook "23.1") -(dolist (regexp - '("^No user option defaults have been changed since Emacs " - "^Invalid face:? " - "^No \\(?:customized\\|rogue\\|saved\\) user options" - "^No customizable items matching " - "^There are unset changes" - "^Cannot set hidden variable" - "^No \\(?:saved\\|backup\\) value for " - "^No standard setting known for " - "^No standard setting for this face" - "^Saving settings from \"emacs -q\" would overwrite existing customizations")) - (add-to-list 'debug-ignored-errors regexp)) +(add-to-list 'debug-ignored-errors "^Invalid face:? ") ;;; The End. diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index c169e07ac3..87a03fd24d 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -406,10 +406,10 @@ then it searches *all* buffers." (dabbrev--find-all-expansions abbrev ignore-case-p)) (completion-ignore-case ignore-case-p)) (or (consp completion-list) - (error "No dynamic expansion for \"%s\" found%s" - abbrev - (if dabbrev--check-other-buffers - "" " in this-buffer"))) + (user-error "No dynamic expansion for \"%s\" found%s" + abbrev + (if dabbrev--check-other-buffers + "" " in this-buffer"))) (setq list (cond ((not (and ignore-case-p dabbrev-case-replace)) @@ -585,7 +585,7 @@ all skip characters." "Extract the symbol at point to serve as abbreviation." ;; Check for error (if (bobp) - (error "No possible abbreviation preceding point")) + (user-error "No possible abbreviation preceding point")) ;; Return abbrev at point (save-excursion ;; Record the end of the abbreviation. @@ -603,7 +603,7 @@ all skip characters." "\\sw\\|\\s_") nil t) (forward-char 1) - (error "No possible abbreviation preceding point")))) + (user-error "No possible abbreviation preceding point")))) ;; Now find the beginning of that one. (dabbrev--goto-start-of-abbrev) (buffer-substring-no-properties @@ -974,11 +974,6 @@ Leaves point at the location of the start of the expansion." (cons found-string dabbrev--last-table)) result))))) -(dolist (mess '("^No dynamic expansion for .* found" - "^No further dynamic expansion for .* found$" - "^No possible abbreviation preceding point$")) - (add-to-list 'debug-ignored-errors mess)) - (provide 'dabbrev) ;;; dabbrev.el ends here diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 7a9a33fc2c..ee8cbd2c3b 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -916,7 +916,7 @@ is the starting location. If this is nil, `point-min' is used instead." (progn (goto-char wrong) (if (not take-notes) - (error "%s" (checkdoc-error-text msg))))) + (user-error "%s" (checkdoc-error-text msg))))) (checkdoc-show-diagnostics) (if (called-interactively-p 'interactive) (message "No style warnings.")))) @@ -949,7 +949,7 @@ if there is one." (e (checkdoc-file-comments-engine)) (checkdoc-generate-compile-warnings-flag (or take-notes checkdoc-generate-compile-warnings-flag))) - (if e (error "%s" (checkdoc-error-text e))) + (if e (user-error "%s" (checkdoc-error-text e))) (checkdoc-show-diagnostics) e)) @@ -987,7 +987,7 @@ Optional argument TAKE-NOTES causes all errors to be logged." (if (not (called-interactively-p 'interactive)) e (if e - (error "%s" (checkdoc-error-text e)) + (user-error "%s" (checkdoc-error-text e)) (checkdoc-show-diagnostics))) (goto-char p)) (if (called-interactively-p 'interactive) @@ -1027,19 +1027,14 @@ space at the end of each line." (car (memq checkdoc-spellcheck-documentation-flag '(defun t)))) (beg (save-excursion (beginning-of-defun) (point))) - (end (save-excursion (end-of-defun) (point))) - (msg (checkdoc-this-string-valid))) - (if msg (if no-error - (message "%s" (checkdoc-error-text msg)) - (error "%s" (checkdoc-error-text msg))) - (setq msg (checkdoc-message-text-search beg end)) - (if msg (if no-error - (message "%s" (checkdoc-error-text msg)) - (error "%s" (checkdoc-error-text msg))) - (setq msg (checkdoc-rogue-space-check-engine beg end)) - (if msg (if no-error - (message "%s" (checkdoc-error-text msg)) - (error "%s" (checkdoc-error-text msg)))))) + (end (save-excursion (end-of-defun) (point)))) + (dolist (fun (list #'checkdoc-this-string-valid + (lambda () (checkdoc-message-text-search beg end)) + (lambda () (checkdoc-rogue-space-check-engine beg end)))) + (let ((msg (funcall fun))) + (if msg (if no-error + (message "%s" (checkdoc-error-text msg)) + (user-error "%s" (checkdoc-error-text msg)))))) (if (called-interactively-p 'interactive) (message "Checkdoc: done.")))))) @@ -2644,12 +2639,6 @@ function called to create the messages." (custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode) -(add-to-list 'debug-ignored-errors - "Argument `.*' should appear (as .*) in the doc string") -(add-to-list 'debug-ignored-errors - "Lisp symbol `.*' should appear in quotes") -(add-to-list 'debug-ignored-errors "Disambiguate .* by preceding .*") - (provide 'checkdoc) ;;; checkdoc.el ends here diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 0d6716a2e6..301947f073 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -572,8 +572,6 @@ BODY is executed after moving to the destination location." (when was-narrowed (,narrowfun))))))) (unless name (setq name base-name)) `(progn - (add-to-list 'debug-ignored-errors - ,(concat "^No \\(previous\\|next\\) " (regexp-quote name))) (defun ,next-sym (&optional count) ,(format "Go to the next COUNT'th %s." name) (interactive "p") @@ -584,7 +582,7 @@ BODY is executed after moving to the destination location." `(if (not (re-search-forward ,re nil t count)) (if (looking-at ,re) (goto-char (or ,(if endfun `(,endfun)) (point-max))) - (error "No next %s" ,name)) + (user-error "No next %s" ,name)) (goto-char (match-beginning 0)) (when (and (eq (current-buffer) (window-buffer (selected-window))) (called-interactively-p 'interactive)) @@ -603,7 +601,7 @@ BODY is executed after moving to the destination location." (if (< count 0) (,next-sym (- count)) ,(funcall when-narrowed `(unless (re-search-backward ,re nil t count) - (error "No previous %s" ,name))) + (user-error "No previous %s" ,name))) ,@body)) (put ',prev-sym 'definition-name ',base)))) diff --git a/lisp/files.el b/lisp/files.el index ee455f4bf4..dd80ce6981 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4497,7 +4497,7 @@ Before and after saving the buffer, this function runs (format "%s has changed since visited or saved. Save anyway? " (file-name-nondirectory buffer-file-name))) - (error "Save not confirmed")) + (user-error "Save not confirmed")) (save-restriction (widen) (save-excursion @@ -5364,7 +5364,7 @@ non-nil, it is called instead of rereading visited file contents." (insert-file-contents file-name nil) (set-buffer-file-coding-system coding-system)) (after-find-file nil nil t)) - (t (error "Recover-file cancelled"))))) + (t (user-error "Recover-file cancelled"))))) (defun recover-session () "Recover auto save files from a previous Emacs session. diff --git a/lisp/imenu.el b/lisp/imenu.el index 12ac354092..feebb96d37 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -579,7 +579,7 @@ See `imenu--index-alist' for the format of the index alist." (funcall imenu-create-index-function)))) (imenu--truncate-items imenu--index-alist))) (or imenu--index-alist noerror - (error "No items suitable for an index found in this buffer")) + (user-error "No items suitable for an index found in this buffer")) (or imenu--index-alist (setq imenu--index-alist (list nil))) ;; Add a rescan option to the index. @@ -695,7 +695,7 @@ The alternate method, which is the one most often used, is to call ((and imenu-generic-expression) (imenu--generic-function imenu-generic-expression)) (t - (error "This buffer cannot use `imenu-default-create-index-function'")))) + (user-error "This buffer cannot use `imenu-default-create-index-function'")))) ;;; ;;; Generic index gathering function. @@ -968,8 +968,8 @@ See the command `imenu' for more information." `(menu-item ,name ,(make-sparse-keymap "Imenu"))) (use-local-map newmap) (add-hook 'menu-bar-update-hook 'imenu-update-menubar))) - (error "The mode `%s' does not support Imenu" - (format-mode-line mode-name)))) + (user-error "The mode `%s' does not support Imenu" + (format-mode-line mode-name)))) ;;;###autoload (defun imenu-add-menubar-index () @@ -1058,12 +1058,6 @@ for more information." (apply function (car index-item) position rest)) (run-hooks 'imenu-after-jump-hook))) -(dolist (mess - '("^No items suitable for an index found in this buffer$" - "^This buffer cannot use `imenu-default-create-index-function'$" - "^The mode `.*' does not support Imenu$")) - (add-to-list 'debug-ignored-errors mess)) - (provide 'imenu) ;;; imenu.el ends here diff --git a/lisp/info.el b/lisp/info.el index 042ff15836..1e3b14632e 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1071,7 +1071,7 @@ a case-insensitive match is tried." (throw 'foo t)) ;; No such anchor in tag table or node in tag table or file - (error "No such node or anchor: %s" nodename)) + (user-error "No such node or anchor: %s" nodename)) (Info-select-node) (goto-char (point-min)) @@ -2012,8 +2012,8 @@ if ERRORNAME is nil, just return nil." (concat name ":" (Info-following-node-name-re)) bound t) (match-string-no-properties 1)) ((not (eq errorname t)) - (error "Node has no %s" - (capitalize (or errorname name))))))))) + (user-error "Node has no %s" + (capitalize (or errorname name))))))))) (defun Info-following-node-name-re (&optional allowedchars) "Return a regexp matching a node name. @@ -2082,7 +2082,7 @@ If SAME-FILE is non-nil, do not move to a different Info file." "Go back in the history to the last node visited." (interactive) (or Info-history - (error "This is the first Info node you looked at")) + (user-error "This is the first Info node you looked at")) (let ((history-forward (cons (list Info-current-file Info-current-node (point)) Info-history-forward)) @@ -2102,7 +2102,7 @@ If SAME-FILE is non-nil, do not move to a different Info file." "Go forward in the history of visited nodes." (interactive) (or Info-history-forward - (error "This is the last Info node you looked at")) + (user-error "This is the last Info node you looked at")) (let ((history-forward (cdr Info-history-forward)) filename nodename opoint) (setq filename (car (car Info-history-forward))) @@ -2388,7 +2388,7 @@ new buffer." completions nil t))) (list (if (equal input "") default input) current-prefix-arg)) - (error "No cross-references in this node")))) + (user-error "No cross-references in this node")))) (unless footnotename (error "No reference was specified")) @@ -2419,7 +2419,8 @@ new buffer." (abs (- prev-ref (point)))) next-ref prev-ref)) ((or next-ref prev-ref)) - ((error "No cross-reference named %s" footnotename)))) + ((user-error "No cross-reference named %s" + footnotename)))) (setq target (Info-extract-menu-node-name t)))) (while (setq i (string-match "[ \t\n]+" target i)) (setq target (concat (substring target 0 i) " " @@ -2564,7 +2565,7 @@ new buffer." (save-excursion (goto-char (point-min)) (if (not (search-forward "\n* menu:" nil t)) - (error "No menu in this node")) + (user-error "No menu in this node")) (setq beg (point)) (and (< (point) p) (save-excursion @@ -2605,10 +2606,10 @@ new buffer." (let ((case-fold-search t)) (goto-char (point-min)) (or (search-forward "\n* menu:" nil t) - (error "No menu in this node")) + (user-error "No menu in this node")) (or (re-search-forward (concat "\n\\* +" menu-item ":") nil t) (re-search-forward (concat "\n\\* +" menu-item) nil t) - (error "No such item in menu")) + (user-error "No such item in menu")) (beginning-of-line) (forward-char 2) (Info-extract-menu-node-name nil (Info-index-node)))))) @@ -2624,7 +2625,7 @@ new buffer." (match-beginning 0)))) (goto-char (point-min)) (or (search-forward "\n* menu:" bound t) - (error "No menu in this node")) + (user-error "No menu in this node")) (if count (or (search-forward "\n* " bound t count) (error "Too few items in menu")) @@ -2696,7 +2697,7 @@ N is the digit argument used to invoke this command." (if Info-history-skip-intermediate-nodes (setq Info-history old-history))))) (no-error nil) - (t (error "No pointer forward from this node"))))) + (t (user-error "No pointer forward from this node"))))) (defun Info-backward-node () "Go backward one node, considering all nodes as forming one sequence." @@ -2705,7 +2706,7 @@ N is the digit argument used to invoke this command." (upnode (Info-extract-pointer "up" t)) (case-fold-search t)) (cond ((and upnode (string-match "(" upnode)) - (error "First node in file")) + (user-error "First node in file")) ((and upnode (or (null prevnode) ;; Use string-equal, not equal, ;; to ignore text properties. @@ -2723,7 +2724,7 @@ N is the digit argument used to invoke this command." (if Info-history-skip-intermediate-nodes (setq Info-history old-history)))) (t - (error "No pointer backward from this node"))))) + (user-error "No pointer backward from this node"))))) (defun Info-exit () "Exit Info by selecting some other buffer." @@ -2744,7 +2745,7 @@ N is the digit argument used to invoke this command." (and (search-forward "\n* " nil t) (Info-extract-menu-node-name))))) (if node (Info-goto-node node) - (error "No more items in menu")))) + (user-error "No more items in menu")))) (defun Info-last-menu-item () "Go to the node of the previous menu item." @@ -2757,7 +2758,7 @@ N is the digit argument used to invoke this command." (and (search-backward "\n* menu:" nil t) (point))))) (or (and beg (search-backward "\n* " beg t)) - (error "No previous items in menu"))) + (user-error "No previous items in menu"))) (Info-goto-node (save-excursion (goto-char (match-end 0)) (Info-extract-menu-node-name))))) @@ -2782,7 +2783,7 @@ N is the digit argument used to invoke this command." (if Info-history-skip-intermediate-nodes (setq Info-history old-history)))) (t - (error "No more nodes")))) + (user-error "No more nodes")))) (defun Info-last-preorder () "Go to the last node, popping up a level if there is none." @@ -2822,7 +2823,7 @@ N is the digit argument used to invoke this command." (let ((case-fold-search t)) (or (search-forward "\n* Menu:" nil t) (goto-char (point-max))))) - (t (error "No previous nodes")))) + (t (user-error "No previous nodes")))) (defun Info-scroll-up () "Scroll one screenful forward in Info, considering all nodes as one sequence. @@ -2911,11 +2912,11 @@ See `Info-scroll-down'." (or (re-search-forward pat nil t) (progn (goto-char old-pt) - (error "No cross references in this node"))))) + (user-error "No cross references in this node"))))) (goto-char (or (match-beginning 1) (match-beginning 0))) (if (looking-at "\\* Menu:") (if recur - (error "No cross references in this node") + (user-error "No cross references in this node") (Info-next-reference t)) (if (looking-at "^\\* ") (forward-char 2))))) @@ -2932,11 +2933,11 @@ See `Info-scroll-down'." (or (re-search-backward pat nil t) (progn (goto-char old-pt) - (error "No cross references in this node"))))) + (user-error "No cross references in this node"))))) (goto-char (or (match-beginning 1) (match-beginning 0))) (if (looking-at "\\* Menu:") (if recur - (error "No cross references in this node") + (user-error "No cross references in this node") (Info-prev-reference t)) (if (looking-at "^\\* ") (forward-char 2))))) @@ -3107,7 +3108,7 @@ Give an empty topic name to go to the Index node itself." (or matches (progn (Info-goto-node orignode) - (error "No `%s' in index" topic))) + (user-error "No `%s' in index" topic))) ;; Here it is a feature that assoc is case-sensitive. (while (setq found (assoc topic matches)) (setq exact (cons found exact) @@ -3120,7 +3121,7 @@ Give an empty topic name to go to the Index node itself." "Go to the next matching index item from the last \\\\[Info-index] command." (interactive "p") (or Info-index-alternatives - (error "No previous `i' command")) + (user-error "No previous `i' command")) (while (< num 0) (setq num (+ num (length Info-index-alternatives)))) (while (> num 0) @@ -3640,7 +3641,7 @@ If FORK is a string, it is the name to use for the new buffer." ;; Don't raise an error when mouse-1 is bound to this - it's ;; often used to simply select the window or frame. (eq 'mouse-1 (event-basic-type last-input-event))) - (error "Point neither on reference nor in menu item description"))) + (user-error "Point neither on reference nor in menu item description"))) ;; Common subroutine. (defun Info-try-follow-nearest-node (&optional fork) @@ -3907,7 +3908,7 @@ The name of the Info file is prepended to the node name in parentheses. With a zero prefix arg, put the name inside a function call to `info'." (interactive "P") (unless Info-current-node - (error "No current Info node")) + (user-error "No current Info node")) (let ((node (if (stringp Info-current-file) (concat "(" (file-name-nondirectory Info-current-file) ") " Info-current-node)))) @@ -4899,25 +4900,8 @@ BUFFER is the buffer speedbar is requesting buttons for." (erase-buffer)) (Info-speedbar-hierarchy-buttons nil 0)) -(dolist (mess '("^First node in file$" - "^No `.*' in index$" - "^No cross-reference named" - "^No cross.references in this node$" - "^No current Info node$" - "^No menu in this node$" - "^No more items in menu$" - "^No more nodes$" - "^No pointer \\(?:forward\\|backward\\) from this node$" - "^No previous `i' command$" - "^No previous items in menu$" - "^No previous nodes$" - "^No such item in menu$" - "^No such node or anchor" - "^Node has no" - "^Point neither on reference nor in menu item description$" - "^This is the \\(?:first\\|last\\) Info node you looked at$" - search-failed)) - (add-to-list 'debug-ignored-errors mess)) +;; FIXME: Really? Why here? +(add-to-list 'debug-ignored-errors 'search-failed) ;;;; Desktop support diff --git a/lisp/man.el b/lisp/man.el index 6912486dff..dd64613c49 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1273,8 +1273,8 @@ manpage command." (if (not Man-page-list) (let ((args Man-arguments)) (kill-buffer (current-buffer)) - (error "Can't find the %s manpage" - (Man-page-from-arguments args))) + (user-error "Can't find the %s manpage" + (Man-page-from-arguments args))) (set-buffer-modified-p nil)))) ;; Restore case-fold-search before calling ;; Man-notify-when-ready because it may switch buffers. @@ -1649,7 +1649,7 @@ Specify which REFERENCE to use; default is based on word at point." (when Man-page-list (if (or (< page 1) (> page (length Man-page-list))) - (error "No manpage %d found" page)) + (user-error "No manpage %d found" page)) (let* ((page-range (nth (1- page) Man-page-list)) (page-start (car page-range)) (page-end (car (cdr page-range)))) @@ -1742,9 +1742,6 @@ Uses `Man-name-local-regexp'." ;; Init the man package variables, if not already done. (Man-init-defvars) -(add-to-list 'debug-ignored-errors "^No manpage [0-9]* found$") -(add-to-list 'debug-ignored-errors "^Can't find the .* manpage$") - (provide 'man) ;;; man.el ends here diff --git a/lisp/mouse.el b/lisp/mouse.el index 46e50ed950..f40a019952 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -298,7 +298,7 @@ Use the former if the menu bar is showing, otherwise the latter." (let ((w (posn-window (event-start event)))) (and (window-minibuffer-p w) (not (minibuffer-window-active-p w)) - (error "Minibuffer window is not active"))) + (user-error "Minibuffer window is not active"))) ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook)) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 2608ba0b0c..f22ee4f7ea 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2132,14 +2132,14 @@ and runs `compilation-filter-hook'." (if (or (eq (get-text-property ,limit 'compilation-message) (get-text-property opt 'compilation-message)) (eq pt opt)) - (error ,error compilation-error) + (user-error ,error compilation-error) (setq pt ,limit))) ;; prop 'compilation-message usually has 2 changes, on and off, so ;; re-search if off (or (setq msg (get-text-property pt 'compilation-message)) (if (setq pt (,property-change pt 'compilation-message nil ,limit)) (setq msg (get-text-property pt 'compilation-message))) - (error ,error compilation-error)) + (user-error ,error compilation-error)) (or (< (compilation--message->type msg) compilation-skip-threshold) (if different-file (eq (prog1 last @@ -2660,9 +2660,6 @@ The file-structure looks like this: (if (eq v fs) (remhash k compilation-locs))) compilation-locs))) -(add-to-list 'debug-ignored-errors "\\`No more [-a-z ]+s yet\\'") -(add-to-list 'debug-ignored-errors "\\`Moved past last .*") - ;;; Compatibility with the old compile.el. (defvaralias 'compilation-last-buffer 'next-error-last-buffer) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 638410ae62..2664b51eea 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -554,11 +554,10 @@ Returns t if it visits a tags table, or nil if there are no more in the list." (cond ((eq cont 'same) ;; Use the ambient value of tags-file-name. (or tags-file-name - (error "%s" - (substitute-command-keys - (concat "No tags table in use; " - "use \\[visit-tags-table] to select one"))))) - + (user-error "%s" + (substitute-command-keys + (concat "No tags table in use; " + "use \\[visit-tags-table] to select one"))))) ((eq t cont) ;; Find the next table. (if (tags-next-table) @@ -566,7 +565,6 @@ Returns t if it visits a tags table, or nil if there are no more in the list." (while (and (not (or (get-file-buffer tags-file-name) (file-exists-p tags-file-name))) (tags-next-table))))) - (t ;; Pick a table out of our hat. (tags-table-check-computed-list) ;Get it up to date, we might use it. @@ -706,7 +704,8 @@ Returns t if it visits a tags table, or nil if there are no more in the list." (kill-local-variable 'tags-file-name) (if (eq local-tags-file-name tags-file-name) (setq tags-file-name nil)) - (error "File %s is not a valid tags table" local-tags-file-name))))) + (user-error "File %s is not a valid tags table" + local-tags-file-name))))) (defun tags-reset-tags-tables () "Reset tags state to cancel effect of any previous \\[visit-tags-table] or \\[find-tag]." @@ -831,7 +830,7 @@ If no tags table is loaded, do nothing and return nil." (tags-lazy-completion-table) nil nil nil nil default))) (if (equal spec "") - (or default (error "There is no default tag")) + (or default (user-error "There is no default tag")) spec))) (defvar last-tag nil @@ -886,7 +885,7 @@ See documentation of variable `tags-file-name'." (if (eq '- next-p) ;; Pop back to a previous location. (if (ring-empty-p tags-location-ring) - (error "No previous tag locations") + (user-error "No previous tag locations") (let ((marker (ring-remove tags-location-ring 0))) (prog1 ;; Move to the saved location. @@ -1150,8 +1149,8 @@ error message." (set-marker (car tag-lines-already-matched) nil nil) (setq tag-lines-already-matched (cdr tag-lines-already-matched))) (set-marker match-marker nil nil) - (error "No %stags %s %s" (if first-search "" "more ") - matching pattern)) + (user-error "No %stags %s %s" (if first-search "" "more ") + matching pattern)) ;; Found a tag; extract location info. (beginning-of-line) @@ -1391,8 +1390,8 @@ hits the start of file." offset (* 3 offset))) ; expand search window (or found (re-search-forward pat nil t) - (error "Rerun etags: `%s' not found in %s" - pat buffer-file-name))) + (user-error "Rerun etags: `%s' not found in %s" + pat buffer-file-name))) ;; Position point at the right place ;; if the search string matched an extra Ctrl-m at the beginning. (and (eq selective-display t) @@ -1742,7 +1741,7 @@ if the file was newly read in, the value is the filename." (and novisit (get-buffer " *next-file*") (kill-buffer " *next-file*")) - (error "All files processed")) + (user-error "All files processed")) (let* ((next (car next-file-list)) (buffer (get-file-buffer next)) (new (not buffer))) @@ -1775,9 +1774,9 @@ if the file was newly read in, the value is the filename." "Form for `tags-loop-continue' to eval to change one file.") (defvar tags-loop-scan - '(error "%s" - (substitute-command-keys - "No \\[tags-search] or \\[tags-query-replace] in progress")) + '(user-error "%s" + (substitute-command-keys + "No \\[tags-search] or \\[tags-query-replace] in progress")) "Form for `tags-loop-continue' to eval to scan one file. If it returns non-nil, this file needs processing by evalling \`tags-loop-operate'. Otherwise, move on to the next file.") @@ -1937,7 +1936,7 @@ directory specification." (if (funcall list-tags-function file) (setq gotany t))) (or gotany - (error "File %s not in current tags tables" file))))) + (user-error "File %s not in current tags tables" file))))) (with-current-buffer "*Tags List*" (require 'apropos) (with-no-warnings @@ -2067,28 +2066,15 @@ for \\[find-tag] (which see)." (interactive) (or tags-table-list tags-file-name - (error "%s" - (substitute-command-keys - "No tags table loaded; try \\[visit-tags-table]"))) + (user-error "%s" + (substitute-command-keys + "No tags table loaded; try \\[visit-tags-table]"))) (let ((comp-data (tags-completion-at-point-function))) (if (null comp-data) - (error "Nothing to complete") + (user-error "Nothing to complete") (completion-in-region (car comp-data) (cadr comp-data) (nth 2 comp-data) (plist-get (nthcdr 3 comp-data) :predicate))))) - -(dolist (x '("^No tags table in use; use .* to select one$" - "^There is no default tag$" - "^No previous tag locations$" - "^File .* is not a valid tags table$" - "^No \\(more \\|\\)tags \\(matching\\|containing\\) " - "^Rerun etags: `.*' not found in " - "^All files processed$" - "^No .* or .* in progress$" - "^File .* not in current tags tables$" - "^No tags table loaded" - "^Nothing to complete$")) - (add-to-list 'debug-ignored-errors x)) (provide 'etags) diff --git a/lisp/simple.el b/lisp/simple.el index 3d8a3a38db..2b7d5580ba 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1465,7 +1465,7 @@ See also `minibuffer-history-case-insensitive-variables'." (list (if (string= regexp "") (if minibuffer-history-search-history (car minibuffer-history-search-history) - (error "No previous history search regexp")) + (user-error "No previous history search regexp")) regexp) (prefix-numeric-value current-prefix-arg)))) (unless (zerop n) @@ -1491,9 +1491,9 @@ See also `minibuffer-history-case-insensitive-variables'." (setq prevpos pos) (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history))) (when (= pos prevpos) - (error (if (= pos 1) - "No later matching history item" - "No earlier matching history item"))) + (user-error (if (= pos 1) + "No later matching history item" + "No earlier matching history item"))) (setq match-string (if (eq minibuffer-history-sexp-flag (minibuffer-depth)) (let ((print-level nil)) @@ -1536,7 +1536,7 @@ makes the search case-sensitive." (list (if (string= regexp "") (if minibuffer-history-search-history (car minibuffer-history-search-history) - (error "No previous history search regexp")) + (user-error "No previous history search regexp")) regexp) (prefix-numeric-value current-prefix-arg)))) (previous-matching-history-element regexp (- n))) @@ -1595,11 +1595,11 @@ The argument NABS specifies the absolute history position." (setq minibuffer-text-before-history (minibuffer-contents-no-properties))) (if (< nabs minimum) - (if minibuffer-default - (error "End of defaults; no next item") - (error "End of history; no default available"))) + (user-error (if minibuffer-default + "End of defaults; no next item" + "End of history; no default available"))) (if (> nabs (length (symbol-value minibuffer-history-variable))) - (error "Beginning of history; no preceding item")) + (user-error "Beginning of history; no preceding item")) (unless (memq last-command '(next-history-element previous-history-element)) (let ((prompt-end (minibuffer-prompt-end))) @@ -1945,8 +1945,8 @@ Some change-hooks test this variable to do something different.") Call `undo-start' to get ready to undo recent changes, then call `undo-more' one or more times to undo them." (or (listp pending-undo-list) - (error (concat "No further undo information" - (and undo-in-region " for region")))) + (user-error (concat "No further undo information" + (and undo-in-region " for region")))) (let ((undo-in-progress t)) ;; Note: The following, while pulling elements off ;; `pending-undo-list' will call primitive change functions which @@ -1972,7 +1972,7 @@ If BEG and END are specified, then only undo elements that apply to text between BEG and END are used; other undo elements are ignored. If BEG and END are nil, all undo elements are used." (if (eq buffer-undo-list t) - (error "No undo information in this buffer")) + (user-error "No undo information in this buffer")) (setq pending-undo-list (if (and beg end (not (= beg end))) (undo-make-selective-list (min beg end) (max beg end)) @@ -3244,10 +3244,6 @@ move the yanking point; just return the Nth kill forward." :type 'boolean :group 'killing) -(put 'text-read-only 'error-conditions - '(text-read-only buffer-read-only error)) -(put 'text-read-only 'error-message (purecopy "Text is read-only")) - (defun kill-region (beg end &optional yank-handler) "Kill (\"cut\") text between point and mark. This deletes the text from the buffer and saves it in the kill ring. diff --git a/lisp/subr.el b/lisp/subr.el index 1f9f3aee9f..8cfb1eeea1 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -274,6 +274,17 @@ for the sake of consistency." (signal 'error (list (apply 'format args))))) (set-advertised-calling-convention 'error '(string &rest args) "23.1") +(defun user-error (format &rest args) + "Signal a pilot error, making error message by passing all args to `format'. +In Emacs, the convention is that error messages start with a capital +letter but *do not* end with a period. Please follow this convention +for the sake of consistency. +This is just like `error' except that `user-error's are expected to be the +result of an incorrect manipulation on the part of the user, rather than the +result of an actual problem." + (while t + (signal 'user-error (list (apply #'format format args))))) + ;; We put this here instead of in frame.el so that it's defined even on ;; systems where frame.el isn't loaded. (defun frame-configuration-p (object) diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index d2881b40ad..3db1f669d6 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -342,12 +342,11 @@ Can be nil if the style is undecided, or else: )))) (defvar smerge-resolve-function - (lambda () (error "Don't know how to resolve")) + (lambda () (user-error "Don't know how to resolve")) "Mode-specific merge function. The function is called with zero or one argument (non-nil if the resolution function should only apply safe heuristics) and with the match data set according to `smerge-match-conflict'.") -(add-to-list 'debug-ignored-errors "Don't know how to resolve") (defvar smerge-text-properties `(help-echo "merge conflict: mouse-3 shows a menu" @@ -626,7 +625,7 @@ major modes. Uses `smerge-resolve-function' to do the actual work." (set-match-data md) (smerge-keep-n choice)) (t - (error "Don't know how to resolve")))) + (user-error "Don't know how to resolve")))) (if (buffer-name buf) (kill-buffer buf)) (if m (delete-file m)) (if b (delete-file b)) @@ -810,9 +809,7 @@ An error is raised if not inside a conflict." (when base-start (1- base-start)) base-start (1- other-start) other-start)) t) - (search-failed (error "Point not in conflict region"))))) - -(add-to-list 'debug-ignored-errors "Point not in conflict region") + (search-failed (user-error "Point not in conflict region"))))) (defun smerge-conflict-overlay (pos) "Return the conflict overlay at POS if any." diff --git a/lisp/window.el b/lisp/window.el index 9557dbf057..a650c5602b 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5094,11 +5094,11 @@ Return the buffer switched to." ((eq buffer (window-buffer))) ((window-minibuffer-p) (if force-same-window - (error "Cannot switch buffers in minibuffer window") + (user-error "Cannot switch buffers in minibuffer window") (pop-to-buffer buffer norecord))) ((eq (window-dedicated-p) t) (if force-same-window - (error "Cannot switch buffers in a dedicated window") + (user-error "Cannot switch buffers in a dedicated window") (pop-to-buffer buffer norecord))) (t (set-window-buffer nil buffer))) diff --git a/src/ChangeLog b/src/ChangeLog index 2c2902e937..8063c8d816 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,13 @@ +2012-05-04 Stefan Monnier + + * data.c (PUT_ERROR): New macro. + (syms_of_data): Use it. Add new error type `user-error'. + * undo.c (user_error): New function. + (Fprimitive_undo): Use it. + * print.c (print_error_message): Adjust print style for `user-error'. + * keyboard.c (user_error): New function. + (Fexit_recursive_edit, Fabort_recursive_edit): Use it. + 2012-05-03 Paul Eggert Do not limit current-time-string to years 1000..9999. @@ -19,8 +29,8 @@ localtime/gmtime, but also accessing these functions' results including their tm_zone values if any, and any related TZ setting. (format_time_string): Last arg is now struct tm *, not struct tm **, - so that the struct tm is saved in the critical section. All - callers changed. Simplify allocation of initial buffer, partly + so that the struct tm is saved in the critical section. + All callers changed. Simplify allocation of initial buffer, partly motivated by the fact that memory allocation needs to be outside the critical section. diff --git a/src/data.c b/src/data.c index bd1d89992c..feacea2c08 100644 --- a/src/data.c +++ b/src/data.c @@ -51,7 +51,7 @@ along with GNU Emacs. If not, see . */ Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound; static Lisp_Object Qsubr; Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; -Lisp_Object Qerror, Qquit, Qargs_out_of_range; +Lisp_Object Qerror, Quser_error, Qquit, Qargs_out_of_range; static Lisp_Object Qwrong_type_argument; Lisp_Object Qvoid_variable, Qvoid_function; static Lisp_Object Qcyclic_function_indirection; @@ -2937,6 +2937,7 @@ syms_of_data (void) DEFSYM (Qtop_level, "top-level"); DEFSYM (Qerror, "error"); + DEFSYM (Quser_error, "user-error"); DEFSYM (Qquit, "quit"); DEFSYM (Qwrong_type_argument, "wrong-type-argument"); DEFSYM (Qargs_out_of_range, "args-out-of-range"); @@ -3004,102 +3005,42 @@ syms_of_data (void) Fput (Qerror, Qerror_message, make_pure_c_string ("error")); - Fput (Qquit, Qerror_conditions, - pure_cons (Qquit, Qnil)); - Fput (Qquit, Qerror_message, - make_pure_c_string ("Quit")); - - Fput (Qwrong_type_argument, Qerror_conditions, - pure_cons (Qwrong_type_argument, error_tail)); - Fput (Qwrong_type_argument, Qerror_message, - make_pure_c_string ("Wrong type argument")); - - Fput (Qargs_out_of_range, Qerror_conditions, - pure_cons (Qargs_out_of_range, error_tail)); - Fput (Qargs_out_of_range, Qerror_message, - make_pure_c_string ("Args out of range")); - - Fput (Qvoid_function, Qerror_conditions, - pure_cons (Qvoid_function, error_tail)); - Fput (Qvoid_function, Qerror_message, - make_pure_c_string ("Symbol's function definition is void")); - - Fput (Qcyclic_function_indirection, Qerror_conditions, - pure_cons (Qcyclic_function_indirection, error_tail)); - Fput (Qcyclic_function_indirection, Qerror_message, - make_pure_c_string ("Symbol's chain of function indirections contains a loop")); - - Fput (Qcyclic_variable_indirection, Qerror_conditions, - pure_cons (Qcyclic_variable_indirection, error_tail)); - Fput (Qcyclic_variable_indirection, Qerror_message, - make_pure_c_string ("Symbol's chain of variable indirections contains a loop")); - +#define PUT_ERROR(sym, tail, msg) \ + Fput (sym, Qerror_conditions, pure_cons (sym, tail)); \ + Fput (sym, Qerror_message, make_pure_c_string (msg)) + + PUT_ERROR (Qquit, Qnil, "Quit"); + + PUT_ERROR (Quser_error, error_tail, ""); + PUT_ERROR (Qwrong_type_argument, error_tail, "Wrong type argument"); + PUT_ERROR (Qargs_out_of_range, error_tail, "Args out of range"); + PUT_ERROR (Qvoid_function, error_tail, + "Symbol's function definition is void"); + PUT_ERROR (Qcyclic_function_indirection, error_tail, + "Symbol's chain of function indirections contains a loop"); + PUT_ERROR (Qcyclic_variable_indirection, error_tail, + "Symbol's chain of variable indirections contains a loop"); DEFSYM (Qcircular_list, "circular-list"); - Fput (Qcircular_list, Qerror_conditions, - pure_cons (Qcircular_list, error_tail)); - Fput (Qcircular_list, Qerror_message, - make_pure_c_string ("List contains a loop")); - - Fput (Qvoid_variable, Qerror_conditions, - pure_cons (Qvoid_variable, error_tail)); - Fput (Qvoid_variable, Qerror_message, - make_pure_c_string ("Symbol's value as variable is void")); - - Fput (Qsetting_constant, Qerror_conditions, - pure_cons (Qsetting_constant, error_tail)); - Fput (Qsetting_constant, Qerror_message, - make_pure_c_string ("Attempt to set a constant symbol")); - - Fput (Qinvalid_read_syntax, Qerror_conditions, - pure_cons (Qinvalid_read_syntax, error_tail)); - Fput (Qinvalid_read_syntax, Qerror_message, - make_pure_c_string ("Invalid read syntax")); - - Fput (Qinvalid_function, Qerror_conditions, - pure_cons (Qinvalid_function, error_tail)); - Fput (Qinvalid_function, Qerror_message, - make_pure_c_string ("Invalid function")); - - Fput (Qwrong_number_of_arguments, Qerror_conditions, - pure_cons (Qwrong_number_of_arguments, error_tail)); - Fput (Qwrong_number_of_arguments, Qerror_message, - make_pure_c_string ("Wrong number of arguments")); - - Fput (Qno_catch, Qerror_conditions, - pure_cons (Qno_catch, error_tail)); - Fput (Qno_catch, Qerror_message, - make_pure_c_string ("No catch for tag")); - - Fput (Qend_of_file, Qerror_conditions, - pure_cons (Qend_of_file, error_tail)); - Fput (Qend_of_file, Qerror_message, - make_pure_c_string ("End of file during parsing")); + PUT_ERROR (Qcircular_list, error_tail, "List contains a loop"); + PUT_ERROR (Qvoid_variable, error_tail, "Symbol's value as variable is void"); + PUT_ERROR (Qsetting_constant, error_tail, + "Attempt to set a constant symbol"); + PUT_ERROR (Qinvalid_read_syntax, error_tail, "Invalid read syntax"); + PUT_ERROR (Qinvalid_function, error_tail, "Invalid function"); + PUT_ERROR (Qwrong_number_of_arguments, error_tail, + "Wrong number of arguments"); + PUT_ERROR (Qno_catch, error_tail, "No catch for tag"); + PUT_ERROR (Qend_of_file, error_tail, "End of file during parsing"); arith_tail = pure_cons (Qarith_error, error_tail); - Fput (Qarith_error, Qerror_conditions, - arith_tail); - Fput (Qarith_error, Qerror_message, - make_pure_c_string ("Arithmetic error")); - - Fput (Qbeginning_of_buffer, Qerror_conditions, - pure_cons (Qbeginning_of_buffer, error_tail)); - Fput (Qbeginning_of_buffer, Qerror_message, - make_pure_c_string ("Beginning of buffer")); - - Fput (Qend_of_buffer, Qerror_conditions, - pure_cons (Qend_of_buffer, error_tail)); - Fput (Qend_of_buffer, Qerror_message, - make_pure_c_string ("End of buffer")); - - Fput (Qbuffer_read_only, Qerror_conditions, - pure_cons (Qbuffer_read_only, error_tail)); - Fput (Qbuffer_read_only, Qerror_message, - make_pure_c_string ("Buffer is read-only")); - - Fput (Qtext_read_only, Qerror_conditions, - pure_cons (Qtext_read_only, error_tail)); - Fput (Qtext_read_only, Qerror_message, - make_pure_c_string ("Text is read-only")); + Fput (Qarith_error, Qerror_conditions, arith_tail); + Fput (Qarith_error, Qerror_message, make_pure_c_string ("Arithmetic error")); + + PUT_ERROR (Qbeginning_of_buffer, error_tail, "Beginning of buffer"); + PUT_ERROR (Qend_of_buffer, error_tail, "End of buffer"); + PUT_ERROR (Qbuffer_read_only, error_tail, "Buffer is read-only"); + PUT_ERROR (Qtext_read_only, pure_cons (Qbuffer_read_only, error_tail), + "Text is read-only"); DEFSYM (Qrange_error, "range-error"); DEFSYM (Qdomain_error, "domain-error"); @@ -3107,30 +3048,17 @@ syms_of_data (void) DEFSYM (Qoverflow_error, "overflow-error"); DEFSYM (Qunderflow_error, "underflow-error"); - Fput (Qdomain_error, Qerror_conditions, - pure_cons (Qdomain_error, arith_tail)); - Fput (Qdomain_error, Qerror_message, - make_pure_c_string ("Arithmetic domain error")); - - Fput (Qrange_error, Qerror_conditions, - pure_cons (Qrange_error, arith_tail)); - Fput (Qrange_error, Qerror_message, - make_pure_c_string ("Arithmetic range error")); - - Fput (Qsingularity_error, Qerror_conditions, - pure_cons (Qsingularity_error, Fcons (Qdomain_error, arith_tail))); - Fput (Qsingularity_error, Qerror_message, - make_pure_c_string ("Arithmetic singularity error")); - - Fput (Qoverflow_error, Qerror_conditions, - pure_cons (Qoverflow_error, Fcons (Qdomain_error, arith_tail))); - Fput (Qoverflow_error, Qerror_message, - make_pure_c_string ("Arithmetic overflow error")); - - Fput (Qunderflow_error, Qerror_conditions, - pure_cons (Qunderflow_error, Fcons (Qdomain_error, arith_tail))); - Fput (Qunderflow_error, Qerror_message, - make_pure_c_string ("Arithmetic underflow error")); + PUT_ERROR (Qdomain_error, arith_tail, "Arithmetic domain error"); + + PUT_ERROR (Qrange_error, arith_tail, "Arithmetic range error"); + + PUT_ERROR (Qsingularity_error, Fcons (Qdomain_error, arith_tail), + "Arithmetic singularity error"); + + PUT_ERROR (Qoverflow_error, Fcons (Qdomain_error, arith_tail), + "Arithmetic overflow error"); + PUT_ERROR (Qunderflow_error, Fcons (Qdomain_error, arith_tail), + "Arithmetic underflow error"); staticpro (&Qnil); staticpro (&Qt); diff --git a/src/fileio.c b/src/fileio.c index 69b2c9cb0f..f09ba2c394 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -87,17 +87,17 @@ along with GNU Emacs. If not, see . */ #define FILE_SYSTEM_CASE(filename) (filename) #endif -/* Nonzero during writing of auto-save files */ +/* Nonzero during writing of auto-save files. */ static int auto_saving; -/* Nonzero umask during creation of auto-save directories */ +/* Nonzero umask during creation of auto-save directories. */ static int auto_saving_dir_umask; /* Set by auto_save_1 to mode of original file so Fwrite_region will create - a new file with the same mode as the original */ + a new file with the same mode as the original. */ static int auto_save_mode_bits; -/* Set by auto_save_1 if an error occurred during the last auto-save. */ +/* Set by auto_save_1 if an error occurred during the last auto-save. */ static int auto_save_error_occurred; /* The symbol bound to coding-system-for-read when @@ -111,7 +111,7 @@ static Lisp_Object Qauto_save_coding; which gives a list of operations it handles.. */ static Lisp_Object Qoperations; -/* Lisp functions for translating file formats */ +/* Lisp functions for translating file formats. */ static Lisp_Object Qformat_decode, Qformat_annotate_function; /* Lisp function for setting buffer-file-coding-system and the diff --git a/src/keyboard.c b/src/keyboard.c index a1ad1fed32..249e5ee954 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1200,6 +1200,12 @@ This also exits all active minibuffers. */) Fthrow (Qtop_level, Qnil); } +static void user_error (const char*) NO_RETURN; +static void user_error (const char *msg) +{ + xsignal1 (Quser_error, build_string (msg)); +} + static Lisp_Object Fexit_recursive_edit (void) NO_RETURN; DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, "", doc: /* Exit from the innermost recursive edit or minibuffer. */) @@ -1208,7 +1214,7 @@ DEFUN ("exit-recursive-edit", Fexit_recursive_edit, Sexit_recursive_edit, 0, 0, if (command_loop_level > 0 || minibuf_level > 0) Fthrow (Qexit, Qnil); - error ("No recursive edit is in progress"); + user_error ("No recursive edit is in progress"); } static Lisp_Object Fabort_recursive_edit (void) NO_RETURN; @@ -1219,7 +1225,7 @@ DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, if (command_loop_level > 0 || minibuf_level > 0) Fthrow (Qexit, Qt); - error ("No recursive edit is in progress"); + user_error ("No recursive edit is in progress"); } #if defined (HAVE_MOUSE) || defined (HAVE_GPM) diff --git a/src/lisp.h b/src/lisp.h index 16c10f2688..1f83975060 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2377,7 +2377,7 @@ extern Lisp_Object Qerror, Qquit, Qargs_out_of_range; extern Lisp_Object Qvoid_variable, Qvoid_function; extern Lisp_Object Qinvalid_read_syntax; extern Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch; -extern Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive; +extern Lisp_Object Quser_error, Qend_of_file, Qarith_error, Qmark_inactive; extern Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; extern Lisp_Object Qtext_read_only; extern Lisp_Object Qinteractive_form; diff --git a/src/print.c b/src/print.c index b8ee44d0d1..c2edde590f 100644 --- a/src/print.c +++ b/src/print.c @@ -865,7 +865,6 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context, { Lisp_Object errname, errmsg, file_error, tail; struct gcpro gcpro1; - int i; if (context != 0) write_string_1 (context, -1, stream); @@ -893,9 +892,8 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context, } else { - Lisp_Object error_conditions; + Lisp_Object error_conditions = Fget (errname, Qerror_conditions); errmsg = Fget (errname, Qerror_message); - error_conditions = Fget (errname, Qerror_conditions); file_error = Fmemq (Qfile_error, error_conditions); } @@ -909,22 +907,30 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context, if (!NILP (file_error) && CONSP (tail)) errmsg = XCAR (tail), tail = XCDR (tail); - if (STRINGP (errmsg)) - Fprinc (errmsg, stream); - else - write_string_1 ("peculiar error", -1, stream); + { + const char *sep = ": "; - for (i = 0; CONSP (tail); tail = XCDR (tail), i = 1) - { - Lisp_Object obj; + if (!STRINGP (errmsg)) + write_string_1 ("peculiar error", -1, stream); + else if (SCHARS (errmsg)) + Fprinc (errmsg, stream); + else + sep = NULL; - write_string_1 (i ? ", " : ": ", 2, stream); - obj = XCAR (tail); - if (!NILP (file_error) || EQ (errname, Qend_of_file)) - Fprinc (obj, stream); - else - Fprin1 (obj, stream); - } + for (; CONSP (tail); tail = XCDR (tail), sep = ", ") + { + Lisp_Object obj; + + if (sep) + write_string_1 (sep, 2, stream); + obj = XCAR (tail); + if (!NILP (file_error) + || EQ (errname, Qend_of_file) || EQ (errname, Quser_error)) + Fprinc (obj, stream); + else + Fprin1 (obj, stream); + } + } UNGCPRO; } diff --git a/src/undo.c b/src/undo.c index 4041a2adac..b0acd0c216 100644 --- a/src/undo.c +++ b/src/undo.c @@ -436,6 +436,13 @@ truncate_undo_list (struct buffer *b) unbind_to (count, Qnil); } + +static void user_error (const char*) NO_RETURN; +static void user_error (const char *msg) +{ + xsignal1 (Quser_error, build_string (msg)); +} + DEFUN ("primitive-undo", Fprimitive_undo, Sprimitive_undo, 2, 2, 0, doc: /* Undo N records from the front of the list LIST. @@ -528,7 +535,7 @@ Return what remains of the list. */) end = Fcdr (cdr); if (XINT (beg) < BEGV || XINT (end) > ZV) - error ("Changes to be undone are outside visible portion of buffer"); + user_error ("Changes to be undone are outside visible portion of buffer"); Fput_text_property (beg, end, prop, val, Qnil); } else if (INTEGERP (car) && INTEGERP (cdr)) @@ -537,7 +544,7 @@ Return what remains of the list. */) if (XINT (car) < BEGV || XINT (cdr) > ZV) - error ("Changes to be undone are outside visible portion of buffer"); + user_error ("Changes to be undone are outside visible portion of buffer"); /* Set point first thing, so that undoing this undo does not send point back to where it is now. */ Fgoto_char (car); @@ -588,14 +595,14 @@ Return what remains of the list. */) if (pos < 0) { if (-pos < BEGV || -pos > ZV) - error ("Changes to be undone are outside visible portion of buffer"); + user_error ("Changes to be undone are outside visible portion of buffer"); SET_PT (-pos); Finsert (1, &membuf); } else { if (pos < BEGV || pos > ZV) - error ("Changes to be undone are outside visible portion of buffer"); + user_error ("Changes to be undone are outside visible portion of buffer"); SET_PT (pos); /* Now that we record marker adjustments -- 2.20.1