Now on revision 113784. ------------------------------------------------------------ revno: 113784 committer: Xue Fuqiao branch nick: trunk timestamp: Sat 2013-08-10 13:03:11 +0800 message: * doc/lispref/edebug.texi (Instrumenting Macro Calls): Use @defmac for macros. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2013-08-09 22:34:05 +0000 +++ doc/lispref/ChangeLog 2013-08-10 05:03:11 +0000 @@ -1,3 +1,7 @@ +2013-08-10 Xue Fuqiao + + * edebug.texi (Instrumenting Macro Calls): Use @defmac for macros. + 2013-08-09 Xue Fuqiao * control.texi (Error Symbols): Minor fix for previous change. === modified file 'doc/lispref/edebug.texi' --- doc/lispref/edebug.texi 2013-01-01 09:11:05 +0000 +++ doc/lispref/edebug.texi 2013-08-10 05:03:11 +0000 @@ -1132,14 +1132,14 @@ definitions in Lisp, but @code{def-edebug-spec} makes it possible to define Edebug specifications for special forms implemented in C. -@deffn Macro def-edebug-spec macro specification +@defmac def-edebug-spec macro specification Specify which expressions of a call to macro @var{macro} are forms to be evaluated. @var{specification} should be the edebug specification. Neither argument is evaluated. The @var{macro} argument can actually be any symbol, not just a macro name. -@end deffn +@end defmac Here is a table of the possibilities for @var{specification} and how each directs processing of arguments. ------------------------------------------------------------ revno: 113783 committer: Xue Fuqiao branch nick: trunk timestamp: Sat 2013-08-10 12:58:31 +0800 message: * doc/misc/ido.texi (Working Directories): (Flexible Matching, Regexp Matching, Find File At Point) (Ignoring, Misc Customization): Use @defopt for user options. diff: === modified file 'doc/lispref/frames.texi' --- doc/lispref/frames.texi 2013-03-23 09:33:00 +0000 +++ doc/lispref/frames.texi 2013-08-10 04:58:31 +0000 @@ -446,7 +446,7 @@ If you invoke Emacs with command-line options that specify frame appearance, those options take effect by adding elements to either @code{initial-frame-alist} or @code{default-frame-alist}. Options -which affect just the initial frame, such as @samp{-geometry} and +which affect just the initial frame, such as @samp{--geometry} and @samp{--maximized}, add to @code{initial-frame-alist}; the others add to @code{default-frame-alist}. @pxref{Emacs Invocation,, Command Line Arguments for Emacs Invocation, emacs, The GNU Emacs Manual}. === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2013-08-09 00:51:03 +0000 +++ doc/misc/ChangeLog 2013-08-10 04:58:31 +0000 @@ -1,3 +1,9 @@ +2013-08-10 Xue Fuqiao + + * ido.texi (Working Directories): + (Flexible Matching, Regexp Matching, Find File At Point) + (Ignoring, Misc Customization): Use @defopt for user options. + 2013-08-09 Xue Fuqiao * htmlfontify.texi (Customization): Remove documentation of === modified file 'doc/misc/ido.texi' --- doc/misc/ido.texi 2013-08-08 23:56:25 +0000 +++ doc/misc/ido.texi 2013-08-10 04:58:31 +0000 @@ -168,13 +168,13 @@ @c @defvar ido-try-merged-list @c @defvar ido-pre-merge-state -@defvr {User Option} ido-max-work-directory-list +@defopt ido-max-work-directory-list This user option specifies maximum number of working directories to record. -@end defvr +@end defopt @c see (info "(elisp) File Name Completion") -@defvr {User Option} ido-max-dir-file-cache +@defopt ido-max-dir-file-cache This user option specifies maximum number of working directories to be cached. This is the size of the cache of @code{file-name-all-completions} results. Each cache entry is time @@ -183,7 +183,7 @@ may choose to disable caching on such systems, or explicitly refresh the cache contents using the command @code{ido-reread-directory} (usually @kbd{C-l}) in the minibuffer. -@end defvr +@end defopt @node Matching @chapter Matching @@ -320,11 +320,11 @@ @cindex ftp hosts You can also visit files on other hosts using the ange-ftp notations @samp{/host:} and @samp{/user@@host:}. -@c @defvr {User Option} ido-record-ftp-work-directories -@c @defvr {User Option} ido-merge-ftp-work-directories -@c @defvr {User Option} ido-cache-ftp-work-directory-time -@c @defvr {User Option} ido-slow-ftp-hosts -@c @defvr {User Option} ido-slow-ftp-host-regexps +@c @defopt ido-record-ftp-work-directories +@c @defopt ido-merge-ftp-work-directories +@c @defopt ido-cache-ftp-work-directory-time +@c @defopt ido-slow-ftp-hosts +@c @defopt ido-slow-ftp-host-regexps You can type @kbd{M-p} and @kbd{M-n} to change to previous/next directories from the history, @kbd{M-s} to search for a file matching @@ -377,12 +377,12 @@ @section Flexible Matching @cindex flexible matching -@defvr {User Option} ido-enable-flex-matching +@defopt ido-enable-flex-matching If non-@code{nil}, Ido will do flexible string matching. Flexible matching means that if the entered string does not match any item, any item containing the entered characters in the given sequence will match. -@end defvr +@end defopt @noindent If @code{ido-enable-flex-matching} is non-@code{nil}, Ido will do a @@ -410,11 +410,11 @@ you to type @samp{[ch]$} for example and see all file names ending in @samp{c} or @samp{h}. -@defvr {User Option} ido-enable-regexp +@defopt ido-enable-regexp If the value of this user option is non-@code{nil}, Ido will do regexp matching. The value of this user option can be toggled within ido-mode using @code{ido-toggle-regexp}. -@end defvr +@end defopt @strong{Please notice:} Ido-style completion is inhibited when you enable regexp matching. @@ -474,7 +474,7 @@ (define-key ido-completion-map " " 'ido-next-match)) @end example -@c @defvr {User Option} ido-setup-hook +@c @defopt ido-setup-hook @c a new node for Ido hooks? @menu @@ -521,17 +521,17 @@ (setq ido-use-filename-at-point 'guess) @end example -@c @defvr {User Option} ido-use-filename-at-point +@c @defopt ido-use-filename-at-point @c If the value of this user option is non-@code{nil}, ... -@c @end defvr +@c @end defopt You can disable URL ffap support by toggling @code{ido-use-url-at-point}. -@defvr {User Option} ido-use-url-at-point +@defopt ido-use-url-at-point If the value of this user option is non-@code{nil}, Ido will look for a URL at point. If found, call @code{find-file-at-point} to visit it. -@end defvr +@end defopt @node Ignoring @section Ignoring Buffers and Files @@ -542,29 +542,29 @@ Ido is capable of ignoring buffers, directories, files and extensions using regular expression. -@defvr {User Option} ido-ignore-buffers +@defopt ido-ignore-buffers This variable takes a list of regular expressions for buffers to ignore in @code{ido-switch-buffer}. -@end defvr +@end defopt -@defvr {User Option} ido-ignore-directories +@defopt ido-ignore-directories This variable takes a list of regular expressions for (sub)directories names to ignore in @code{ido-dired} and @code{ido-find-file}. -@end defvr +@end defopt -@defvr {User Option} ido-ignore-files +@defopt ido-ignore-files This variable takes a list of regular expressions for files to ignore in @code{ido-find-file}. -@end defvr +@end defopt -@defvr {User Option} ido-ignore-unc-host-regexps +@defopt ido-ignore-unc-host-regexps This variable takes a list of regular expressions matching UNC hosts to ignore. The letter case will be ignored if @code{ido-downcase-unc-hosts} is non-@code{nil}. -@end defvr +@end defopt @c FIXME: Where to add this variable? This node or ``working directory''? -@c @defvr {User Option} ido-work-directory-list-ignore-regexps +@c @defopt ido-work-directory-list-ignore-regexps To make Ido use @code{completion-ignored-extensions} you need to enable it: @@ -588,114 +588,114 @@ @c Variables described in this sections may be moved to new nodes in @c the future. -@defvr {User Option} ido-mode +@defopt ido-mode This user option determines for which functional group (buffer and files) Ido behavior should be enabled. -@end defvr +@end defopt -@defvr {User Option} ido-case-fold +@defopt ido-case-fold If the value of this user option is non-@code{nil}, searching of buffer and file names should ignore case. -@end defvr +@end defopt -@defvr {User Option} ido-show-dot-for-dired +@defopt ido-show-dot-for-dired If the value of this user option is non-@code{nil}, always put @samp{.} as the first item in file name lists. This allows the current directory to be opened immediately with Dired -@end defvr +@end defopt -@defvr {User Option} ido-enable-dot-prefix +@defopt ido-enable-dot-prefix If the value of this user option is non-@code{nil}, Ido will match leading dot as prefix. I.e., hidden files and buffers will match only if you type a dot as first char (even if @code{ido-enable-prefix} is @code{nil}). -@end defvr +@end defopt -@defvr {User Option} ido-confirm-unique-completion +@defopt ido-confirm-unique-completion If the value of this user option is non-@code{nil}, even a unique completion must be confirmed. This means that @code{ido-complete} (@key{TAB}) must always be followed by @code{ido-exit-minibuffer} (@key{RET}) even when there is only one unique completion. -@end defvr +@end defopt -@defvr {User Option} ido-cannot-complete-command +@defopt ido-cannot-complete-command When @code{ido-complete} can't complete any more, it will run the command specified by this user option. The most useful values are @code{ido-completion-help}, which pops up a window with completion alternatives, or @code{ido-next-match} or @code{ido-prev-match}, which cycle the buffer list. -@end defvr +@end defopt -@defvr {User Option} ido-max-file-prompt-width +@defopt ido-max-file-prompt-width This user option specifies the upper limit of the prompt string. If its value is an integer, it specifies the number of characters of the string. If its value is a floating point number, it specifies a fraction of the frame width. -@end defvr +@end defopt -@defvr {User Option} ido-max-window-height +@defopt ido-max-window-height If the value of this user option is non-@code{nil}, its value will override the variable @code{max-mini-window-height}, which is the maximum height for resizing mini-windows (the minibuffer and the echo area). If it's a floating point number, it specifies a fraction of the mini-window frame's height. If it's an integer, it specifies the number of lines. -@end defvr +@end defopt -@defvr {User Option} ido-record-commands +@defopt ido-record-commands If the value of this user option is non-@code{nil}, Ido will record commands in the variable @code{command-history}. Note that non-Ido equivalent is recorded. -@end defvr +@end defopt -@defvr {User Option} ido-all-frames +@defopt ido-all-frames This user option will be passed to @code{walk-windows} as its @var{all-frames} argument when Ido is finding buffers. @xref{Cyclic Window Ordering, , Cyclic Ordering of Windows, elisp, GNU Emacs Lisp Reference Manual}. -@end defvr +@end defopt -@defvr {User Option} ido-minibuffer-setup-hook +@defopt ido-minibuffer-setup-hook This hook variable contains Ido-specific customization of minibuffer setup. It is run during minibuffer setup if Ido is active, and is intended for use in customizing ido for interoperation with other packages. -@end defvr +@end defopt -@c @defvr {User Option} ido-enable-tramp-completion +@c @defopt ido-enable-tramp-completion @c cross-reference to tramp.texi @c @cindex UNC host names, completion -@c @defvr {User Option} ido-unc-hosts -@c @defvr {User Option} ido-downcase-unc-hosts -@c @defvr {User Option} ido-cache-unc-host-shares-time +@c @defopt ido-unc-hosts +@c @defopt ido-downcase-unc-hosts +@c @defopt ido-cache-unc-host-shares-time -@c @defvr {User Option} ido-enable-last-directory-history -@c @defvr {User Option} ido-max-work-file-list -@c @defvr {User Option} ido-work-directory-match-only -@c @defvr {User Option} ido-auto-merge-work-directories-length -@c @defvr {User Option} ido-auto-merge-delay-time -@c @defvr {User Option} ido-auto-merge-inhibit-characters-regexp -@c @defvr {User Option} ido-merged-indicator -@c @defvr {User Option} ido-max-directory-size -@c @defvr {User Option} ido-rotate-file-list-default -@c @defvr {User Option} ido-enter-matching-directory -@c @defvr {User Option} ido-create-new-buffer -@c @defvr {User Option} ido-separator -@c @defvr {User Option} ido-decorations -@c @defvr {User Option} ido-use-virtual-buffers -@c @defvr {User Option} ido-use-faces -@c @defvr {User Option} ido-make-file-list-hook -@c @defvr {User Option} ido-make-dir-list-hook -@c @defvr {User Option} ido-make-buffer-list-hook -@c @defvr {User Option} ido-rewrite-file-prompt-functions -@c @defvr {User Option} ido-completion-buffer -@c @defvr {User Option} ido-completion-buffer-all-completions -@c @defvr {User Option} ido-save-directory-list-file -@c @defvr {User Option} ido-read-file-name-as-directory-commands -@c @defvr {User Option} ido-read-file-name-non-ido -@c @defvr {User Option} ido-before-fallback-functions -@c @defvr {User Option} ido-buffer-disable-smart-matches +@c @defopt ido-enable-last-directory-history +@c @defopt ido-max-work-file-list +@c @defopt ido-work-directory-match-only +@c @defopt ido-auto-merge-work-directories-length +@c @defopt ido-auto-merge-delay-time +@c @defopt ido-auto-merge-inhibit-characters-regexp +@c @defopt ido-merged-indicator +@c @defopt ido-max-directory-size +@c @defopt ido-rotate-file-list-default +@c @defopt ido-enter-matching-directory +@c @defopt ido-create-new-buffer +@c @defopt ido-separator +@c @defopt ido-decorations +@c @defopt ido-use-virtual-buffers +@c @defopt ido-use-faces +@c @defopt ido-make-file-list-hook +@c @defopt ido-make-dir-list-hook +@c @defopt ido-make-buffer-list-hook +@c @defopt ido-rewrite-file-prompt-functions +@c @defopt ido-completion-buffer +@c @defopt ido-completion-buffer-all-completions +@c @defopt ido-save-directory-list-file +@c @defopt ido-read-file-name-as-directory-commands +@c @defopt ido-read-file-name-non-ido +@c @defopt ido-before-fallback-functions +@c @defopt ido-buffer-disable-smart-matches @node Misc @chapter Miscellaneous @@ -748,7 +748,7 @@ matching items is limited to 12, but you can increase or removed this limit via the @code{ido-max-prospects} user option. -@c @defvr {User Option} ido-max-prospects +@c @defopt ido-max-prospects To see a full list of all matching buffers in a separate buffer, hit @kbd{?} or press @key{TAB} when there are no further completions to @@ -767,7 +767,7 @@ variable @code{ido-everywhere}. @c @deffn Command ido-everywhere -@c @defvr {User Option} ido-everywhere +@c @defopt ido-everywhere @node Other Packages @section Other Packages ------------------------------------------------------------ revno: 113782 committer: Juanma Barranquero branch nick: trunk timestamp: Sat 2013-08-10 01:15:39 +0200 message: lisp/filecache.el (file-cache-delete-file-list): Print message only when told so. (file-cache-files-matching): Use #' in mapconcat argument. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-09 23:08:46 +0000 +++ lisp/ChangeLog 2013-08-09 23:15:39 +0000 @@ -1,5 +1,9 @@ 2013-08-09 Juanma Barranquero + * filecache.el (file-cache-delete-file-list): + Print message only when told so. + (file-cache-files-matching): Use #' in mapconcat argument. + * ffap.el (ffap-url-at-point): Fix reference to variable thing-at-point-default-mail-uri-scheme. === modified file 'lisp/filecache.el' --- lisp/filecache.el 2013-01-02 16:13:04 +0000 +++ lisp/filecache.el 2013-08-09 23:15:39 +0000 @@ -453,8 +453,9 @@ (dolist (f files) (if (file-cache-delete-file f) (setq n (1+ n)))) - (message "Filecache: uncached %d file name%s." - n (if (= n 1) "" "s")))) + (when message + (message "Filecache: uncached %d file name%s." + n (if (= n 1) "" "s"))))) (defun file-cache-delete-file-regexp (regexp) "Delete files matching REGEXP from the file cache." @@ -679,10 +680,7 @@ "*File Cache Files Matching*"))) (erase-buffer) (insert - (mapconcat - 'identity - results - "\n")) + (mapconcat #'identity results "\n")) (goto-char (point-min)) (display-buffer buf))) ------------------------------------------------------------ revno: 113781 committer: Juanma Barranquero branch nick: trunk timestamp: Sat 2013-08-10 01:08:46 +0200 message: lisp/ffap.el: Fix reference to variable thing-at-point-default-mail-uri-scheme. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-09 21:22:44 +0000 +++ lisp/ChangeLog 2013-08-09 23:08:46 +0000 @@ -1,3 +1,8 @@ +2013-08-09 Juanma Barranquero + + * ffap.el (ffap-url-at-point): Fix reference to variable + thing-at-point-default-mail-uri-scheme. + 2013-08-09 Stefan Monnier * subr.el (define-error): New function. === modified file 'lisp/ffap.el' --- lisp/ffap.el 2013-08-05 14:26:57 +0000 +++ lisp/ffap.el 2013-08-09 23:08:46 +0000 @@ -1073,7 +1073,7 @@ (or (and (eq major-mode 'w3-mode) ; In a w3 buffer button? (w3-view-this-url t)) (let ((thing-at-point-beginning-of-url-regexp ffap-url-regexp) - (thing-at-point-default-mail-scheme ffap-foo-at-bar-prefix)) + (thing-at-point-default-mail-uri-scheme ffap-foo-at-bar-prefix)) (thing-at-point-url-at-point t (if (use-region-p) (cons (region-beginning) ------------------------------------------------------------ revno: 113780 committer: Xue Fuqiao branch nick: trunk timestamp: Sat 2013-08-10 06:34:05 +0800 message: * doc/lispref/control.texi (Error Symbols): Minor fix for previous change. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2013-08-09 21:22:44 +0000 +++ doc/lispref/ChangeLog 2013-08-09 22:34:05 +0000 @@ -1,3 +1,7 @@ +2013-08-09 Xue Fuqiao + + * control.texi (Error Symbols): Minor fix for previous change. + 2013-08-09 Stefan Monnier * errors.texi (Standard Errors): Don't refer to `error-conditions'. === modified file 'doc/lispref/control.texi' --- doc/lispref/control.texi 2013-08-09 21:22:44 +0000 +++ doc/lispref/control.texi 2013-08-09 22:34:05 +0000 @@ -1282,9 +1282,10 @@ The transitive set of parents always includes the error symbol itself, and the symbol @code{error}. Because quitting is not considered an error, the set of parents of @code{quit} is just @code{(quit)}. +@end defun @cindex peculiar error - In addition to its parents, the error symbol has a var{message} which + In addition to its parents, the error symbol has a @var{message} which is a string to be printed when that error is signaled but not handled. If that message is not valid, the error message @samp{peculiar error} is used. @xref{Definition of signal}. ------------------------------------------------------------ revno: 113779 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2013-08-09 17:22:44 -0400 message: * lisp/subr.el (define-error): New function. * doc/lispref/control.texi (Signaling Errors): Refer to define-error. (Error Symbols): Add `define-error'. * doc/lispref/errors.texi (Standard Errors): Don't refer to `error-conditions'. * lisp/progmodes/ada-xref.el (ada-error-file-not-found): Rename from error-file-not-found and define with define-error. * lisp/emacs-lisp/cl-lib.el (cl-assertion-failed): Move here from subr.el and define with define-error. * lisp/userlock.el (file-locked, file-supersession): * lisp/simple.el (mark-inactive): * lisp/progmodes/js.el (js-moz-bad-rpc, js-js-error): * lisp/progmodes/ada-mode.el (ada-mode-errors): * lisp/play/life.el (life-extinct): * lisp/nxml/xsd-regexp.el (xsdre-invalid-regexp, xsdre-parse-error): * lisp/nxml/xmltok.el (xmltok-markup-declaration-parse-error): * lisp/nxml/rng-util.el (rng-error): * lisp/nxml/rng-uri.el (rng-uri-error): * lisp/nxml/rng-match.el (rng-compile-error): * lisp/nxml/rng-cmpct.el (rng-c-incorrect-schema): * lisp/nxml/nxml-util.el (nxml-error, nxml-file-parse-error): * lisp/nxml/nxml-rap.el (nxml-scan-error): * lisp/nxml/nxml-outln.el (nxml-outline-error): * lisp/net/soap-client.el (soap-error): * lisp/net/gnutls.el (gnutls-error): * lisp/net/ange-ftp.el (ftp-error): * lisp/mpc.el (mpc-proc-error): * lisp/json.el (json-error, json-readtable-error, json-unknown-keyword) (json-number-format, json-string-escape, json-string-format) (json-key-format, json-object-format): * lisp/jka-compr.el (compression-error): * lisp/international/quail.el (quail-error): * lisp/international/kkc.el (kkc-error): * lisp/emacs-lisp/ert.el (ert-test-failed): * lisp/calc/calc.el (calc-error, inexact-result, math-overflow) (math-underflow): * lisp/bookmark.el (bookmark-error-no-filename): * lisp/epg.el (epg-error): Define with define-error. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2013-08-06 06:53:09 +0000 +++ doc/lispref/ChangeLog 2013-08-09 21:22:44 +0000 @@ -1,3 +1,10 @@ +2013-08-09 Stefan Monnier + + * errors.texi (Standard Errors): Don't refer to `error-conditions'. + + * control.texi (Signaling Errors): Refer to define-error. + (Error Symbols): Add `define-error'. + 2013-08-06 Dmitry Antipov * positions.texi (Motion by Screen Lines): === modified file 'doc/lispref/control.texi' --- doc/lispref/control.texi 2013-03-11 17:05:30 +0000 +++ doc/lispref/control.texi 2013-08-09 21:22:44 +0000 @@ -890,9 +890,8 @@ the circumstances of the error. The argument @var{error-symbol} must be an @dfn{error symbol}---a symbol -bearing a property @code{error-conditions} whose value is a list of -condition names. This is how Emacs Lisp classifies different sorts of -errors. @xref{Error Symbols}, for a description of error symbols, +defined with @code{define-error}. This is how Emacs Lisp classifies different +sorts of errors. @xref{Error Symbols}, for a description of error symbols, error conditions and condition names. If the error is not handled, the two arguments are used in printing @@ -1118,8 +1117,8 @@ @end example Each error that occurs has an @dfn{error symbol} that describes what -kind of error it is. The @code{error-conditions} property of this -symbol is a list of condition names (@pxref{Error Symbols}). Emacs +kind of error it is, and which describes also a list of condition names +(@pxref{Error Symbols}). Emacs searches all the active @code{condition-case} forms for a handler that specifies one or more of these condition names; the innermost matching @code{condition-case} handles the error. Within this @@ -1259,6 +1258,7 @@ @cindex condition name @cindex user-defined error @kindex error-conditions +@kindex define-error When you signal an error, you specify an @dfn{error symbol} to specify the kind of error you have in mind. Each error has one and only one @@ -1275,42 +1275,37 @@ error symbol if that is distinct from @code{error}, and perhaps some intermediate classifications. - In order for a symbol to be an error symbol, it must have an -@code{error-conditions} property which gives a list of condition names. -This list defines the conditions that this kind of error belongs to. -(The error symbol itself, and the symbol @code{error}, should always be -members of this list.) Thus, the hierarchy of condition names is -defined by the @code{error-conditions} properties of the error symbols. -Because quitting is not considered an error, the value of the -@code{error-conditions} property of @code{quit} is just @code{(quit)}. +@defun define-error name message &optional parent + In order for a symbol to be an error symbol, it must be defined with +@code{define-error} which takes a parent condition (defaults to @code{error}). +This parent defines the conditions that this kind of error belongs to. +The transitive set of parents always includes the error symbol itself, and the +symbol @code{error}. Because quitting is not considered an error, the set of +parents of @code{quit} is just @code{(quit)}. @cindex peculiar error - In addition to the @code{error-conditions} list, the error symbol -should have an @code{error-message} property whose value is a string to -be printed when that error is signaled but not handled. If the -error symbol has no @code{error-message} property or if the -@code{error-message} property exists, but is not a string, the error -message @samp{peculiar error} is used. @xref{Definition of signal}. + In addition to its parents, the error symbol has a var{message} which +is a string to be printed when that error is signaled but not handled. If that +message is not valid, the error message @samp{peculiar error} is used. +@xref{Definition of signal}. + +Internally, the set of parents is stored in the @code{error-conditions} +property of the error symbol and the message is stored in the +@code{error-message} property of the error symbol. Here is how we define a new error symbol, @code{new-error}: @example @group -(put 'new-error - 'error-conditions - '(error my-own-errors new-error)) -@result{} (error my-own-errors new-error) -@end group -@group -(put 'new-error 'error-message "A new error") -@result{} "A new error" +(define-error 'new-error "A new error" 'my-own-errors) @end group @end example @noindent -This error has three condition names: @code{new-error}, the narrowest +This error has several condition names: @code{new-error}, the narrowest classification; @code{my-own-errors}, which we imagine is a wider -classification; and @code{error}, which is the widest of all. +classification; and all the conditions of @code{my-own-errors} which should +include @code{error}, which is the widest of all. The error string should start with a capital letter but it should not end with a period. This is for consistency with the rest of Emacs. @@ -1326,7 +1321,7 @@ @end group @end example - This error can be handled through any of the three condition names. + This error can be handled through any of its condition names. This example handles @code{new-error} and any other errors in the class @code{my-own-errors}: === modified file 'doc/lispref/errors.texi' --- doc/lispref/errors.texi 2013-07-24 13:10:38 +0000 +++ doc/lispref/errors.texi 2013-08-09 21:22:44 +0000 @@ -7,12 +7,11 @@ @appendix Standard Errors @cindex standard errors - Here is a list of the more important error symbols in standard Emacs, -grouped by concept. The list includes each symbol's message (on the -@code{error-message} property of the symbol) and a cross reference to a -description of how the error can occur. + Here is a list of the more important error symbols in standard Emacs, grouped +by concept. The list includes each symbol's message and a cross reference +to a description of how the error can occur. - Each error symbol has an @code{error-conditions} property that is a + Each error symbol has an set of parent error conditions that is a list of symbols. Normally this list includes the error symbol itself and the symbol @code{error}. Occasionally it includes additional symbols, which are intermediate classifications, narrower than @@ -24,8 +23,6 @@ As a special exception, the error symbol @code{quit} does not have the condition @code{error}, because quitting is not considered an error. -@c You can grep for "(put 'foo 'error-conditions ...) to find -@c examples defined in Lisp. E.g., soap-client.el, sasl.el. Most of these error symbols are defined in C (mainly @file{data.c}), but some are defined in Lisp. For example, the file @file{userlock.el} defines the @code{file-locked} and @code{file-supersession} errors. === modified file 'etc/NEWS' --- etc/NEWS 2013-08-08 00:46:48 +0000 +++ etc/NEWS 2013-08-09 21:22:44 +0000 @@ -599,6 +599,9 @@ * Lisp Changes in Emacs 24.4 ++++ +** New function `define-error'. + ** New hook `tty-setup-hook'. +++ === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-09 18:49:36 +0000 +++ lisp/ChangeLog 2013-08-09 21:22:44 +0000 @@ -1,5 +1,40 @@ 2013-08-09 Stefan Monnier + * subr.el (define-error): New function. + * progmodes/ada-xref.el (ada-error-file-not-found): Rename from + error-file-not-found and define with define-error. + * emacs-lisp/cl-lib.el (cl-assertion-failed): Move here from subr.el + and define with define-error. + * userlock.el (file-locked, file-supersession): + * simple.el (mark-inactive): + * progmodes/js.el (js-moz-bad-rpc, js-js-error): + * progmodes/ada-mode.el (ada-mode-errors): + * play/life.el (life-extinct): + * nxml/xsd-regexp.el (xsdre-invalid-regexp, xsdre-parse-error): + * nxml/xmltok.el (xmltok-markup-declaration-parse-error): + * nxml/rng-util.el (rng-error): + * nxml/rng-uri.el (rng-uri-error): + * nxml/rng-match.el (rng-compile-error): + * nxml/rng-cmpct.el (rng-c-incorrect-schema): + * nxml/nxml-util.el (nxml-error, nxml-file-parse-error): + * nxml/nxml-rap.el (nxml-scan-error): + * nxml/nxml-outln.el (nxml-outline-error): + * net/soap-client.el (soap-error): + * net/gnutls.el (gnutls-error): + * net/ange-ftp.el (ftp-error): + * mpc.el (mpc-proc-error): + * json.el (json-error, json-readtable-error, json-unknown-keyword) + (json-number-format, json-string-escape, json-string-format) + (json-key-format, json-object-format): + * jka-compr.el (compression-error): + * international/quail.el (quail-error): + * international/kkc.el (kkc-error): + * emacs-lisp/ert.el (ert-test-failed): + * calc/calc.el (calc-error, inexact-result, math-overflow) + (math-underflow): + * bookmark.el (bookmark-error-no-filename): + * epg.el (epg-error): Define with define-error. + * time.el (display-time-event-handler) (display-time-next-load-average): Don't call sit-for since it seems unnecessary (bug#15045). === modified file 'lisp/bookmark.el' --- lisp/bookmark.el 2013-07-23 00:58:28 +0000 +++ lisp/bookmark.el 2013-08-09 21:22:44 +0000 @@ -1112,12 +1112,9 @@ (setq bookmark-current-bookmark bookmark-name-or-record)) nil) -(put 'bookmark-error-no-filename - 'error-conditions - '(error bookmark-errors bookmark-error-no-filename)) -(put 'bookmark-error-no-filename - 'error-message - "Bookmark has no associated file (or directory)") +(define-error 'bookmark-errors nil) +(define-error 'bookmark-error-no-filename + "Bookmark has no associated file (or directory)" 'bookmark-errors) (defun bookmark-default-handler (bmk-record) "Default handler to jump to a particular bookmark location. === modified file 'lisp/calc/calc.el' --- lisp/calc/calc.el 2013-08-05 14:26:57 +0000 +++ lisp/calc/calc.el 2013-08-09 21:22:44 +0000 @@ -921,15 +921,12 @@ (put 'calc-mode 'mode-class 'special) (put 'calc-trail-mode 'mode-class 'special) -;; Define "inexact-result" as an e-lisp error symbol. -(put 'inexact-result 'error-conditions '(error inexact-result calc-error)) -(put 'inexact-result 'error-message "Calc internal error (inexact-result)") +(define-error 'calc-error "Calc internal error") +(define-error 'inexact-result + "Calc internal error (inexact-result)" 'calc-error) -;; Define "math-overflow" and "math-underflow" as e-lisp error symbols. -(put 'math-overflow 'error-conditions '(error math-overflow calc-error)) -(put 'math-overflow 'error-message "Floating-point overflow occurred") -(put 'math-underflow 'error-conditions '(error math-underflow calc-error)) -(put 'math-underflow 'error-message "Floating-point underflow occurred") +(define-error 'math-overflow "Floating-point overflow occurred" 'calc-error) +(define-error 'math-underflow "Floating-point underflow occurred" 'calc-error) (defvar calc-trail-pointer nil "The \"current\" entry in trail buffer.") === modified file 'lisp/emacs-lisp/cl-lib.el' --- lisp/emacs-lisp/cl-lib.el 2013-06-20 20:01:51 +0000 +++ lisp/emacs-lisp/cl-lib.el 2013-08-09 21:22:44 +0000 @@ -714,6 +714,9 @@ ;;;###autoload (progn + ;; The `assert' macro from the cl package signals + ;; `cl-assertion-failed' at runtime so always define it. + (define-error 'cl-assertion-failed (purecopy "Assertion failed")) ;; Make sure functions defined with cl-defsubst can be inlined even in ;; packages which do not require CL. We don't put an autoload cookie ;; directly on that function, since those cookies only go to cl-loaddefs. === modified file 'lisp/emacs-lisp/ert.el' --- lisp/emacs-lisp/ert.el 2013-07-11 16:13:38 +0000 +++ lisp/emacs-lisp/ert.el 2013-08-09 21:22:44 +0000 @@ -236,8 +236,7 @@ "The regexp the `find-function' mechanisms use for finding test definitions.") -(put 'ert-test-failed 'error-conditions '(error ert-test-failed)) -(put 'ert-test-failed 'error-message "Test failed") +(define-error 'ert-test-failed "Test failed") (defun ert-pass () "Terminate the current test and mark it passed. Does not return." === modified file 'lisp/epg.el' --- lisp/epg.el 2013-08-05 10:35:55 +0000 +++ lisp/epg.el 2013-08-09 21:22:44 +0000 @@ -162,8 +162,7 @@ (defvar epg-prompt-alist nil) -(put 'epg-error 'error-conditions '(epg-error error)) -(put 'epg-error 'error-message "GPG error") +(define-error 'epg-error "GPG error") (defun epg-make-data-from-file (file) "Make a data object from FILE." === modified file 'lisp/international/kkc.el' --- lisp/international/kkc.el 2013-03-12 02:08:21 +0000 +++ lisp/international/kkc.el 2013-08-09 21:22:44 +0000 @@ -207,7 +207,7 @@ kkc-current-conversions-width nil kkc-current-conversions (cons 0 nil))))))) -(put 'kkc-error 'error-conditions '(kkc-error error)) +(define-error 'kkc-error nil) (defun kkc-error (&rest args) (signal 'kkc-error (apply 'format args))) === modified file 'lisp/international/quail.el' --- lisp/international/quail.el 2013-01-01 09:11:05 +0000 +++ lisp/international/quail.el 2013-08-09 21:22:44 +0000 @@ -1301,7 +1301,7 @@ (setcdr map (funcall (cdr map) key len))) map)) -(put 'quail-error 'error-conditions '(quail-error error)) +(define-error 'quail-error nil) (defun quail-error (&rest args) (signal 'quail-error (apply 'format args))) === modified file 'lisp/jka-compr.el' --- lisp/jka-compr.el 2013-02-09 12:52:01 +0000 +++ lisp/jka-compr.el 2013-08-09 21:22:44 +0000 @@ -109,8 +109,7 @@ (put 'jka-compr-really-do-compress 'permanent-local t) -(put 'compression-error 'error-conditions '(compression-error file-error error)) - +(define-error 'compression-error nil 'file-error) (defvar jka-compr-acceptable-retval-list '(0 2 141)) === modified file 'lisp/json.el' --- lisp/json.el 2013-01-02 16:13:04 +0000 +++ lisp/json.el 2013-08-09 21:22:44 +0000 @@ -177,36 +177,14 @@ ;; Error conditions -(put 'json-error 'error-message "Unknown JSON error") -(put 'json-error 'error-conditions '(json-error error)) - -(put 'json-readtable-error 'error-message "JSON readtable error") -(put 'json-readtable-error 'error-conditions - '(json-readtable-error json-error error)) - -(put 'json-unknown-keyword 'error-message "Unrecognized keyword") -(put 'json-unknown-keyword 'error-conditions - '(json-unknown-keyword json-error error)) - -(put 'json-number-format 'error-message "Invalid number format") -(put 'json-number-format 'error-conditions - '(json-number-format json-error error)) - -(put 'json-string-escape 'error-message "Bad Unicode escape") -(put 'json-string-escape 'error-conditions - '(json-string-escape json-error error)) - -(put 'json-string-format 'error-message "Bad string format") -(put 'json-string-format 'error-conditions - '(json-string-format json-error error)) - -(put 'json-key-format 'error-message "Bad JSON object key") -(put 'json-key-format 'error-conditions - '(json-key-format json-error error)) - -(put 'json-object-format 'error-message "Bad JSON object") -(put 'json-object-format 'error-conditions - '(json-object-format json-error error)) +(define-error 'json-error "Unknown JSON error") +(define-error 'json-readtable-error "JSON readtable error" 'json-error) +(define-error 'json-unknown-keyword "Unrecognized keyword" 'json-error) +(define-error 'json-number-format "Invalid number format" 'json-error) +(define-error 'json-string-escape "Bad Unicode escape" 'json-error) +(define-error 'json-string-format "Bad string format" 'json-error) +(define-error 'json-key-format "Bad JSON object key" 'json-error) +(define-error 'json-object-format "Bad JSON object" 'json-error) === modified file 'lisp/mpc.el' --- lisp/mpc.el 2013-08-05 14:26:57 +0000 +++ lisp/mpc.el 2013-08-09 21:22:44 +0000 @@ -209,8 +209,7 @@ (defconst mpc--proc-end-re "^\\(?:OK\\(?: MPD .*\\)?\\|ACK \\(.*\\)\\)\n") -(put 'mpc-proc-error 'error-conditions '(mpc-proc-error error)) -(put 'mpc-proc-error 'error-message "MPD error") +(define-error 'mpc-proc-error "MPD error") (defun mpc--debug (format &rest args) (if (get-buffer "*MPC-debug*") === modified file 'lisp/net/ange-ftp.el' --- lisp/net/ange-ftp.el 2013-04-15 09:43:20 +0000 +++ lisp/net/ange-ftp.el 2013-08-09 21:22:44 +0000 @@ -1097,8 +1097,7 @@ (defvar ange-ftp-trample-marker) ;; New error symbols. -(put 'ftp-error 'error-conditions '(ftp-error file-error error)) -;; (put 'ftp-error 'error-message "FTP error") +(define-error 'ftp-error nil 'file-error) ;"FTP error" ;;; ------------------------------------------------------------ ;;; Enhanced message support. === modified file 'lisp/net/gnutls.el' --- lisp/net/gnutls.el 2013-01-01 09:11:05 +0000 +++ lisp/net/gnutls.el 2013-08-09 21:22:44 +0000 @@ -111,11 +111,7 @@ :type 'gnutls-x509pki :hostname host)) -(put 'gnutls-error - 'error-conditions - '(error gnutls-error)) -(put 'gnutls-error - 'error-message "GnuTLS error") +(define-error 'gnutls-error "GnuTLS error") (declare-function gnutls-boot "gnutls.c" (proc type proplist)) (declare-function gnutls-errorp "gnutls.c" (error)) === modified file 'lisp/net/soap-client.el' --- lisp/net/soap-client.el 2013-02-01 07:28:10 +0000 +++ lisp/net/soap-client.el 2013-08-09 21:22:44 +0000 @@ -1352,10 +1352,7 @@ ;;;; Soap Envelope parsing -(put 'soap-error - 'error-conditions - '(error soap-error)) -(put 'soap-error 'error-message "SOAP error") +(define-error 'soap-error "SOAP error") (defun soap-parse-envelope (node operation wsdl) "Parse the SOAP envelope in NODE and return the response. === modified file 'lisp/nxml/nxml-outln.el' --- lisp/nxml/nxml-outln.el 2013-03-23 02:21:25 +0000 +++ lisp/nxml/nxml-outln.el 2013-08-09 21:22:44 +0000 @@ -1008,13 +1008,8 @@ (defun nxml-outline-error (&rest args) (signal 'nxml-outline-error args)) -(put 'nxml-outline-error - 'error-conditions - '(error nxml-error nxml-outline-error)) - -(put 'nxml-outline-error - 'error-message - "Cannot create outline of buffer that is not well-formed") +(define-error 'nxml-outline-error + "Cannot create outline of buffer that is not well-formed" 'nxml-error) ;;; Debugging === modified file 'lisp/nxml/nxml-rap.el' --- lisp/nxml/nxml-rap.el 2013-05-15 18:31:51 +0000 +++ lisp/nxml/nxml-rap.el 2013-08-09 21:22:44 +0000 @@ -402,13 +402,8 @@ (defun nxml-scan-error (&rest args) (signal 'nxml-scan-error args)) -(put 'nxml-scan-error - 'error-conditions - '(error nxml-error nxml-scan-error)) - -(put 'nxml-scan-error - 'error-message - "Scan over element that is not well-formed") +(define-error 'nxml-scan-error + "Scan over element that is not well-formed" 'nxml-error) (provide 'nxml-rap) === modified file 'lisp/nxml/nxml-util.el' --- lisp/nxml/nxml-util.el 2013-03-23 02:21:25 +0000 +++ lisp/nxml/nxml-util.el 2013-08-09 21:22:44 +0000 @@ -101,13 +101,8 @@ (signal (or error-symbol 'nxml-file-parse-error) (list file pos message))) -(put 'nxml-file-parse-error - 'error-conditions - '(error nxml-file-parse-error)) - -(put 'nxml-parse-file-error - 'error-message - "Error parsing file") +(define-error 'nxml-error nil) +(define-error 'nxml-file-parse-error "Error parsing file" 'nxml-error) (provide 'nxml-util) === modified file 'lisp/nxml/rng-cmpct.el' --- lisp/nxml/rng-cmpct.el 2013-01-01 09:11:05 +0000 +++ lisp/nxml/rng-cmpct.el 2013-08-09 21:22:44 +0000 @@ -45,13 +45,8 @@ ;;; Error handling -(put 'rng-c-incorrect-schema - 'error-conditions - '(error rng-error nxml-file-parse-error rng-c-incorrect-schema)) - -(put 'rng-c-incorrect-schema - 'error-message - "Incorrect schema") +(define-error 'rng-c-incorrect-schema + "Incorrect schema" '(rng-error nxml-file-parse-error)) (defun rng-c-signal-incorrect-schema (filename pos message) (nxml-signal-file-parse-error filename === modified file 'lisp/nxml/rng-match.el' --- lisp/nxml/rng-match.el 2013-01-01 09:11:05 +0000 +++ lisp/nxml/rng-match.el 2013-08-09 21:22:44 +0000 @@ -1541,14 +1541,7 @@ (signal 'rng-compile-error (list (apply 'format args)))) -(put 'rng-compile-error - 'error-conditions - '(error rng-error rng-compile-error)) - -(put 'rng-compile-error - 'error-message - "Incorrect schema") - +(define-error 'rng-compile-error "Incorrect schema" 'rng-error) ;;; External API === modified file 'lisp/nxml/rng-uri.el' --- lisp/nxml/rng-uri.el 2013-01-01 09:11:05 +0000 +++ lisp/nxml/rng-uri.el 2013-08-09 21:22:44 +0000 @@ -127,8 +127,7 @@ (defun rng-uri-error (&rest args) (signal 'rng-uri-error (list (apply 'format args)))) -(put 'rng-uri-error 'error-conditions '(error rng-uri-error)) -(put 'rng-uri-error 'error-message "Invalid URI") +(define-error 'rng-uri-error "Invalid URI") (defun rng-uri-split (str) (and (string-match "\\`\\(?:\\([^:/?#]+\\):\\)?\ === modified file 'lisp/nxml/rng-util.el' --- lisp/nxml/rng-util.el 2013-01-01 09:11:05 +0000 +++ lisp/nxml/rng-util.el 2013-08-09 21:22:44 +0000 @@ -165,6 +165,8 @@ (setq string (substring string 0 -1))) string) +(define-error 'rng-error nil) + (provide 'rng-util) ;;; rng-util.el ends here === modified file 'lisp/nxml/xmltok.el' --- lisp/nxml/xmltok.el 2013-05-15 18:31:51 +0000 +++ lisp/nxml/xmltok.el 2013-08-09 21:22:44 +0000 @@ -1435,13 +1435,8 @@ (defun xmltok-current-token-string () (buffer-substring-no-properties xmltok-start (point))) -(put 'xmltok-markup-declaration-parse-error - 'error-conditions - '(error xmltok-markup-declaration-parse-error)) - -(put 'xmltok-markup-declaration-parse-error - 'error-message - "Syntax error in markup declaration") +(define-error 'xmltok-markup-declaration-parse-error + "Syntax error in markup declaration") (defun xmltok-markup-declaration-parse-error () (signal 'xmltok-markup-declaration-parse-error nil)) === modified file 'lisp/nxml/xsd-regexp.el' --- lisp/nxml/xsd-regexp.el 2013-01-01 09:11:05 +0000 +++ lisp/nxml/xsd-regexp.el 2013-08-09 21:22:44 +0000 @@ -466,13 +466,8 @@ (- (length str) (length xsdre-current-regexp)))))))) -(put 'xsdre-invalid-regexp - 'error-conditions - '(error xsdre-invalid-regexp)) - -(put 'xsdre-invalid-regexp - 'error-message - "Invalid W3C XML Schema Datatypes regular expression") +(define-error 'xsdre-invalid-regexp + "Invalid W3C XML Schema Datatypes regular expression") (defun xsdre-parse-regexp () (let ((branches nil)) @@ -686,13 +681,7 @@ ;; This error condition is used only internally. -(put 'xsdre-parse-error - 'error-conditions - '(error xsdre-parse-error)) - -(put 'xsdre-parse-error - 'error-message - "Internal error in parsing XSD regexp") +(define-error 'xsdre-parse-error "Internal error in parsing XSD regexp") ;;; Character class data === modified file 'lisp/play/life.el' --- lisp/play/life.el 2013-01-01 09:11:05 +0000 +++ lisp/play/life.el 2013-08-09 21:22:44 +0000 @@ -290,8 +290,7 @@ (life-display-generation 0) (signal 'life-extinct nil)) -(put 'life-extinct 'error-conditions '(life-extinct quit)) -(put 'life-extinct 'error-message "All life has perished") +(define-error 'life-extinct "All life has perished" 'quit) ;FIXME: quit really? (provide 'life) === modified file 'lisp/progmodes/ada-mode.el' --- lisp/progmodes/ada-mode.el 2013-05-08 16:27:53 +0000 +++ lisp/progmodes/ada-mode.el 2013-08-09 21:22:44 +0000 @@ -130,6 +130,8 @@ (defvar ispell-check-comments) (defvar skeleton-further-elements) +(define-error 'ada-mode-errors nil) + (defun ada-mode-version () "Return Ada mode version." (interactive) === modified file 'lisp/progmodes/ada-xref.el' --- lisp/progmodes/ada-xref.el 2013-01-01 09:11:05 +0000 +++ lisp/progmodes/ada-xref.el 2013-08-09 21:22:44 +0000 @@ -1142,7 +1142,7 @@ (condition-case err (ada-find-in-ali identlist other-frame) ;; File not found: print explicit error message - (error-file-not-found + (ada-error-file-not-found (message (concat (error-message-string err) (nthcdr 1 err)))) @@ -1637,7 +1637,7 @@ (let ((filename (ada-find-src-file-in-dir file))) (if filename (expand-file-name filename) - (signal 'error-file-not-found (file-name-nondirectory file))) + (signal 'ada-error-file-not-found (file-name-nondirectory file))) ))) (defun ada-find-file-number-in-ali (file) @@ -1828,7 +1828,7 @@ (ada-file-of identlist))) ;; Else clean up the ali file - (error-file-not-found + (ada-error-file-not-found (signal (car err) (cdr err))) (error (kill-buffer ali-buffer) @@ -2127,7 +2127,7 @@ (string-to-number (nth 2 (nth choice list))) identlist other-frame) - (signal 'error-file-not-found (car (nth choice list)))) + (signal 'ada-error-file-not-found (car (nth choice list)))) (message "This is only a (good) guess at the cross-reference.") )))) @@ -2362,12 +2362,8 @@ (add-hook 'ada-mode-hook 'ada-xref-initialize) ;; Define a new error type -(put 'error-file-not-found - 'error-conditions - '(error ada-mode-errors error-file-not-found)) -(put 'error-file-not-found - 'error-message - "File not found in src-dir (check project file): ") +(define-error 'ada-error-file-not-found + "File not found in src-dir (check project file): " 'ada-mode-errors) (provide 'ada-xref) === modified file 'lisp/progmodes/js.el' --- lisp/progmodes/js.el 2013-05-24 03:50:31 +0000 +++ lisp/progmodes/js.el 2013-08-09 21:22:44 +0000 @@ -2244,11 +2244,8 @@ ;;; MozRepl integration -(put 'js-moz-bad-rpc 'error-conditions '(error timeout)) -(put 'js-moz-bad-rpc 'error-message "Mozilla RPC Error") - -(put 'js-js-error 'error-conditions '(error js-error)) -(put 'js-js-error 'error-message "Javascript Error") +(define-error 'js-moz-bad-rpc "Mozilla RPC Error") ;; '(timeout error)) +(define-error 'js-js-error "Javascript Error") ;; '(js-error error)) (defun js--wait-for-matching-output (process regexp timeout &optional start) === modified file 'lisp/simple.el' --- lisp/simple.el 2013-08-05 14:26:57 +0000 +++ lisp/simple.el 2013-08-09 21:22:44 +0000 @@ -4160,8 +4160,7 @@ (save-excursion (insert-buffer-substring oldbuf start end))))) -(put 'mark-inactive 'error-conditions '(mark-inactive error)) -(put 'mark-inactive 'error-message (purecopy "The mark is not active now")) +(define-error 'mark-inactive (purecopy "The mark is not active now")) (defvar activate-mark-hook nil "Hook run when the mark becomes active. === modified file 'lisp/subr.el' --- lisp/subr.el 2013-08-07 15:43:57 +0000 +++ lisp/subr.el 2013-08-09 21:22:44 +0000 @@ -312,6 +312,26 @@ (while t (signal 'user-error (list (apply #'format format args))))) +(defun define-error (name message &optional parent) + "Define NAME as a new error signal. +MESSAGE is a string that will be output to the echo area if such an error +is signaled without being caught by a `condition-case'. +PARENT is either a signal or a list of signals from which it inherits. +Defaults to `error'." + (unless parent (setq parent 'error)) + (let ((conditions + (if (consp parent) + (apply #'nconc + (mapcar (lambda (parent) + (cons parent + (or (get parent 'error-conditions) + (error "Unknown signal `%s'" parent)))) + parent)) + (cons parent (get parent 'error-conditions))))) + (put name 'error-conditions + (delete-dups (copy-sequence (cons name conditions)))) + (when message (put name 'error-message message)))) + ;; 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) @@ -2526,11 +2546,6 @@ This hook is normally set up with a function to put the buffer in Help mode.") -;; The `assert' macro from the cl package signals -;; `cl-assertion-failed' at runtime so always define it. -(put 'cl-assertion-failed 'error-conditions '(error)) -(put 'cl-assertion-failed 'error-message (purecopy "Assertion failed")) - (defconst user-emacs-directory (if (eq system-type 'ms-dos) ;; MS-DOS cannot have initial dot. === modified file 'lisp/userlock.el' --- lisp/userlock.el 2013-01-01 09:11:05 +0000 +++ lisp/userlock.el 2013-08-09 21:22:44 +0000 @@ -30,8 +30,7 @@ ;;; Code: -(put 'file-locked 'error-conditions '(file-locked file-error error)) -(put 'file-locked 'error-message "File is locked") +(define-error 'file-locked "File is locked" 'file-error) ;;;###autoload (defun ask-user-about-lock (file opponent) @@ -94,8 +93,7 @@ (with-current-buffer standard-output (help-mode)))) -(put - 'file-supersession 'error-conditions '(file-supersession file-error error)) +(define-error 'file-supersession nil 'file-error) ;;;###autoload (defun ask-user-about-supersession-threat (fn) ------------------------------------------------------------ revno: 113778 fixes bug: http://debbugs.gnu.org/15064 committer: Eli Zaretskii branch nick: trunk timestamp: Sat 2013-08-10 00:19:42 +0300 message: Fix bug #15064 with assertion violation due to mouse face. src/xdisp.c (draw_glyphs): Don't compare row pointers, compare row vertical positions instead. This avoids calling MATRIX_ROW with row numbers that are possibly beyond valid limits. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-09 12:25:34 +0000 +++ src/ChangeLog 2013-08-09 21:19:42 +0000 @@ -1,3 +1,9 @@ +2013-08-09 Eli Zaretskii + + * xdisp.c (draw_glyphs): Don't compare row pointers, compare row + vertical positions instead. This avoids calling MATRIX_ROW with + row numbers that are possibly beyond valid limits. (Bug#15064) + 2013-08-09 Dmitry Antipov Use xstrdup and build_unibyte_string where applicable. === modified file 'src/xdisp.c' --- src/xdisp.c 2013-08-09 12:25:34 +0000 +++ src/xdisp.c 2013-08-09 21:19:42 +0000 @@ -23826,17 +23826,15 @@ && hlinfo->mouse_face_beg_row >= 0 && hlinfo->mouse_face_end_row >= 0) { - struct glyph_row *mouse_beg_row, *mouse_end_row; - - mouse_beg_row = MATRIX_ROW (w->current_matrix, hlinfo->mouse_face_beg_row); - mouse_end_row = MATRIX_ROW (w->current_matrix, hlinfo->mouse_face_end_row); - - if (row >= mouse_beg_row && row <= mouse_end_row) + ptrdiff_t row_vpos = MATRIX_ROW_VPOS (row, w->current_matrix); + + if (row_vpos >= hlinfo->mouse_face_beg_row + && row_vpos <= hlinfo->mouse_face_end_row) { check_mouse_face = 1; - mouse_beg_col = (row == mouse_beg_row) + mouse_beg_col = (row_vpos == hlinfo->mouse_face_beg_row) ? hlinfo->mouse_face_beg_col : 0; - mouse_end_col = (row == mouse_end_row) + mouse_end_col = (row_vpos == hlinfo->mouse_face_end_row) ? hlinfo->mouse_face_end_col : row->used[TEXT_AREA]; } ------------------------------------------------------------ revno: 113777 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15045 committer: Stefan Monnier branch nick: trunk timestamp: Fri 2013-08-09 14:49:36 -0400 message: * lisp/time.el (display-time-event-handler) (display-time-next-load-average): Don't call sit-for since it seems unnecessary. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-09 01:19:42 +0000 +++ lisp/ChangeLog 2013-08-09 18:49:36 +0000 @@ -1,5 +1,9 @@ 2013-08-09 Stefan Monnier + * time.el (display-time-event-handler) + (display-time-next-load-average): Don't call sit-for since it seems + unnecessary (bug#15045). + * emacs-lisp/checkdoc.el: Remove redundant :group keywords. Use #' instead of ' to quote functions. (checkdoc-output-mode): Use setq-local. === modified file 'lisp/time.el' --- lisp/time.el 2013-01-01 09:11:05 +0000 +++ lisp/time.el 2013-08-09 18:49:36 +0000 @@ -323,8 +323,6 @@ (defun display-time-event-handler () (display-time-update) - ;; Do redisplay right now, if no input pending. - (sit-for 0) (let* ((current (current-time)) (timer display-time-timer) ;; Compute the time when this timer will run again, next. @@ -352,8 +350,7 @@ (interactive) (if (= 3 (setq display-time-load-average (1+ display-time-load-average))) (setq display-time-load-average 0)) - (display-time-update) - (sit-for 0)) + (display-time-update)) (defun display-time-mail-check-directory () (let ((mail-files (directory-files display-time-mail-directory t)) ------------------------------------------------------------ revno: 113776 committer: Dmitry Antipov branch nick: trunk timestamp: Fri 2013-08-09 16:25:34 +0400 message: Use xstrdup and build_unibyte_string where applicable. * alloc.c (xstrdup): Tiny cleanup. Add eassert. * xfns.c (x_window): * xrdb.c (x_get_customization_string): * xterm.c (xim_initialize): * w32fns.c (w32_window): Use xstrdup. (w32_display_monitor_attributes_list): * emacs.c (init_cmdargs): * keyboard.c (PUSH_C_STR): * nsfont.m (nsfont_open): * sysdep.c (system_process_attributes): * w32.c (system_process_attributes): * xdisp.c (message1, message1_nolog): Use build_unibyte_string. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-09 10:18:48 +0000 +++ src/ChangeLog 2013-08-09 12:25:34 +0000 @@ -1,3 +1,19 @@ +2013-08-09 Dmitry Antipov + + Use xstrdup and build_unibyte_string where applicable. + * alloc.c (xstrdup): Tiny cleanup. Add eassert. + * xfns.c (x_window): + * xrdb.c (x_get_customization_string): + * xterm.c (xim_initialize): + * w32fns.c (w32_window): Use xstrdup. + (w32_display_monitor_attributes_list): + * emacs.c (init_cmdargs): + * keyboard.c (PUSH_C_STR): + * nsfont.m (nsfont_open): + * sysdep.c (system_process_attributes): + * w32.c (system_process_attributes): + * xdisp.c (message1, message1_nolog): Use build_unibyte_string. + 2013-08-09 Eli Zaretskii * w32.c (PEXCEPTION_POINTERS, PEXCEPTION_RECORD, PCONTEXT): Define === modified file 'src/alloc.c' --- src/alloc.c 2013-07-24 15:11:30 +0000 +++ src/alloc.c 2013-08-09 12:25:34 +0000 @@ -796,10 +796,8 @@ char * xstrdup (const char *s) { - size_t len = strlen (s) + 1; - char *p = xmalloc (len); - memcpy (p, s, len); - return p; + eassert (s); + return strcpy (xmalloc (strlen (s) + 1), s); } /* Like putenv, but (1) use the equivalent of xmalloc and (2) the === modified file 'src/emacs.c' --- src/emacs.c 2013-07-16 07:05:41 +0000 +++ src/emacs.c 2013-08-09 12:25:34 +0000 @@ -517,8 +517,7 @@ They are decoded in the function command-line after we know locale-coding-system. */ Vcommand_line_args - = Fcons (make_unibyte_string (argv[i], strlen (argv[i])), - Vcommand_line_args); + = Fcons (build_unibyte_string (argv[i]), Vcommand_line_args); } unbind_to (count, Qnil); === modified file 'src/keyboard.c' --- src/keyboard.c 2013-08-03 03:29:03 +0000 +++ src/keyboard.c 2013-08-09 12:25:34 +0000 @@ -8431,7 +8431,7 @@ return Qnil; #define PUSH_C_STR(str, listvar) \ - listvar = Fcons (make_unibyte_string (str, strlen (str)), listvar) + listvar = Fcons (build_unibyte_string (str), listvar) /* Prompt string always starts with map's prompt, and a space. */ prompt_strings = Fcons (name, prompt_strings); === modified file 'src/nsfont.m' --- src/nsfont.m 2013-08-03 03:29:03 +0000 +++ src/nsfont.m 2013-08-09 12:25:34 +0000 @@ -920,8 +920,7 @@ font->underline_thickness = lrint (font_info->underwidth); font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil); - font->props[FONT_FULLNAME_INDEX] = - make_unibyte_string (font_info->name, strlen (font_info->name)); + font->props[FONT_FULLNAME_INDEX] = build_unibyte_string (font_info->name); } unblock_input (); === modified file 'src/sysdep.c' --- src/sysdep.c 2013-07-22 15:30:54 +0000 +++ src/sysdep.c 2013-08-09 12:25:34 +0000 @@ -3243,13 +3243,11 @@ attrs); decoded_cmd = (code_convert_string_norecord - (make_unibyte_string (pinfo.pr_fname, - strlen (pinfo.pr_fname)), + (build_unibyte_string (pinfo.pr_fname), Vlocale_coding_system, 0)); attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs); decoded_cmd = (code_convert_string_norecord - (make_unibyte_string (pinfo.pr_psargs, - strlen (pinfo.pr_psargs)), + (build_unibyte_string (pinfo.pr_psargs), Vlocale_coding_system, 0)); attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs); } @@ -3319,9 +3317,9 @@ if (gr) attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); - decoded_comm = code_convert_string_norecord - (make_unibyte_string (proc.ki_comm, strlen (proc.ki_comm)), - Vlocale_coding_system, 0); + decoded_comm = (code_convert_string_norecord + (build_unibyte_string (proc.ki_comm), + Vlocale_coding_system, 0)); attrs = Fcons (Fcons (Qcomm, decoded_comm), attrs); { === modified file 'src/w32.c' --- src/w32.c 2013-08-09 10:18:48 +0000 +++ src/w32.c 2013-08-09 12:25:34 +0000 @@ -5769,8 +5769,8 @@ { /* Decode the command name from locale-specific encoding. */ - cmd_str = make_unibyte_string (pe.szExeFile, - strlen (pe.szExeFile)); + cmd_str = build_unibyte_string (pe.szExeFile); + decoded_cmd = code_convert_string_norecord (cmd_str, Vlocale_coding_system, 0); === modified file 'src/w32fns.c' --- src/w32fns.c 2013-08-03 03:29:03 +0000 +++ src/w32fns.c 2013-08-09 12:25:34 +0000 @@ -4124,12 +4124,7 @@ for the window manager, so GC relocation won't bother it. Elsewhere we specify the window name for the window manager. */ - - { - char *str = SSDATA (Vx_resource_name); - f->namebuf = xmalloc (strlen (str) + 1); - strcpy (f->namebuf, str); - } + f->namebuf = xstrdup (SSDATA (Vx_resource_name)); my_create_window (f); @@ -4992,8 +4987,8 @@ attributes = Fcons (Fcons (Qframes, AREF (monitor_frames, i)), attributes); - name = DECODE_SYSTEM (make_unibyte_string (mi.szDevice, - strlen (mi.szDevice))); + name = DECODE_SYSTEM (build_unibyte_string (mi.szDevice)); + attributes = Fcons (Fcons (Qname, name), attributes); attributes = Fcons (Fcons (Qmm_size, list2i (width_mm, height_mm)), === modified file 'src/xdisp.c' --- src/xdisp.c 2013-08-08 14:51:07 +0000 +++ src/xdisp.c 2013-08-09 12:25:34 +0000 @@ -9789,7 +9789,7 @@ void message1 (const char *m) { - message3 (m ? make_unibyte_string (m, strlen (m)) : Qnil); + message3 (m ? build_unibyte_string (m) : Qnil); } @@ -9798,7 +9798,7 @@ void message1_nolog (const char *m) { - message3_nolog (m ? make_unibyte_string (m, strlen (m)) : Qnil); + message3_nolog (m ? build_unibyte_string (m) : Qnil); } /* Display a message M which contains a single %s === modified file 'src/xfns.c' --- src/xfns.c 2013-08-03 03:29:03 +0000 +++ src/xfns.c 2013-08-09 12:25:34 +0000 @@ -2313,12 +2313,7 @@ for the window manager, so GC relocation won't bother it. Elsewhere we specify the window name for the window manager. */ - - { - char *str = SSDATA (Vx_resource_name); - f->namebuf = xmalloc (strlen (str) + 1); - strcpy (f->namebuf, str); - } + f->namebuf = xstrdup (SSDATA (Vx_resource_name)); ac = 0; XtSetArg (al[ac], XtNallowShellResize, 1); ac++; === modified file 'src/xrdb.c' --- src/xrdb.c 2013-07-09 07:04:48 +0000 +++ src/xrdb.c 2013-08-09 12:25:34 +0000 @@ -75,18 +75,9 @@ sprintf (full_class, "%s.%s", class, "Customization"); result = x_get_string_resource (db, full_name, full_class); - - if (result) - { - char *copy = xmalloc (strlen (result) + 1); - strcpy (copy, result); - return copy; - } - else - return 0; + return result ? xstrdup (result) : NULL; } - /* Expand all the Xt-style %-escapes in STRING, whose length is given by STRING_LEN. Here are the escapes we're supposed to recognize: === modified file 'src/xterm.c' --- src/xterm.c 2013-08-08 14:51:07 +0000 +++ src/xterm.c 2013-08-09 12:25:34 +0000 @@ -8081,13 +8081,10 @@ { #ifdef HAVE_X11R6_XIM struct xim_inst_t *xim_inst = xmalloc (sizeof *xim_inst); - ptrdiff_t len; dpyinfo->xim_callback_data = xim_inst; xim_inst->dpyinfo = dpyinfo; - len = strlen (resource_name); - xim_inst->resource_name = xmalloc (len + 1); - memcpy (xim_inst->resource_name, resource_name, len + 1); + xim_inst->resource_name = xstrdup (resource_name); XRegisterIMInstantiateCallback (dpyinfo->display, dpyinfo->xrdb, resource_name, emacs_class, xim_instantiate_callback, ------------------------------------------------------------ revno: 113775 fixes bug: http://debbugs.gnu.org/15024 committer: Eli Zaretskii branch nick: trunk timestamp: Fri 2013-08-09 13:18:48 +0300 message: Define a few variables of obscure types to aid debugging exceptions on Windows. src/w32.c (PEXCEPTION_POINTERS, PEXCEPTION_RECORD, PCONTEXT): Define variables of these types so that GDB would know about them, as aid for debugging fatal exceptions. (Bug#15024) See also http://sourceware.org/ml/gdb/2013-08/msg00010.html for related discussions. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-08-08 17:52:00 +0000 +++ src/ChangeLog 2013-08-09 10:18:48 +0000 @@ -1,3 +1,11 @@ +2013-08-09 Eli Zaretskii + + * w32.c (PEXCEPTION_POINTERS, PEXCEPTION_RECORD, PCONTEXT): Define + variables of these types so that GDB would know about them, as aid + for debugging fatal exceptions. (Bug#15024) See also + http://sourceware.org/ml/gdb/2013-08/msg00010.html for related + discussions. + 2013-08-08 Jan Djärv * nsterm.m (ns_update_begin): Don't change clip path if it would be === modified file 'src/w32.c' --- src/w32.c 2013-08-04 15:43:10 +0000 +++ src/w32.c 2013-08-09 10:18:48 +0000 @@ -89,6 +89,21 @@ DWORDLONG ullAvailExtendedVirtual; } MEMORY_STATUS_EX,*LPMEMORY_STATUS_EX; +/* These are here so that GDB would know about these data types. This + allows to attach GDB to Emacs when a fatal exception is triggered + and Windows pops up the "application needs to be closed" dialog. + At that point, _gnu_exception_handler, the top-level exception + handler installed by the MinGW startup code, is somewhere on the + call-stack of the main thread, so going to that call frame and + looking at the argument to _gnu_exception_handler, which is a + PEXCEPTION_POINTERS pointer, can reveal the exception code + (excptr->ExceptionRecord->ExceptionCode) and the address where the + exception happened (excptr->ExceptionRecord->ExceptionAddress), as + well as some additional information specific to the exception. */ +PEXCEPTION_POINTERS excptr; +PEXCEPTION_RECORD excprec; +PCONTEXT ctxrec; + #include #include ------------------------------------------------------------ revno: 113774 committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2013-08-09 09:17:25 +0000 message: lisp/gnus/mm-decode.el (mm-temp-files-delete): Fix last commit diff: === modified file 'lisp/gnus/mm-decode.el' --- lisp/gnus/mm-decode.el 2013-08-09 08:05:56 +0000 +++ lisp/gnus/mm-decode.el 2013-08-09 09:17:25 +0000 @@ -629,7 +629,8 @@ nil cache-file nil 'silent) (set-file-modes cache-file #o600)) (when (file-exists-p cache-file) - (ignore-errors (delete-file cache-file)))))) + (ignore-errors (delete-file cache-file)))) + (setq mm-temp-files-to-be-deleted nil))) (autoload 'message-fetch-field "message") ------------------------------------------------------------ revno: 113773 committer: Katsumi Yamaoka branch nick: trunk timestamp: Fri 2013-08-09 08:05:56 +0000 message: Gnus: delete temporary files when Gnus exits instead of using timers lisp/gnus/mm-decode.el (mm-temp-files-to-be-deleted, mm-temp-files-cache-file): New internal variables. (mm-temp-files-delete): New function; add it to gnus-exit-gnus-hook. (mm-display-external): Use it to delete temporary files instead of using timers. diff: === modified file 'lisp/gnus/ChangeLog' --- lisp/gnus/ChangeLog 2013-08-06 22:09:27 +0000 +++ lisp/gnus/ChangeLog 2013-08-09 08:05:56 +0000 @@ -1,3 +1,11 @@ +2013-08-09 Katsumi Yamaoka + + * mm-decode.el (mm-temp-files-to-be-deleted, mm-temp-files-cache-file): + New internal variables. + (mm-temp-files-delete): New function; add it to gnus-exit-gnus-hook. + (mm-display-external): Use it to delete temporary files instead of + using timers. + 2013-08-06 Jan Tatarik * gnus-icalendar.el (gnus-icalendar-event-from-ical): Replace pcase === modified file 'lisp/gnus/mm-decode.el' --- lisp/gnus/mm-decode.el 2013-08-06 13:52:59 +0000 +++ lisp/gnus/mm-decode.el 2013-08-09 08:05:56 +0000 @@ -47,6 +47,7 @@ (defvar gnus-current-window-configuration) (add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list) +(add-hook 'gnus-exit-gnus-hook 'mm-temp-files-delete) (defgroup mime-display () "Display of MIME in mail and news articles." @@ -470,6 +471,11 @@ (defvar mm-content-id-alist nil) (defvar mm-postponed-undisplay-list nil) (defvar mm-inhibit-auto-detect-attachment nil) +(defvar mm-temp-files-to-be-deleted nil + "List of temporary files scheduled to be deleted.") +(defvar mm-temp-files-cache-file (concat ".mm-temp-files-" (user-login-name)) + "Name of a file that caches a list of temporary files to be deleted. +The file will be saved in the directory `mm-tmp-directory'.") ;; According to RFC2046, in particular, in a digest, the default ;; Content-Type value for a body part is changed from "text/plain" to @@ -586,6 +592,45 @@ (message "Destroying external MIME viewers") (mm-destroy-parts mm-postponed-undisplay-list))) +(defun mm-temp-files-delete () + "Delete temporary files and those parent directories. +Note that the deletion may fail if a program is catching hold of a file +under Windows or Cygwin. In that case, it schedules the deletion of +files left at the next time." + (let* ((coding-system-for-read mm-universal-coding-system) + (coding-system-for-write mm-universal-coding-system) + (cache-file (expand-file-name mm-temp-files-cache-file + mm-tmp-directory)) + (cache (when (file-exists-p cache-file) + (mm-with-multibyte-buffer + (insert-file-contents cache-file) + (split-string (buffer-string) "\n" t)))) + fails) + (dolist (temp (append cache mm-temp-files-to-be-deleted)) + (unless (and (file-exists-p temp) + (if (file-directory-p temp) + ;; A parent directory left at the previous time. + (progn + (ignore-errors (delete-directory temp)) + (not (file-exists-p temp))) + ;; Delete a temporary file and its parent directory. + (ignore-errors (delete-file temp)) + (and (not (file-exists-p temp)) + (progn + (setq temp (file-name-directory temp)) + (ignore-errors (delete-directory temp)) + (not (file-exists-p temp)))))) + (push temp fails))) + (if fails + ;; Schedule the deletion of the files left at the next time. + (progn + (write-region (concat (mapconcat 'identity (nreverse fails) "\n") + "\n") + nil cache-file nil 'silent) + (set-file-modes cache-file #o600)) + (when (file-exists-p cache-file) + (ignore-errors (delete-file cache-file)))))) + (autoload 'message-fetch-field "message") (defun mm-dissect-buffer (&optional no-strict-mime loose-mime from) @@ -975,22 +1020,8 @@ (buffer buffer) (command command) (handle handle)) - (run-at-time - 30.0 nil - (lambda () - (ignore-errors - (delete-file file)) - (ignore-errors - (delete-directory (file-name-directory file))))) (lambda (process state) (when (eq (process-status process) 'exit) - (run-at-time - 10.0 nil - (lambda () - (ignore-errors - (delete-file file)) - (ignore-errors - (delete-directory (file-name-directory file))))) (when (buffer-live-p outbuf) (with-current-buffer outbuf (let ((buffer-read-only nil) @@ -1007,7 +1038,8 @@ (kill-buffer buffer))) (message "Displaying %s...done" command))))) (mm-handle-set-external-undisplayer - handle (cons file buffer))) + handle (cons file buffer)) + (add-to-list 'mm-temp-files-to-be-deleted file t)) (message "Displaying %s..." command)) 'external))))))) ------------------------------------------------------------ revno: 113772 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15010 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2013-08-08 21:19:42 -0400 message: * lisp/emacs-lisp/checkdoc.el: Remove redundant :group keywords. Use #' instead of ' to quote functions. (checkdoc-output-mode): Use setq-local. (checkdoc-spellcheck-documentation-flag, checkdoc-ispell-lisp-words) (checkdoc-verb-check-experimental-flag, checkdoc-proper-noun-regexp) (checkdoc-common-verbs-regexp): Mark safe-local-variable. (checkdoc-ispell, checkdoc-ispell-current-buffer) (checkdoc-ispell-interactive, checkdoc-ispell-message-interactive) (checkdoc-ispell-message-text, checkdoc-ispell-start) (checkdoc-ispell-continue, checkdoc-ispell-comments) (checkdoc-ispell-defun): Remove unused arg `take-notes'. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-08-09 00:54:22 +0000 +++ lisp/ChangeLog 2013-08-09 01:19:42 +0000 @@ -1,5 +1,17 @@ 2013-08-09 Stefan Monnier + * emacs-lisp/checkdoc.el: Remove redundant :group keywords. + Use #' instead of ' to quote functions. + (checkdoc-output-mode): Use setq-local. + (checkdoc-spellcheck-documentation-flag, checkdoc-ispell-lisp-words) + (checkdoc-verb-check-experimental-flag, checkdoc-proper-noun-regexp) + (checkdoc-common-verbs-regexp): Mark safe-local-variable (bug#15010). + (checkdoc-ispell, checkdoc-ispell-current-buffer) + (checkdoc-ispell-interactive, checkdoc-ispell-message-interactive) + (checkdoc-ispell-message-text, checkdoc-ispell-start) + (checkdoc-ispell-continue, checkdoc-ispell-comments) + (checkdoc-ispell-defun): Remove unused arg `take-notes'. + * ido.el (ido-completion-help): Fix up compiler warning. 2013-08-09 Juanma Barranquero === modified file 'lisp/emacs-lisp/checkdoc.el' --- lisp/emacs-lisp/checkdoc.el 2013-05-23 05:01:59 +0000 +++ lisp/emacs-lisp/checkdoc.el 2013-08-09 01:19:42 +0000 @@ -186,7 +186,6 @@ (defcustom checkdoc-minor-mode-string " CDoc" "String to display in mode line when Checkdoc mode is enabled; nil for none." :type '(choice string (const :tag "None" nil)) - :group 'checkdoc :version "23.1") (defcustom checkdoc-autofix-flag 'semiautomatic @@ -197,7 +196,6 @@ is `semiautomatic' or any other value, then simple fixes are made without asking, and complex changes are made by asking the user first. The value `never' is the same as nil, never ask or change anything." - :group 'checkdoc :type '(choice (const automatic) (const query) (const never) @@ -207,7 +205,6 @@ "Non-nil means to \"bounce\" to auto-fix locations. Setting this to nil will silently make fixes that require no user interaction. See `checkdoc-autofix-flag' for auto-fixing details." - :group 'checkdoc :type 'boolean) (defcustom checkdoc-force-docstrings-flag t @@ -215,16 +212,14 @@ Style guide dictates that interactive functions MUST have documentation, and that it's good but not required practice to make non user visible items have doc strings." - :group 'checkdoc :type 'boolean) -;;;###autoload(put 'checkdoc-force-docstrings-flag 'safe-local-variable 'booleanp) +;;;###autoload(put 'checkdoc-force-docstrings-flag 'safe-local-variable #'booleanp) (defcustom checkdoc-force-history-flag nil "Non-nil means that files should have a History section or ChangeLog file. This helps document the evolution of, and recent changes to, the package." - :group 'checkdoc :type 'boolean) -;;;###autoload(put 'checkdoc-force-history-flag 'safe-local-variable 'booleanp) +;;;###autoload(put 'checkdoc-force-history-flag 'safe-local-variable #'booleanp) (defcustom checkdoc-permit-comma-termination-flag nil "Non-nil means the first line of a docstring may end with a comma. @@ -232,9 +227,8 @@ there is a substantial caveat to the one-line description -- the comma should be used when the first part could stand alone as a sentence, but it indicates that a modifying clause follows." - :group 'checkdoc :type 'boolean) -;;;###autoload(put 'checkdoc-permit-comma-termination-flag 'safe-local-variable 'booleanp) +;;;###autoload(put 'checkdoc-permit-comma-termination-flag 'safe-local-variable #'booleanp) (defcustom checkdoc-spellcheck-documentation-flag nil "Non-nil means run Ispell on text based on value. @@ -246,22 +240,22 @@ buffer - Spell-check when style checking the whole buffer interactive - Spell-check during any interactive check. t - Always spell-check" - :group 'checkdoc :type '(choice (const nil) (const defun) (const buffer) (const interactive) (const t))) +;;;###autoload(put 'checkdoc-spellcheck-documentation-flag 'safe-local-variable #'booleanp) (defvar checkdoc-ispell-lisp-words '("alist" "emacs" "etags" "keymap" "paren" "regexp" "sexp" "xemacs") "List of words that are correct when spell-checking Lisp documentation.") +;;;###autoload(put 'checkdoc-ispell-list-words 'safe-local-variable #'checkdoc-list-of-strings-p) (defcustom checkdoc-max-keyref-before-warn 10 "The number of \\ [command-to-keystroke] tokens allowed in a doc string. Any more than this and a warning is generated suggesting that the construct \\ {keymap} be used instead." - :group 'checkdoc :type 'integer) (defcustom checkdoc-arguments-in-order-flag t @@ -270,9 +264,8 @@ appear in the proper form in the documentation, not that they are in the same order as they appear in the argument list. No mention is made in the style guide relating to order." - :group 'checkdoc :type 'boolean) -;;;###autoload(put 'checkdoc-arguments-in-order-flag 'safe-local-variable 'booleanp) +;;;###autoload(put 'checkdoc-arguments-in-order-flag 'safe-local-variable #'booleanp) (define-obsolete-variable-alias 'checkdoc-style-hooks 'checkdoc-style-functions "24.3") @@ -305,8 +298,8 @@ "Non-nil means to attempt to check the voice of the doc string. This check keys off some words which are commonly misused. See the variable `checkdoc-common-verbs-wrong-voice' if you wish to add your own." - :group 'checkdoc :type 'boolean) +;;;###autoload(put 'checkdoc-verb-check-experimental-flag 'safe-local-variable #'booleanp) (defvar checkdoc-generate-compile-warnings-flag nil "Non-nil means generate warnings in a buffer for browsing. @@ -317,16 +310,15 @@ "A list of symbol names (strings) which also happen to make good words. These words are ignored when unquoted symbols are searched for. This should be set in an Emacs Lisp file's local variables." - :group 'checkdoc :type '(repeat (symbol :tag "Word"))) -;;;###autoload(put 'checkdoc-symbol-words 'safe-local-variable 'checkdoc-list-of-strings-p) +;;;###autoload(put 'checkdoc-symbol-words 'safe-local-variable #'checkdoc-list-of-strings-p) ;;;###autoload (defun checkdoc-list-of-strings-p (obj) ;; this is a function so it might be shared by checkdoc-proper-noun-list ;; and/or checkdoc-ispell-lisp-words in the future (and (listp obj) - (not (memq nil (mapcar 'stringp obj))))) + (not (memq nil (mapcar #'stringp obj))))) (defvar checkdoc-proper-noun-list '("ispell" "xemacs" "emacs" "lisp") @@ -340,9 +332,11 @@ (regexp-opt checkdoc-proper-noun-list t) "\\(\\_>\\|[.!?][ \t\n\"]\\)") "Regular expression derived from `checkdoc-proper-noun-regexp'.") +;;;###autoload(put 'checkdoc-proper-noun-regexp 'safe-local-variable 'stringp) (defvar checkdoc-common-verbs-regexp nil "Regular expression derived from `checkdoc-common-verbs-regexp'.") +;;;###autoload(put 'checkdoc-common-verbs-regexp 'safe-local-variable 'stringp) (defvar checkdoc-common-verbs-wrong-voice '(("adds" . "add") @@ -443,19 +437,19 @@ ;;; Compatibility ;; (defalias 'checkdoc-make-overlay - (if (featurep 'xemacs) 'make-extent 'make-overlay)) + (if (featurep 'xemacs) #'make-extent #'make-overlay)) (defalias 'checkdoc-overlay-put - (if (featurep 'xemacs) 'set-extent-property 'overlay-put)) + (if (featurep 'xemacs) #'set-extent-property #'overlay-put)) (defalias 'checkdoc-delete-overlay - (if (featurep 'xemacs) 'delete-extent 'delete-overlay)) + (if (featurep 'xemacs) #'delete-extent #'delete-overlay)) (defalias 'checkdoc-overlay-start - (if (featurep 'xemacs) 'extent-start 'overlay-start)) + (if (featurep 'xemacs) #'extent-start #'overlay-start)) (defalias 'checkdoc-overlay-end - (if (featurep 'xemacs) 'extent-end 'overlay-end)) + (if (featurep 'xemacs) #'extent-end #'overlay-end)) (defalias 'checkdoc-mode-line-update - (if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update)) + (if (featurep 'xemacs) #'redraw-modeline #'force-mode-line-update)) (defalias 'checkdoc-char= - (if (featurep 'xemacs) 'char= '=)) + (if (featurep 'xemacs) #'char= #'=)) ;;; User level commands ;; @@ -540,7 +534,7 @@ ;; Due to a design flaw, this will never spell check ;; docstrings. (checkdoc-interactive-loop start-here showstatus - 'checkdoc-next-error) + #'checkdoc-next-error) ;; This is a workaround to perform spell checking. (checkdoc-interactive-ispell-loop start-here)))) @@ -560,7 +554,7 @@ (prog1 ;; Due to a design flaw, this will never spell check messages. (checkdoc-interactive-loop start-here showstatus - 'checkdoc-next-message-error) + #'checkdoc-next-message-error) ;; This is a workaround to perform spell checking. (checkdoc-message-interactive-ispell-loop start-here)))) @@ -639,7 +633,7 @@ (goto-char (cdr (car err-list))) ;; `automatic-then-never' tells the autofix function ;; to only allow one fix to be automatic. The autofix - ;; function will then set the flag to 'never, allowing + ;; function will then set the flag to `never', allowing ;; the checker to return a different error. (let ((checkdoc-autofix-flag 'automatic-then-never) (fixed nil)) @@ -1004,7 +998,7 @@ documentation is checked. If there is a documentation error, then the display of what was evaluated will be overwritten by the diagnostic message." (interactive) - (call-interactively 'eval-defun) + (call-interactively #'eval-defun) (checkdoc-defun)) ;;;###autoload @@ -1046,85 +1040,86 @@ ;; ;;;###autoload -(defun checkdoc-ispell (&optional take-notes) +(defun checkdoc-ispell () "Check the style and spelling of everything interactively. Calls `checkdoc' with spell-checking turned on. -Prefix argument TAKE-NOTES is the same as for `checkdoc'" +Prefix argument is the same as for `checkdoc'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively 'checkdoc nil current-prefix-arg))) + (call-interactively #'checkdoc nil current-prefix-arg))) ;;;###autoload -(defun checkdoc-ispell-current-buffer (&optional take-notes) +(defun checkdoc-ispell-current-buffer () "Check the style and spelling of the current buffer. Calls `checkdoc-current-buffer' with spell-checking turned on. -Prefix argument TAKE-NOTES is the same as for `checkdoc-current-buffer'" +Prefix argument is the same as for `checkdoc-current-buffer'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively 'checkdoc-current-buffer nil current-prefix-arg))) + (call-interactively #'checkdoc-current-buffer nil current-prefix-arg))) ;;;###autoload -(defun checkdoc-ispell-interactive (&optional take-notes) +(defun checkdoc-ispell-interactive () "Check the style and spelling of the current buffer interactively. Calls `checkdoc-interactive' with spell-checking turned on. -Prefix argument TAKE-NOTES is the same as for `checkdoc-interactive'" +Prefix argument is the same as for `checkdoc-interactive'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively 'checkdoc-interactive nil current-prefix-arg))) + (call-interactively #'checkdoc-interactive nil current-prefix-arg))) ;;;###autoload -(defun checkdoc-ispell-message-interactive (&optional take-notes) +(defun checkdoc-ispell-message-interactive () "Check the style and spelling of message text interactively. Calls `checkdoc-message-interactive' with spell-checking turned on. -Prefix argument TAKE-NOTES is the same as for `checkdoc-message-interactive'" +Prefix argument is the same as for `checkdoc-message-interactive'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively 'checkdoc-message-interactive nil current-prefix-arg))) + (call-interactively #'checkdoc-message-interactive + nil current-prefix-arg))) ;;;###autoload -(defun checkdoc-ispell-message-text (&optional take-notes) +(defun checkdoc-ispell-message-text () "Check the style and spelling of message text interactively. Calls `checkdoc-message-text' with spell-checking turned on. -Prefix argument TAKE-NOTES is the same as for `checkdoc-message-text'" +Prefix argument is the same as for `checkdoc-message-text'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively 'checkdoc-message-text nil current-prefix-arg))) + (call-interactively #'checkdoc-message-text nil current-prefix-arg))) ;;;###autoload -(defun checkdoc-ispell-start (&optional take-notes) +(defun checkdoc-ispell-start () "Check the style and spelling of the current buffer. Calls `checkdoc-start' with spell-checking turned on. -Prefix argument TAKE-NOTES is the same as for `checkdoc-start'" +Prefix argument is the same as for `checkdoc-start'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively 'checkdoc-start nil current-prefix-arg))) + (call-interactively #'checkdoc-start nil current-prefix-arg))) ;;;###autoload -(defun checkdoc-ispell-continue (&optional take-notes) +(defun checkdoc-ispell-continue () "Check the style and spelling of the current buffer after point. Calls `checkdoc-continue' with spell-checking turned on. -Prefix argument TAKE-NOTES is the same as for `checkdoc-continue'" +Prefix argument is the same as for `checkdoc-continue'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively 'checkdoc-continue nil current-prefix-arg))) + (call-interactively #'checkdoc-continue nil current-prefix-arg))) ;;;###autoload -(defun checkdoc-ispell-comments (&optional take-notes) +(defun checkdoc-ispell-comments () "Check the style and spelling of the current buffer's comments. Calls `checkdoc-comments' with spell-checking turned on. -Prefix argument TAKE-NOTES is the same as for `checkdoc-comments'" +Prefix argument is the same as for `checkdoc-comments'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively 'checkdoc-comments nil current-prefix-arg))) + (call-interactively #'checkdoc-comments nil current-prefix-arg))) ;;;###autoload -(defun checkdoc-ispell-defun (&optional take-notes) +(defun checkdoc-ispell-defun () "Check the style and spelling of the current defun with Ispell. Calls `checkdoc-defun' with spell-checking turned on. -Prefix argument TAKE-NOTES is the same as for `checkdoc-defun'" +Prefix argument is the same as for `checkdoc-defun'" (interactive) (let ((checkdoc-spellcheck-documentation-flag t)) - (call-interactively 'checkdoc-defun nil current-prefix-arg))) + (call-interactively #'checkdoc-defun nil current-prefix-arg))) ;;; Error Management ;; @@ -1254,10 +1249,10 @@ (defsubst checkdoc-run-hooks (hookvar &rest args) "Run hooks in HOOKVAR with ARGS." (if (fboundp 'run-hook-with-args-until-success) - (apply 'run-hook-with-args-until-success hookvar args) + (apply #'run-hook-with-args-until-success hookvar args) ;; This method was similar to above. We ignore the warning ;; since we will use the above for future Emacs versions - (apply 'run-hook-with-args hookvar args))) + (apply #'run-hook-with-args hookvar args))) (defsubst checkdoc-create-common-verbs-regexp () "Rebuild the contents of `checkdoc-common-verbs-regexp'." @@ -2198,8 +2193,8 @@ nil (require 'lisp-mnt) ;; Old XEmacs don't have `lm-commentary-mark' - (if (and (not (fboundp 'lm-commentary-mark)) (boundp 'lm-commentary)) - (defalias 'lm-commentary-mark 'lm-commentary))) + (if (and (not (fboundp 'lm-commentary-mark)) (fboundp 'lm-commentary)) + (defalias 'lm-commentary-mark #'lm-commentary))) (save-excursion (let* ((f1 (file-name-nondirectory (buffer-file-name))) (fn (file-name-sans-extension f1)) @@ -2260,8 +2255,7 @@ (if (or (not checkdoc-force-history-flag) (file-exists-p "ChangeLog") (file-exists-p "../ChangeLog") - (let ((fn 'lm-history-mark)) ;bestill byte-compiler - (and (fboundp fn) (funcall fn)))) + (and (fboundp 'lm-history-mark) (funcall #'lm-history-mark))) nil (progn (goto-char (or (lm-commentary-mark) (point-min))) @@ -2585,10 +2579,10 @@ (define-derived-mode checkdoc-output-mode compilation-mode "Checkdoc" "Set up the major mode for the buffer containing the list of errors." - (set (make-local-variable 'compilation-error-regexp-alist) - checkdoc-output-error-regex-alist) - (set (make-local-variable 'compilation-mode-font-lock-keywords) - checkdoc-output-font-lock-keywords)) + (setq-local compilation-error-regexp-alist + checkdoc-output-error-regex-alist) + (setq-local compilation-mode-font-lock-keywords + checkdoc-output-font-lock-keywords)) (defun checkdoc-buffer-label () "The name to use for a checkdoc buffer in the error list." @@ -2620,7 +2614,7 @@ (with-current-buffer (get-buffer checkdoc-diagnostic-buffer) (goto-char (point-max)) (let ((inhibit-read-only t)) - (apply 'insert text))))) + (apply #'insert text))))) (defun checkdoc-show-diagnostics () "Display the checkdoc diagnostic buffer in a temporary window."