diff options
| author | Andrea Corallo <akrl@sdf.org> | 2021-02-10 21:56:55 +0100 |
|---|---|---|
| committer | Andrea Corallo <akrl@sdf.org> | 2021-02-10 21:56:55 +0100 |
| commit | 2fcb85c3e780f1f2871ce0f300cfaffce9836eb0 (patch) | |
| tree | a8857ccad8bff12080062a3edaad1a55a3eb8171 /lisp | |
| parent | 1f626e9662d8120acd5a937f847123cc2b8c6e31 (diff) | |
| parent | 6bfdfeed36fab4680c8db90c22da8f6611694186 (diff) | |
| download | emacs-2fcb85c3e780f1f2871ce0f300cfaffce9836eb0.tar.gz emacs-2fcb85c3e780f1f2871ce0f300cfaffce9836eb0.tar.bz2 emacs-2fcb85c3e780f1f2871ce0f300cfaffce9836eb0.zip | |
Merge remote-tracking branch 'savannah/master' into HEAD
Diffstat (limited to 'lisp')
374 files changed, 6100 insertions, 6485 deletions
diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 65f71183856..54783db2c3e 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -516,9 +516,8 @@ It is nil if the abbrev has already been unexpanded.") (defvar last-abbrev-location 0 "The location of the start of the last abbrev expanded.") -;; (defvar local-abbrev-table fundamental-mode-abbrev-table +;; (defvar-local local-abbrev-table fundamental-mode-abbrev-table ;; "Local (mode-specific) abbrev table of current buffer.") -;; (make-variable-buffer-local 'local-abbrev-table) (defun clear-abbrev-table (table) "Undefine all abbrevs in abbrev table TABLE, leaving it empty." diff --git a/lisp/align.el b/lisp/align.el index 1318b735c05..1a1d3dd7ec1 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -424,7 +424,7 @@ The possible settings for `align-region-separate' are: (backward-word 1) (looking-at "\\(goto\\|return\\|new\\|delete\\|throw\\)")) - (if (and (boundp 'font-lock-mode) font-lock-mode) + (if font-lock-mode (eq (get-text-property (point) 'face) 'font-lock-comment-face) (eq (caar (c-guess-basic-syntax)) 'c))))))) @@ -775,18 +775,14 @@ See the documentation for `align-rules-list' for more info." ;;; Internal Variables: -(defvar align-mode-rules-list nil +(defvar-local align-mode-rules-list nil "Alignment rules specific to the current major mode. See the variable `align-rules-list' for more details.") -(make-variable-buffer-local 'align-mode-rules-list) - -(defvar align-mode-exclude-rules-list nil +(defvar-local align-mode-exclude-rules-list nil "Alignment exclusion rules specific to the current major mode. See the variable `align-exclude-rules-list' for more details.") -(make-variable-buffer-local 'align-mode-exclude-rules-list) - (defvar align-highlight-overlays nil "The current overlays highlighting the text matched by a rule.") diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index d31083e4271..f251be8dfb9 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -78,9 +78,8 @@ ;;; during file load, so the involved code must reside above that ;;; definition in the file. ;;;_ = allout-widgets-mode -(defvar allout-widgets-mode nil +(defvar-local allout-widgets-mode nil "Allout mode enhanced with graphical widgets.") -(make-variable-buffer-local 'allout-widgets-mode) ;;;_ : USER CUSTOMIZATION VARIABLES and incidental functions: ;;;_ > defgroup allout-widgets @@ -243,14 +242,13 @@ decreases as obsolete widgets are garbage collected." :version "24.1" :type 'boolean :group 'allout-widgets-developer) -(defvar allout-widgets-tally nil +(defvar-local allout-widgets-tally nil "Hash-table of existing allout widgets, for debugging. Table is maintained only if `allout-widgets-maintain-tally' is non-nil. The table contents will be out of sync if any widgets are created or deleted while this variable is nil.") -(make-variable-buffer-local 'allout-widgets-tally) (defvar allout-widgets-mode-inhibit) ; defined below ;;;_ > allout-widgets-tally-string (defun allout-widgets-tally-string () @@ -295,7 +293,7 @@ to publicize it by making it a customization variable)." (message "%s" msg) msg)) ;;;_ = allout-widgets-mode-inhibit -(defvar allout-widgets-mode-inhibit nil +(defvar-local allout-widgets-mode-inhibit nil "Inhibit `allout-widgets-mode' from activating widgets. This also inhibits automatic adjustment of widgets to track allout outline @@ -310,15 +308,13 @@ buffers where this is set to enable and disable widget enhancements, directly.") ;;;###autoload (put 'allout-widgets-mode-inhibit 'safe-local-variable 'booleanp) -(make-variable-buffer-local 'allout-widgets-mode-inhibit) ;;;_ = allout-inhibit-body-modification-hook -(defvar allout-inhibit-body-modification-hook nil +(defvar-local allout-inhibit-body-modification-hook nil "Override de-escaping of text-prefixes in item bodies during specific changes. This is used by `allout-buffer-modification-handler' to signal such changes to `allout-body-modification-handler', and is always reset by `allout-post-command-business'.") -(make-variable-buffer-local 'allout-inhibit-body-modification-hook) ;;;_ = allout-widgets-icons-cache (defvar allout-widgets-icons-cache nil "Cache allout icon images, as an association list. @@ -358,7 +354,7 @@ See \\[describe-mode] for many more options." The structure includes the guides lines, bullet, and bullet cue.") ;;;_ = allout-widgets-changes-record -(defvar allout-widgets-changes-record nil +(defvar-local allout-widgets-changes-record nil "Record outline changes for processing by post-command hook. Entries on the list are lists whose first element is a symbol indicating @@ -369,14 +365,12 @@ type. For example: The changes are recorded in reverse order, with new values pushed onto the front.") -(make-variable-buffer-local 'allout-widgets-changes-record) ;;;_ = allout-widgets-undo-exposure-record -(defvar allout-widgets-undo-exposure-record nil +(defvar-local allout-widgets-undo-exposure-record nil "Record outline undo traces for processing by post-command hook. The changes are recorded in reverse order, with new values pushed onto the front.") -(make-variable-buffer-local 'allout-widgets-undo-exposure-record) ;;;_ = allout-widgets-last-hook-error (defvar allout-widgets-last-hook-error nil "String holding last error string, for debugging purposes.") @@ -393,13 +387,12 @@ onto the front.") "Maintained true during `allout-widgets-exposure-undo-processor'") ;;;_ , Widget-specific outline text format ;;;_ = allout-escaped-prefix-regexp -(defvar allout-escaped-prefix-regexp "" +(defvar-local allout-escaped-prefix-regexp "" "Regular expression for body text that would look like an item prefix if not altered with an escape sequence.") -(make-variable-buffer-local 'allout-escaped-prefix-regexp) ;;;_ , Widget element formatting ;;;_ = allout-item-icon-keymap -(defvar allout-item-icon-keymap +(defvar-local allout-item-icon-keymap (let ((km (make-sparse-keymap)) (as-parent (if (current-local-map) (make-composed-keymap (current-local-map) @@ -420,9 +413,8 @@ not altered with an escape sequence.") km) "General tree-node key bindings.") -(make-variable-buffer-local 'allout-item-icon-keymap) ;;;_ = allout-item-body-keymap -(defvar allout-item-body-keymap +(defvar-local allout-item-body-keymap (let ((km (make-sparse-keymap)) (as-parent (if (current-local-map) (make-composed-keymap (current-local-map) @@ -432,17 +424,15 @@ not altered with an escape sequence.") (set-keymap-parent km as-parent) km) "General key bindings for the text content of outline items.") -(make-variable-buffer-local 'allout-item-body-keymap) ;;;_ = allout-body-span-category (defvar allout-body-span-category nil "Symbol carrying allout body-text overlay properties.") ;;;_ = allout-cue-span-keymap -(defvar allout-cue-span-keymap +(defvar-local allout-cue-span-keymap (let ((km (make-sparse-keymap))) (set-keymap-parent km allout-item-icon-keymap) km) "Keymap used in the item cue area - the space between the icon and headline.") -(make-variable-buffer-local 'allout-cue-span-keymap) ;;;_ = allout-escapes-category (defvar allout-escapes-category nil "Symbol for category of text property used to hide escapes of prefix-like @@ -477,7 +467,7 @@ including things like: (defvar allout-trailing-category nil "Symbol carrying common properties of an overlay's trailing newline.") ;;;_ , Developer -(defvar allout-widgets-last-decoration-timing nil +(defvar-local allout-widgets-last-decoration-timing nil "Timing details for the last cooperative decoration action. This is maintained when `allout-widgets-time-decoration-activity' is set. @@ -488,7 +478,6 @@ The value is a list containing two elements: When active, the value is revised each time automatic decoration activity happens in the buffer.") -(make-variable-buffer-local 'allout-widgets-last-decoration-timing) ;;;_ . mode hookup ;;;_ > define-minor-mode allout-widgets-mode (arg) ;;;###autoload @@ -693,12 +682,11 @@ outline hot-spot navigation (see `allout-mode')." (allout-get-or-create-item-widget)))))) ;;;_ . settings context ;;;_ = allout-container-item -(defvar allout-container-item-widget nil +(defvar-local allout-container-item-widget nil "A widget for the current outline's overarching container as an item. The item has settings (of the file/connection) and maybe a body, but no icon/bullet.") -(make-variable-buffer-local 'allout-container-item-widget) ;;;_ . Hooks and hook helpers ;;;_ , major command-loop business: ;;;_ > allout-widgets-pre-command-business (&optional recursing) @@ -2243,7 +2231,7 @@ interactive command." We use a caching strategy, so the caller doesn't need to do so." (let* ((types allout-widgets-icon-types) - (use-dir (if (equal (allout-frame-property nil 'background-mode) + (use-dir (if (equal (frame-parameter nil 'background-mode) 'light) allout-widgets-icons-light-subdir allout-widgets-icons-dark-subdir)) @@ -2274,13 +2262,6 @@ We use a caching strategy, so the caller doesn't need to do so." "Return seconds between START/END time values." (let ((elapsed (time-subtract end start))) (float-time elapsed))) -;;;_ > allout-frame-property (frame property) -(defalias 'allout-frame-property - (cond ((fboundp 'frame-parameter) - 'frame-parameter) - ((fboundp 'frame-property) - 'frame-property) - (t nil))) ;;;_ > allout-find-image (specs) (define-obsolete-function-alias 'allout-find-image #'find-image "28.1") ;;;_ > allout-widgets-copy-list (list) @@ -2307,6 +2288,8 @@ The elements of LIST are not copied, just the list structure itself." (overlays-in start end))))) (length button-overlays))) +(define-obsolete-function-alias 'allout-frame-property #'frame-parameter "28.1") + ;;;_ : provide (provide 'allout-widgets) diff --git a/lisp/allout.el b/lisp/allout.el index 39aa29b664a..ff0b67556e0 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -830,9 +830,8 @@ such topics are encrypted.)" The value of `buffer-saved-size' at the time of decryption is used, for restoring when all encryptions are established.") -(defvar allout-just-did-undo nil +(defvar-local allout-just-did-undo nil "True just after undo commands, until allout-post-command-business.") -(make-variable-buffer-local 'allout-just-did-undo) ;;;_ + Developer ;;;_ = allout-developer group @@ -874,10 +873,10 @@ For details, see `allout-toggle-current-subtree-encryption's docstring." msg)) ;;;_ : Mode activation (defined here because it's referenced early) ;;;_ = allout-mode -(defvar allout-mode nil "Allout outline mode minor-mode flag.") -(make-variable-buffer-local 'allout-mode) +(defvar-local allout-mode nil + "Allout outline mode minor-mode flag.") ;;;_ = allout-layout nil -(defvar allout-layout nil ; LEAVE GLOBAL VALUE NIL -- see docstring. +(defvar-local allout-layout nil ; LEAVE GLOBAL VALUE NIL -- see docstring. "Buffer-specific setting for allout layout. In buffers where this is non-nil (and if `allout-auto-activation' @@ -903,34 +902,30 @@ followed by the equivalent of `(allout-expose-topic 0 : -1 -1 0)'. `allout-default-layout' describes the specification format. `allout-layout' can additionally have the value t, in which case the value of `allout-default-layout' is used.") -(make-variable-buffer-local 'allout-layout) ;;;###autoload (put 'allout-layout 'safe-local-variable (lambda (x) (or (numberp x) (listp x) (memq x '(: * + -))))) ;;;_ : Topic header format ;;;_ = allout-regexp -(defvar allout-regexp "" +(defvar-local allout-regexp "" "Regular expression to match the beginning of a heading line. Any line whose beginning matches this regexp is considered a heading. This var is set according to the user configuration vars by `allout-set-regexp'.") -(make-variable-buffer-local 'allout-regexp) ;;;_ = allout-bullets-string -(defvar allout-bullets-string "" +(defvar-local allout-bullets-string "" "A string dictating the valid set of outline topic bullets. This var should *not* be set by the user -- it is set by `allout-set-regexp', and is produced from the elements of `allout-plain-bullets-string' and `allout-distinctive-bullets-string'.") -(make-variable-buffer-local 'allout-bullets-string) ;;;_ = allout-bullets-string-len -(defvar allout-bullets-string-len 0 +(defvar-local allout-bullets-string-len 0 "Length of current buffers' `allout-plain-bullets-string'.") -(make-variable-buffer-local 'allout-bullets-string-len) ;;;_ = allout-depth-specific-regexp -(defvar allout-depth-specific-regexp "" +(defvar-local allout-depth-specific-regexp "" "Regular expression to match a heading line prefix for a particular depth. This expression is used to search for depth-specific topic @@ -941,34 +936,28 @@ This var is set according to the user configuration vars by `allout-set-regexp'. It is prepared with format strings for two decimal numbers, which should each be one less than the depth of the topic prefix to be matched.") -(make-variable-buffer-local 'allout-depth-specific-regexp) ;;;_ = allout-depth-one-regexp -(defvar allout-depth-one-regexp "" +(defvar-local allout-depth-one-regexp "" "Regular expression to match a heading line prefix for depth one. This var is set according to the user configuration vars by `allout-set-regexp'. It is prepared with format strings for two decimal numbers, which should each be one less than the depth of the topic prefix to be matched.") -(make-variable-buffer-local 'allout-depth-one-regexp) ;;;_ = allout-line-boundary-regexp -(defvar allout-line-boundary-regexp () +(defvar-local allout-line-boundary-regexp () "`allout-regexp' prepended with a newline for the search target. This is properly set by `allout-set-regexp'.") -(make-variable-buffer-local 'allout-line-boundary-regexp) ;;;_ = allout-bob-regexp -(defvar allout-bob-regexp () +(defvar-local allout-bob-regexp () "Like `allout-line-boundary-regexp', for headers at beginning of buffer.") -(make-variable-buffer-local 'allout-bob-regexp) ;;;_ = allout-header-subtraction -(defvar allout-header-subtraction (1- (length allout-header-prefix)) +(defvar-local allout-header-subtraction (1- (length allout-header-prefix)) "Allout-header prefix length to subtract when computing topic depth.") -(make-variable-buffer-local 'allout-header-subtraction) ;;;_ = allout-plain-bullets-string-len -(defvar allout-plain-bullets-string-len (length allout-plain-bullets-string) +(defvar-local allout-plain-bullets-string-len (length allout-plain-bullets-string) "Length of `allout-plain-bullets-string', updated by `allout-set-regexp'.") -(make-variable-buffer-local 'allout-plain-bullets-string-len) ;;;_ = allout-doublecheck-at-and-shallower (defconst allout-doublecheck-at-and-shallower 3 @@ -1279,11 +1268,10 @@ Also refresh various data structures that hinge on the regexp." ["Set New Exposure" allout-expose-topic t]))) ;;;_ : Allout Modal-Variables Utilities ;;;_ = allout-mode-prior-settings -(defvar allout-mode-prior-settings nil +(defvar-local allout-mode-prior-settings nil "Internal `allout-mode' use; settings to be resumed on mode deactivation. See `allout-add-resumptions' and `allout-do-resumptions'.") -(make-variable-buffer-local 'allout-mode-prior-settings) ;;;_ > allout-add-resumptions (&rest pairs) (defun allout-add-resumptions (&rest pairs) "Set name/value PAIRS. @@ -1466,16 +1454,15 @@ that was affected by the undo.." :version "24.3") ;;;_ = allout-outside-normal-auto-fill-function -(defvar allout-outside-normal-auto-fill-function nil +(defvar-local allout-outside-normal-auto-fill-function nil "Value of `normal-auto-fill-function' outside of allout mode. Used by `allout-auto-fill' to do the mandated `normal-auto-fill-function' wrapped within allout's automatic `fill-prefix' setting.") -(make-variable-buffer-local 'allout-outside-normal-auto-fill-function) ;;;_ = prevent redundant activation by desktop mode: (add-to-list 'desktop-minor-mode-handlers '(allout-mode . nil)) ;;;_ = allout-after-save-decrypt -(defvar allout-after-save-decrypt nil +(defvar-local allout-after-save-decrypt nil "Internal variable, is nil or has the value of two points: - the location of a topic to be decrypted after saving is done @@ -1483,9 +1470,8 @@ wrapped within allout's automatic `fill-prefix' setting.") This is used to decrypt the topic that was currently being edited, if it was encrypted automatically as part of a file write or autosave.") -(make-variable-buffer-local 'allout-after-save-decrypt) ;;;_ = allout-encryption-plaintext-sanitization-regexps -(defvar allout-encryption-plaintext-sanitization-regexps nil +(defvar-local allout-encryption-plaintext-sanitization-regexps nil "List of regexps whose matches are removed from plaintext before encryption. This is for the sake of removing artifacts, like escapes, that are added on @@ -1498,9 +1484,8 @@ Each value can be a regexp or a list with a regexp followed by a substitution string. If it's just a regexp, all its matches are removed before the text is encrypted. If it's a regexp and a substitution, the substitution is used against the regexp matches, a la `replace-match'.") -(make-variable-buffer-local 'allout-encryption-plaintext-sanitization-regexps) ;;;_ = allout-encryption-ciphertext-rejection-regexps -(defvar allout-encryption-ciphertext-rejection-regexps nil +(defvar-local allout-encryption-ciphertext-rejection-regexps nil "Variable for regexps matching plaintext to remove before encryption. This is used to detect strings in encryption results that would @@ -1513,13 +1498,11 @@ Encryptions that result in matches will be retried, up to `allout-encryption-ciphertext-rejection-ceiling' times, after which an error is raised.") -(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps) ;;;_ = allout-encryption-ciphertext-rejection-ceiling -(defvar allout-encryption-ciphertext-rejection-ceiling 5 +(defvar-local allout-encryption-ciphertext-rejection-ceiling 5 "Limit on number of times encryption ciphertext is rejected. See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.") -(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling) ;;;_ > allout-mode-p () ;; Must define this macro above any uses, or byte compilation will lack ;; proper def, if file isn't loaded -- eg, during emacs build! @@ -1607,10 +1590,9 @@ non-nil in a lasting way.") ;;;_ #2 Mode environment and activation ;;;_ = allout-explicitly-deactivated -(defvar allout-explicitly-deactivated nil +(defvar-local allout-explicitly-deactivated nil "If t, `allout-mode's last deactivation was deliberate. So `allout-post-command-business' should not reactivate it...") -(make-variable-buffer-local 'allout-explicitly-deactivated) ;;;_ > allout-setup-menubar () (defun allout-setup-menubar () "Populate the current buffer's menubar with `allout-mode' stuff." @@ -2119,21 +2101,17 @@ function can also be used as an `isearch-mode-end-hook'." ;; for just-established data. This optimization can provide ;; significant speed improvement, but it must be employed carefully. ;;;_ = allout-recent-prefix-beginning -(defvar allout-recent-prefix-beginning 0 +(defvar-local allout-recent-prefix-beginning 0 "Buffer point of the start of the last topic prefix encountered.") -(make-variable-buffer-local 'allout-recent-prefix-beginning) ;;;_ = allout-recent-prefix-end -(defvar allout-recent-prefix-end 0 +(defvar-local allout-recent-prefix-end 0 "Buffer point of the end of the last topic prefix encountered.") -(make-variable-buffer-local 'allout-recent-prefix-end) ;;;_ = allout-recent-depth -(defvar allout-recent-depth 0 +(defvar-local allout-recent-depth 0 "Depth of the last topic prefix encountered.") -(make-variable-buffer-local 'allout-recent-depth) ;;;_ = allout-recent-end-of-subtree -(defvar allout-recent-end-of-subtree 0 +(defvar-local allout-recent-end-of-subtree 0 "Buffer point last returned by `allout-end-of-current-subtree'.") -(make-variable-buffer-local 'allout-recent-end-of-subtree) ;;;_ > allout-prefix-data () (defsubst allout-prefix-data () "Register allout-prefix state data. @@ -3213,7 +3191,7 @@ Returns resulting position, else nil if none found." ;;;_ - Fundamental ;;;_ = allout-post-goto-bullet -(defvar allout-post-goto-bullet nil +(defvar-local allout-post-goto-bullet nil "Outline internal var, for `allout-pre-command-business' hot-spot operation. When set, tells post-processing to reposition on topic bullet, and @@ -3221,18 +3199,15 @@ then unset it. Set by `allout-pre-command-business' when implementing hot-spot operation, where literal characters typed over a topic bullet are mapped to the command of the corresponding control-key on the `allout-mode-map-value'.") -(make-variable-buffer-local 'allout-post-goto-bullet) ;;;_ = allout-command-counter -(defvar allout-command-counter 0 +(defvar-local allout-command-counter 0 "Counter that monotonically increases in allout-mode buffers. Set by `allout-pre-command-business', to support allout addons in coordinating with allout activity.") -(make-variable-buffer-local 'allout-command-counter) ;;;_ = allout-this-command-hid-text -(defvar allout-this-command-hid-text nil +(defvar-local allout-this-command-hid-text nil "True if the most recent allout-mode command hid any text.") -(make-variable-buffer-local 'allout-this-command-hid-text) ;;;_ > allout-post-command-business () (defun allout-post-command-business () "Outline `post-command-hook' function. diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 2494040457b..14cae8a52c7 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -581,14 +581,15 @@ default value. If the user, host, or port are missing, the alist `auth-source-creation-prompts' will be used to look up the prompts IN THAT ORDER (so the `user' prompt will be queried first, then `host', then `port', and finally `secret'). Each prompt string -can use %u, %h, and %p to show the user, host, and port. +can use %u, %h, and %p to show the user, host, and port. The prompt +is formatted with `format-prompt', a trailing \": \" is removed. Here's an example: \(let ((auth-source-creation-defaults \\='((user . \"defaultUser\") (A . \"default A\"))) (auth-source-creation-prompts - \\='((secret . \"Enter IMAP password for %h:%p: \")))) + \\='((secret . \"Enter IMAP password for %h:%p\")))) (auth-source-search :host \\='(\"nonesuch\" \"twosuch\") :type \\='netrc :max 1 :P \"pppp\" :Q \"qqqq\" :create \\='(A B Q))) @@ -860,7 +861,9 @@ while \(:host t) would find all host entries." secret))) (defun auth-source-format-prompt (prompt alist) - "Format PROMPT using %x (for any character x) specifiers in ALIST." + "Format PROMPT using %x (for any character x) specifiers in ALIST. +Remove trailing \": \"." + (setq prompt (replace-regexp-in-string ":\\s-*$" "" prompt)) (dolist (cell alist) (let ((c (nth 0 cell)) (v (nth 1 cell))) @@ -1344,11 +1347,11 @@ See `auth-source-search' for details on SPEC." "[any port]")))) (prompt (or (auth-source--aget auth-source-creation-prompts r) (cl-case r - (secret "%p password for %u@%h: ") - (user "%p user name for %h: ") - (host "%p host name for user %u: ") - (port "%p port for %u@%h: ")) - (format "Enter %s (%%u@%%h:%%p): " r))) + (secret "%p password for %u@%h") + (user "%p user name for %h") + (host "%p host name for user %u") + (port "%p port for %u@%h")) + (format "Enter %s (%%u@%%h:%%p)" r))) (prompt (auth-source-format-prompt prompt `((?u ,(auth-source--aget printable-defaults 'user)) @@ -1378,7 +1381,9 @@ See `auth-source-search' for details on SPEC." (setq check nil))) ret)) (t 'never))) - (plain (or (eval default) (read-passwd prompt)))) + (plain + (or (eval default) + (read-passwd (format-prompt prompt nil))))) ;; ask if we don't know what to do (in which case ;; auth-source-netrc-use-gpg-tokens must be a list) (unless gpg-encrypt @@ -1390,12 +1395,9 @@ See `auth-source-search' for details on SPEC." (if (eq gpg-encrypt 'gpg) (auth-source-epa-make-gpg-token plain file) plain)) - (if (stringp default) - (read-string (if (string-match ": *\\'" prompt) - (concat (substring prompt 0 (match-beginning 0)) - " (default " default "): ") - (concat prompt "(default " default ") ")) - nil nil default) + (if (and (stringp default) auth-source-save-behavior) + (read-string + (format-prompt prompt default) nil nil default) (eval default))))) (when data @@ -1745,12 +1747,12 @@ authentication tokens: "[any label]")))) (prompt (or (auth-source--aget auth-source-creation-prompts r) (cl-case r - (secret "%p password for %u@%h: ") - (user "%p user name for %h: ") - (host "%p host name for user %u: ") - (port "%p port for %u@%h: ") - (label "Enter label for %u@%h: ")) - (format "Enter %s (%%u@%%h:%%p): " r))) + (secret "%p password for %u@%h") + (user "%p user name for %h") + (host "%p host name for user %u") + (port "%p port for %u@%h") + (label "Enter label for %u@%h")) + (format "Enter %s (%%u@%%h:%%p)" r))) (prompt (auth-source-format-prompt prompt `((?u ,(auth-source--aget printable-defaults 'user)) @@ -1760,13 +1762,11 @@ authentication tokens: ;; Store the data, prompting for the password if needed. (setq data (or data (if (eq r 'secret) - (or (eval default) (read-passwd prompt)) - (if (stringp default) - (read-string (if (string-match ": *\\'" prompt) - (concat (substring prompt 0 (match-beginning 0)) - " (default " default "): ") - (concat prompt "(default " default ") ")) - nil nil default) + (or (eval default) + (read-passwd (format-prompt prompt nil))) + (if (and (stringp default) auth-source-save-behavior) + (read-string + (format-prompt prompt default) nil nil default) (eval default))))) (when data @@ -2190,11 +2190,11 @@ entries for git.gnus.org: "[any port]")))) (prompt (or (auth-source--aget auth-source-creation-prompts r) (cl-case r - (secret "%p password for %u@%h: ") - (user "%p user name for %h: ") - (host "%p host name for user %u: ") - (port "%p port for %u@%h: ")) - (format "Enter %s (%%u@%%h:%%p): " r))) + (secret "%p password for %u@%h") + (user "%p user name for %h") + (host "%p host name for user %u") + (port "%p port for %u@%h")) + (format "Enter %s (%%u@%%h:%%p)" r))) (prompt (auth-source-format-prompt prompt `((?u ,(auth-source--aget printable-defaults 'user)) @@ -2204,14 +2204,11 @@ entries for git.gnus.org: ;; Store the data, prompting for the password if needed. (setq data (or data (if (eq r 'secret) - (or (eval default) (read-passwd prompt)) - (if (stringp default) + (or (eval default) + (read-passwd (format-prompt prompt nil))) + (if (and (stringp default) auth-source-save-behavior) (read-string - (if (string-match ": *\\'" prompt) - (concat (substring prompt 0 (match-beginning 0)) - " (default " default "): ") - (concat prompt "(default " default ") ")) - nil nil default) + (format-prompt prompt default) nil nil default) (eval default))))) (when data diff --git a/lisp/avoid.el b/lisp/avoid.el index b53584ba9c5..3b3848e20d1 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el @@ -25,8 +25,10 @@ ;; For those who are annoyed by the mouse pointer obscuring text, ;; this mode moves the mouse pointer - either just a little out of ;; the way, or all the way to the corner of the frame. -;; To use, load or evaluate this file and type M-x mouse-avoidance-mode . -;; To set up permanently, put the following in your .emacs: +;; +;; To use, type `M-x mouse-avoidance-mode'. +;; +;; To set up permanently, put this in your .emacs: ;; ;; (if (display-mouse-p) (mouse-avoidance-mode 'animate)) ;; @@ -47,11 +49,6 @@ ;; ;; For completely random pointer shape, replace the setq above with: ;; (setq x-pointer-shape (mouse-avoidance-random-shape)) -;; -;; Bugs / Warnings / To-Do: -;; -;; - Using this code does slow Emacs down. "banish" mode shouldn't -;; be too bad, and on my workstation even "animate" is reasonable. ;; Credits: ;; This code was helped by all those who contributed suggestions, @@ -76,7 +73,7 @@ "Activate Mouse Avoidance mode. See function `mouse-avoidance-mode' for possible values. Setting this variable directly does not take effect; -use either \\[customize] or the function `mouse-avoidance-mode'." +use either \\[customize] or \\[mouse-avoidance-mode]." :set (lambda (_symbol value) ;; 'none below prevents toggling when value is nil. (mouse-avoidance-mode (or value 'none))) @@ -261,9 +258,9 @@ If you want the mouse banished to a different corner set (t 0)))) (defun mouse-avoidance-nudge-mouse () - ;; Push the mouse a little way away, possibly animating the move. - ;; For these modes, state keeps track of the total offset that we've - ;; accumulated, and tries to keep it close to zero. + "Push the mouse a little way away, possibly animating the move. +For these modes, state keeps track of the total offset that we've +accumulated, and tries to keep it close to zero." (let* ((cur (mouse-position)) (cur-pos (cdr cur)) (pos (window-edges)) @@ -375,7 +372,7 @@ redefine this function to suit your own tastes." (setq mouse-avoidance-state nil)))))) (defun mouse-avoidance-fancy () - ;; Used for the "fancy" modes, ie jump et al. + ;; Used for the "fancy" modes, i.e. jump et al. (if (and (not mouse-avoidance-animating-pointer) (not (mouse-avoidance-ignore-p)) (mouse-avoidance-too-close-p (mouse-position))) diff --git a/lisp/bindings.el b/lisp/bindings.el index 187444af664..2f4bab11cf5 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -199,7 +199,7 @@ mouse-3: Set coding system" (symbol-name buffer-file-coding-system)) "Buffer coding system: none specified"))) -(defvar mode-line-mule-info +(defvar-local mode-line-mule-info `("" (current-input-method (:propertize ("" current-input-method-title) @@ -225,7 +225,6 @@ mnemonics of the following coding systems: coding system for terminal output (on a text terminal)") ;;;###autoload (put 'mode-line-mule-info 'risky-local-variable t) -(make-variable-buffer-local 'mode-line-mule-info) (defvar mode-line-client `("" @@ -247,7 +246,7 @@ mnemonics of the following coding systems: (format "Buffer is %smodified\nmouse-1: Toggle modification state" (if (buffer-modified-p (window-buffer window)) "" "not "))) -(defvar mode-line-modified +(defvar-local mode-line-modified (list (propertize "%1*" 'help-echo 'mode-line-read-only-help-echo @@ -264,9 +263,8 @@ mnemonics of the following coding systems: "Mode line construct for displaying whether current buffer is modified.") ;;;###autoload (put 'mode-line-modified 'risky-local-variable t) -(make-variable-buffer-local 'mode-line-modified) -(defvar mode-line-remote +(defvar-local mode-line-remote (list (propertize "%1@" 'mouse-face 'mode-line-highlight @@ -283,7 +281,6 @@ mnemonics of the following coding systems: "Mode line construct to indicate a remote buffer.") ;;;###autoload (put 'mode-line-remote 'risky-local-variable t) -(make-variable-buffer-local 'mode-line-remote) ;; MSDOS frames have window-system, but want the Fn identification. (defun mode-line-frame-control () @@ -301,12 +298,11 @@ Value is used for `mode-line-frame-identification', which see." ;;;###autoload (put 'mode-line-frame-identification 'risky-local-variable t) -(defvar mode-line-process nil +(defvar-local mode-line-process nil "Mode line construct for displaying info on process status. Normally nil in most modes, since there is no process to display.") ;;;###autoload (put 'mode-line-process 'risky-local-variable t) -(make-variable-buffer-local 'mode-line-process) (defun bindings--define-key (map key item) "Define KEY in keymap MAP according to ITEM from a menu. @@ -543,7 +539,7 @@ mouse-1: Previous buffer\nmouse-3: Next buffer") 'mouse-face 'mode-line-highlight 'local-map mode-line-buffer-identification-keymap))) -(defvar mode-line-buffer-identification +(defvar-local mode-line-buffer-identification (propertized-buffer-identification "%12b") "Mode line construct for identifying the buffer being displayed. Its default value is (\"%12b\") with some text properties added. @@ -551,7 +547,6 @@ Major modes that edit things other than ordinary files may change this \(e.g. Info, Dired,...)") ;;;###autoload (put 'mode-line-buffer-identification 'risky-local-variable t) -(make-variable-buffer-local 'mode-line-buffer-identification) (defvar mode-line-misc-info '((global-mode-string ("" global-mode-string " "))) @@ -1418,6 +1413,18 @@ if `inhibit-field-text-motion' is non-nil." (define-key ctl-x-map "z" 'repeat) +(defvar ctl-x-x-map + (let ((map (make-sparse-keymap))) + (define-key map "g" #'revert-buffer) + (define-key map "r" #'rename-buffer) + (define-key map "u" #'rename-uniquely) + (define-key map "n" #'clone-buffer) + (define-key map "i" #'insert-buffer) + (define-key map "t" #'toggle-truncate-lines) + map) + "Keymap for subcommands of C-x x.") +(define-key ctl-x-map "x" ctl-x-x-map) + (define-key esc-map "\C-l" 'reposition-window) (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index c857c9ba7f0..dcf8ff0d0af 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -271,13 +271,11 @@ defaults to `bookmark-default-file' and MODTIME is its modification time.") (defvar bookmark-file-coding-system nil "The coding-system of the last loaded or saved bookmark file.") -(defvar bookmark-current-bookmark nil +(defvar-local bookmark-current-bookmark nil "Name of bookmark most recently used in the current file. It is buffer local, used to make moving a bookmark forward through a file easier.") -(make-variable-buffer-local 'bookmark-current-bookmark) - (defvar bookmark-alist-modification-count 0 "Number of modifications to bookmark list since it was last saved.") @@ -903,13 +901,11 @@ Does not affect the kill ring." (when (and newline-too (= (following-char) ?\n)) (delete-char 1)))) -(defvar bookmark-annotation-name nil +(defvar-local bookmark-annotation-name nil "Name of bookmark under edit in `bookmark-edit-annotation-mode'.") -(make-variable-buffer-local 'bookmark-annotation-name) -(defvar bookmark--annotation-from-bookmark-list nil +(defvar-local bookmark--annotation-from-bookmark-list nil "If non-nil, `bookmark-edit-annotation-mode' should return to bookmark list.") -(make-variable-buffer-local 'bookmark--annotation-from-bookmark-list) (defun bookmark-default-annotation-text (bookmark-name) "Return default annotation text for BOOKMARK-NAME. diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 49f8604f52e..bb39e1f5795 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -111,11 +111,10 @@ as it is by default." :group 'Buffer-menu :version "22.1") -(defvar Buffer-menu-files-only nil +(defvar-local Buffer-menu-files-only nil "Non-nil if the current Buffer Menu lists only file buffers. This is set by the prefix argument to `buffer-menu' and related commands.") -(make-variable-buffer-local 'Buffer-menu-files-only) (defvar Buffer-menu-mode-map (let ((map (make-sparse-keymap)) diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index fda0b4bbedb..74551404776 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el @@ -46,10 +46,8 @@ (defvar calc-embedded-modes nil) (defvar calc-embedded-globals nil) (defvar calc-embedded-active nil) -(defvar calc-embedded-all-active nil) -(make-variable-buffer-local 'calc-embedded-all-active) -(defvar calc-embedded-some-active nil) -(make-variable-buffer-local 'calc-embedded-some-active) +(defvar-local calc-embedded-all-active nil) +(defvar-local calc-embedded-some-active nil) ;; The following variables are customizable and defined in calc.el. (defvar calc-embedded-announce-formula) @@ -856,31 +854,21 @@ The command \\[yank] can retrieve it from there." (newmode (cl-assoc-if #'derived-mode-p calc-embedded-open-close-mode-alist))) (when newann - (make-local-variable 'calc-embedded-announce-formula) - (setq calc-embedded-announce-formula (cdr newann))) + (setq-local calc-embedded-announce-formula (cdr newann))) (when newform - (make-local-variable 'calc-embedded-open-formula) - (make-local-variable 'calc-embedded-close-formula) - (setq calc-embedded-open-formula (nth 0 (cdr newform))) - (setq calc-embedded-close-formula (nth 1 (cdr newform)))) + (setq-local calc-embedded-open-formula (nth 0 (cdr newform))) + (setq-local calc-embedded-close-formula (nth 1 (cdr newform)))) (when newword - (make-local-variable 'calc-embedded-word-regexp) - (setq calc-embedded-word-regexp (nth 1 newword))) + (setq-local calc-embedded-word-regexp (nth 1 newword))) (when newplain - (make-local-variable 'calc-embedded-open-plain) - (make-local-variable 'calc-embedded-close-plain) - (setq calc-embedded-open-plain (nth 0 (cdr newplain))) - (setq calc-embedded-close-plain (nth 1 (cdr newplain)))) + (setq-local calc-embedded-open-plain (nth 0 (cdr newplain))) + (setq-local calc-embedded-close-plain (nth 1 (cdr newplain)))) (when newnewform - (make-local-variable 'calc-embedded-open-new-formula) - (make-local-variable 'calc-embedded-close-new-formula) - (setq calc-embedded-open-new-formula (nth 0 (cdr newnewform))) - (setq calc-embedded-close-new-formula (nth 1 (cdr newnewform)))) + (setq-local calc-embedded-open-new-formula (nth 0 (cdr newnewform))) + (setq-local calc-embedded-close-new-formula (nth 1 (cdr newnewform)))) (when newmode - (make-local-variable 'calc-embedded-open-mode) - (make-local-variable 'calc-embedded-close-mode) - (setq calc-embedded-open-mode (nth 0 (cdr newmode))) - (setq calc-embedded-close-mode (nth 1 (cdr newmode))))))) + (setq-local calc-embedded-open-mode (nth 0 (cdr newmode))) + (setq-local calc-embedded-close-mode (nth 1 (cdr newmode))))))) (while (and (cdr found) (> point (aref (car (cdr found)) 3))) (setq found (cdr found))) diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index fc6eb74e9f1..94b99aa29d8 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -1545,9 +1545,7 @@ (set-buffer trace-buffer) (goto-char (point-max)) (or (assq 'scroll-stop (buffer-local-variables)) - (progn - (make-local-variable 'scroll-step) - (setq scroll-step 3))) + (setq-local scroll-step 3)) (insert "\n\n\n") (set-buffer calcbuf) (math-try-integral sexpr)) diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el index a062a5a5853..f0fa91b3b17 100644 --- a/lisp/cedet/data-debug.el +++ b/lisp/cedet/data-debug.el @@ -1045,30 +1045,30 @@ If the result is a list or vector, then use the data debugger to display it." (list (let ((minibuffer-completing-symbol t)) (read-from-minibuffer "Eval: " nil read-expression-map t - 'read-expression-history)) - )) - - (if (null eval-expression-debug-on-error) - (setq values (cons (eval expr) values)) - (let ((old-value (make-symbol "t")) new-value) - ;; Bind debug-on-error to something unique so that we can - ;; detect when evalled code changes it. - (let ((debug-on-error old-value)) - (setq values (cons (eval expr) values)) - (setq new-value debug-on-error)) - ;; If evalled code has changed the value of debug-on-error, - ;; propagate that change to the global binding. - (unless (eq old-value new-value) - (setq debug-on-error new-value)))) - - (if (or (consp (car values)) (vectorp (car values))) - (let ((v (car values))) - (data-debug-show-stuff v "Expression")) - ;; Old style - (prog1 - (prin1 (car values) t) - (let ((str (eval-expression-print-format (car values)))) - (if str (princ str t)))))) + 'read-expression-history)))) + + (let (result) + (if (null eval-expression-debug-on-error) + (setq result (values--store-value (eval expr))) + (let ((old-value (make-symbol "t")) new-value) + ;; Bind debug-on-error to something unique so that we can + ;; detect when evalled code changes it. + (let ((debug-on-error old-value)) + (setq result (values--store-value (eval expr))) + (setq new-value debug-on-error)) + ;; If evalled code has changed the value of debug-on-error, + ;; propagate that change to the global binding. + (unless (eq old-value new-value) + (setq debug-on-error new-value)))) + + (if (or (consp result) (vectorp result)) + (let ((v result)) + (data-debug-show-stuff v "Expression")) + ;; Old style + (prog1 + (prin1 result t) + (let ((str (eval-expression-print-format result))) + (if str (princ str t))))))) (provide 'data-debug) diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index 14289153e81..e3cc9062ed4 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -140,22 +140,19 @@ specified by `ede-project-directories'." (defvar ede-projects nil "A list of all active projects currently loaded in Emacs.") -(defvar ede-object-root-project nil +(defvar-local ede-object-root-project nil "The current buffer's current root project. If a file is under a project, this specifies the project that is at the root of a project tree.") -(make-variable-buffer-local 'ede-object-root-project) -(defvar ede-object-project nil +(defvar-local ede-object-project nil "The current buffer's current project at that level. If a file is under a project, this specifies the project that contains the current target.") -(make-variable-buffer-local 'ede-object-project) -(defvar ede-object nil +(defvar-local ede-object nil "The current buffer's target object. This object's class determines how to compile and debug from a buffer.") -(make-variable-buffer-local 'ede-object) (defvar ede-selected-object nil "The currently user-selected project or target. diff --git a/lisp/cedet/ede/proj-archive.el b/lisp/cedet/ede/proj-archive.el index 2b1e50dcea3..038f994e4f9 100644 --- a/lisp/cedet/ede/proj-archive.el +++ b/lisp/cedet/ede/proj-archive.el @@ -5,6 +5,8 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make +;; This file is part of GNU Emacs. + ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el index 061d1b540b0..d676c5749c3 100644 --- a/lisp/cedet/ede/project-am.el +++ b/lisp/cedet/ede/project-am.el @@ -1,4 +1,4 @@ -;;; project-am.el --- A project management scheme based on automake files. +;;; project-am.el --- A project management scheme based on automake files. -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2000, 2003, 2005, 2007-2021 Free Software ;; Foundation, Inc. @@ -54,17 +54,14 @@ (defcustom project-am-compile-project-command nil "Default command used to compile a project." - :group 'project-am :type '(choice (const nil) string)) (defcustom project-am-compile-target-command (concat ede-make-command " -k %s") "Default command used to compile a project." - :group 'project-am :type 'string) (defcustom project-am-debug-target-function 'gdb "Default Emacs command used to debug a target." - :group 'project-am :type 'function) ; make this be a list some day (defconst project-am-type-alist @@ -240,8 +237,8 @@ OT is the object target. DIR is the directory to start in." (if (= (point-min) (point)) (re-search-forward (ede-target-name obj)))) -(cl-defmethod project-new-target ((proj project-am-makefile) - &optional name type) +(cl-defmethod project-new-target ((_proj project-am-makefile) + &optional name type) "Create a new target named NAME. Argument TYPE is the type of target to insert. This is a string matching something in `project-am-type-alist' or type class symbol. @@ -300,7 +297,7 @@ buffer being in order to provide a smart default target type." ;; This should be handled at the EDE level, calling a method of the ;; top most project. ;; -(cl-defmethod project-compile-project ((obj project-am-target) &optional command) +(cl-defmethod project-compile-project ((_obj project-am-target) &optional command) "Compile the entire current project. Argument COMMAND is the command to use when compiling." (require 'compile) @@ -324,7 +321,7 @@ Argument COMMAND is the command to use when compiling." (let* ((default-directory (project-am-find-topmost-level default-directory))) (compile command))) -(cl-defmethod project-compile-project ((obj project-am-makefile) +(cl-defmethod project-compile-project ((_obj project-am-makefile) &optional command) "Compile the entire current project. Argument COMMAND is the command to use when compiling." @@ -349,7 +346,7 @@ Argument COMMAND is the command to use when compiling." (let* ((default-directory (project-am-find-topmost-level default-directory))) (compile command))) -(cl-defmethod project-compile-target ((obj project-am-target) &optional command) +(cl-defmethod project-compile-target ((_obj project-am-target) &optional command) "Compile the current target. Argument COMMAND is the command to use for compiling the target." (require 'compile) @@ -423,7 +420,7 @@ Argument COMMAND is the command to use for compiling the target." ;;; Project loading and saving ;; -(defun project-am-load (directory &optional rootproj) +(defun project-am-load (directory &optional _rootproj) "Read an automakefile DIRECTORY into our data structure. If a given set of projects has already been loaded, then do nothing but return the project for the directory given. @@ -442,34 +439,28 @@ Optional ROOTPROJ is the root EDE project." (file-name-directory (directory-file-name newdir)))) (expand-file-name dir))) +(defvar recentf-exclude) + (defmacro project-am-with-makefile-current (dir &rest forms) "Set the Makefile.am in DIR to be the current buffer. -Run FORMS while the makefile is current. -Kill the makefile if it was not loaded before the load." - `(let* ((fn (expand-file-name "Makefile.am" ,dir)) - (fb nil) - (kb (get-file-buffer fn))) - (if (not (file-exists-p fn)) - nil - (save-excursion - (if kb (setq fb kb) - ;; We need to find-file this thing, but don't use - ;; any semantic features. - (let ((semantic-init-hook nil) - (recentf-exclude '( (lambda (f) t) )) - ) - (setq fb (find-file-noselect fn))) - ) - (set-buffer fb) - (prog1 ,@forms - (if (not kb) (kill-buffer (current-buffer)))))))) -(put 'project-am-with-makefile-current 'lisp-indent-function 1) - -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec project-am-with-makefile-current - (form def-body)))) - +Run FORMS while the makefile is current." + (declare (indent 1) (debug (form def-body))) + `(project-am--with-makefile-current ,dir (lambda () ,@forms))) + +(defun project-am--with-makefile-current (dir fun) + (let* ((fn (expand-file-name "Makefile.am" dir)) + (kb (get-file-buffer fn))) + (if (not (file-exists-p fn)) + nil + (with-current-buffer + (or kb + ;; We need to find-file this thing, but don't use + ;; any semantic features. + (let ((semantic-init-hook nil) + (recentf-exclude `(,(lambda (_f) t)))) + (find-file-noselect fn))) + (unwind-protect (funcall fun) + (if (not kb) (kill-buffer (current-buffer)))))))) (defun project-am-load-makefile (path &optional suggestedname) "Convert PATH into a project Makefile, and return its project object. @@ -480,6 +471,7 @@ This is used when subprojects are made in named subdirectories." (if (and ede-object (project-am-makefile-p ede-object)) ede-object (let* ((pi (project-am-package-info path)) + (fn buffer-file-name) (sfn (when suggestedname (project-am-last-dir suggestedname))) (pn (or sfn (nth 0 pi) (project-am-last-dir fn))) @@ -734,19 +726,19 @@ Strip out duplicates, and recurse on variables." "Return the default macro to `edit' for this object type." (concat (subst-char-in-string ?- ?_ (oref this name)) "_SOURCES")) -(cl-defmethod project-am-macro ((this project-am-header-noinst)) +(cl-defmethod project-am-macro ((_this project-am-header-noinst)) "Return the default macro to `edit' for this object." "noinst_HEADERS") -(cl-defmethod project-am-macro ((this project-am-header-inst)) +(cl-defmethod project-am-macro ((_this project-am-header-inst)) "Return the default macro to `edit' for this object." "include_HEADERS") -(cl-defmethod project-am-macro ((this project-am-header-pkg)) +(cl-defmethod project-am-macro ((_this project-am-header-pkg)) "Return the default macro to `edit' for this object." "pkginclude_HEADERS") -(cl-defmethod project-am-macro ((this project-am-header-chk)) +(cl-defmethod project-am-macro ((_this project-am-header-chk)) "Return the default macro to `edit' for this object." "check_HEADERS") @@ -758,7 +750,7 @@ Strip out duplicates, and recurse on variables." "Return the default macro to `edit' for this object type." (oref this name)) -(cl-defmethod project-am-macro ((this project-am-lisp)) +(cl-defmethod project-am-macro ((_this project-am-lisp)) "Return the default macro to `edit' for this object." "lisp_LISP") @@ -785,13 +777,11 @@ nil means that this buffer belongs to no-one." "Return t if object THIS lays claim to the file in BUFFER." (let ((efn (expand-file-name (buffer-file-name buffer)))) (or (string= (oref this file) efn) - (string-match "/configure\\.ac$" efn) - (string-match "/configure\\.in$" efn) - (string-match "/configure$" efn) + (string-match "/configure\\(?:\\.ac\\|\\.in\\)?\\'" efn) ;; Search output files. (let ((ans nil)) (dolist (f (oref this configureoutputfiles)) - (when (string-match (concat (regexp-quote f) "$") efn) + (when (string-match (concat (regexp-quote f) "\\'") efn) (setq ans t))) ans) ))) @@ -822,7 +812,7 @@ nil means that this buffer belongs to no-one." "Return the sub project in AMPF specified by SUBDIR." (object-assoc (expand-file-name subdir) 'file (oref ampf subproj))) -(cl-defmethod project-compile-target-command ((this project-am-target)) +(cl-defmethod project-compile-target-command ((_this project-am-target)) "Default target to use when compiling a given target." ;; This is a pretty good default for most. "") @@ -861,7 +851,7 @@ Argument FILE is the file to extract the end directory name from." (t 'project-am-program))) -(cl-defmethod ede-buffer-header-file((this project-am-objectcode) buffer) +(cl-defmethod ede-buffer-header-file((this project-am-objectcode) _buffer) "There are no default header files." (or (cl-call-next-method) (let ((s (oref this source)) @@ -910,22 +900,13 @@ files in the project." "Set the Configure FILE in the top most directory above DIR as current. Run FORMS in the configure file. Kill the Configure buffer if it was not already in a buffer." - `(save-excursion - (let ((fb (generate-new-buffer ,file))) - (set-buffer fb) - (erase-buffer) - (insert-file-contents ,file) - (prog1 ,@forms - (kill-buffer fb))))) - -(put 'project-am-with-config-current 'lisp-indent-function 1) - -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec project-am-with-config-current - (form def-body)))) - -(defmacro project-am-extract-shell-variable (var) + (declare (indent 1) (debug t)) + `(with-temp-buffer + (erase-buffer) + (insert-file-contents ,file) + ,@forms)) + +(defun project-am-extract-shell-variable (var) "Extract the value of the shell variable VAR from a shell script." (save-excursion (goto-char (point-min)) @@ -997,12 +978,12 @@ Calculates the info with `project-am-extract-package-info'." (project-am-extract-package-info dir))) ;; for simple per project include path extension -(cl-defmethod ede-system-include-path ((this project-am-makefile)) +(cl-defmethod ede-system-include-path ((_this project-am-makefile)) "Return `project-am-localvars-include-path', usually local variable per file or in .dir-locals.el or similar." (bound-and-true-p project-am-localvars-include-path)) -(cl-defmethod ede-system-include-path ((this project-am-target)) +(cl-defmethod ede-system-include-path ((_this project-am-target)) "Return `project-am-localvars-include-path', usually local variable per file or in .dir-locals.el or similar." (bound-and-true-p project-am-localvars-include-path)) diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index d1e528c4a02..63e0cef61a3 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -170,11 +170,10 @@ definition." ;;; Core bindings API ;; -(defvar mode-local-symbol-table nil +(defvar-local mode-local-symbol-table nil "Buffer local mode bindings. These symbols provide a hook for a `major-mode' to specify specific behaviors. Use the function `mode-local-bind' to define new bindings.") -(make-variable-buffer-local 'mode-local-symbol-table) (defvar mode-local-active-mode nil "Major mode in which bindings are active.") diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el index aef4fc89057..3257feb1fed 100644 --- a/lisp/cedet/pulse.el +++ b/lisp/cedet/pulse.el @@ -1,6 +1,6 @@ -;;; pulse.el --- Pulsing Overlays +;;; pulse.el --- Pulsing Overlays -*- lexical-binding: t; -*- -;;; Copyright (C) 2007-2021 Free Software Foundation, Inc. +;; Copyright (C) 2007-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 1.0 diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index c64a9822c6b..44bd4b0cd82 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -77,13 +77,12 @@ introduced." ;;; Variables and Configuration ;; -(defvar semantic--parse-table nil +(defvar-local semantic--parse-table nil "Variable that defines how to parse top level items in a buffer. This variable is for internal use only, and its content depends on the external parser used.") -(make-variable-buffer-local 'semantic--parse-table) -(defvar semantic-symbol->name-assoc-list +(defvar-local semantic-symbol->name-assoc-list '((type . "Types") (variable . "Variables") (function . "Functions") @@ -95,22 +94,19 @@ It is sometimes useful for a language to use a different string in place of the default, even though that language will still return a symbol. For example, Java return's includes, but the string can be replaced with `Imports'.") -(make-variable-buffer-local 'semantic-symbol->name-assoc-list) -(defvar semantic-symbol->name-assoc-list-for-type-parts nil +(defvar-local semantic-symbol->name-assoc-list-for-type-parts nil "Like `semantic-symbol->name-assoc-list' for type parts. Some tags that have children (see `semantic-tag-children-compatibility') will want to define the names of classes of tags differently than at the top level. For example, in C++, a Function may be called a Method. In addition, there may be new types of tags that exist only in classes, such as protection labels.") -(make-variable-buffer-local 'semantic-symbol->name-assoc-list-for-type-parts) -(defvar semantic-case-fold nil +(defvar-local semantic-case-fold nil "Value for `case-fold-search' when parsing.") -(make-variable-buffer-local 'semantic-case-fold) -(defvar semantic--buffer-cache nil +(defvar-local semantic--buffer-cache nil "A cache of the fully parsed buffer. If no significant changes have been made (based on the state) then this is returned instead of re-parsing the buffer. @@ -120,16 +116,13 @@ this is returned instead of re-parsing the buffer. If you need a tag list, use `semantic-fetch-tags'. If you need the cached values for some reason, chances are you can add a hook to `semantic-after-toplevel-cache-change-hook'.") -(make-variable-buffer-local 'semantic--buffer-cache) -(defvar semantic-unmatched-syntax-cache nil +(defvar-local semantic-unmatched-syntax-cache nil "A cached copy of unmatched syntax tokens.") -(make-variable-buffer-local 'semantic-unmatched-syntax-cache) -(defvar semantic-unmatched-syntax-cache-check nil +(defvar-local semantic-unmatched-syntax-cache-check nil "Non-nil if the unmatched syntax cache is out of date. This is tracked with `semantic-change-function'.") -(make-variable-buffer-local 'semantic-unmatched-syntax-cache-check) (defvar semantic-edits-are-safe nil "When non-nil, modifications do not require a reparse. @@ -180,19 +173,16 @@ during a flush when the cache is given a new value of nil.") :group 'semantic :type 'boolean) -(defvar semantic-parser-name "LL" +(defvar-local semantic-parser-name "LL" "Optional name of the parser used to parse input stream.") -(make-variable-buffer-local 'semantic-parser-name) -(defvar semantic--completion-cache nil +(defvar-local semantic--completion-cache nil "Internal variable used by `semantic-complete-symbol'.") -(make-variable-buffer-local 'semantic--completion-cache) ;;; Parse tree state management API ;; -(defvar semantic-parse-tree-state 'needs-rebuild +(defvar-local semantic-parse-tree-state 'needs-rebuild "State of the current parse tree.") -(make-variable-buffer-local 'semantic-parse-tree-state) (defmacro semantic-parse-tree-unparseable () "Indicate that the current buffer is unparseable. @@ -268,9 +258,8 @@ These functions are called by `semantic-new-buffer-fcn', before (defvar semantic-init-hook nil "Hook run when a buffer is initialized with a parsing table.") -(defvar semantic-init-mode-hook nil +(defvar-local semantic-init-mode-hook nil "Hook run when a buffer of a particular mode is initialized.") -(make-variable-buffer-local 'semantic-init-mode-hook) (defvar semantic-init-db-hook nil "Hook run when a buffer is initialized with a parsing table for DBs. @@ -729,9 +718,8 @@ This function returns semantic tags without overlays." ;; ;; Any parser can use this API to provide a list of warnings during a ;; parse which a user may want to investigate. -(defvar semantic-parser-warnings nil +(defvar-local semantic-parser-warnings nil "A list of parser warnings since the last full reparse.") -(make-variable-buffer-local 'semantic-parser-warnings) (defun semantic-clear-parser-warnings () "Clear the current list of parser warnings for this buffer." diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el index 034ecb5ea1c..3bc0e4dd618 100644 --- a/lisp/cedet/semantic/bovine.el +++ b/lisp/cedet/semantic/bovine.el @@ -41,10 +41,9 @@ ;;; Variables ;; -(defvar semantic-bovinate-nonterminal-check-obarray nil +(defvar-local semantic-bovinate-nonterminal-check-obarray nil "Obarray of streams already parsed for nonterminal symbols. Use this to detect infinite recursion during a parse.") -(make-variable-buffer-local 'semantic-bovinate-nonterminal-check-obarray) diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el index 1cfe5a3bac1..9cd9cdcb84b 100644 --- a/lisp/cedet/semantic/bovine/gcc.el +++ b/lisp/cedet/semantic/bovine/gcc.el @@ -1,4 +1,4 @@ -;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser +;;; semantic/bovine/gcc.el --- gcc querying special code for the C parser -*- lexical-binding: t -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -25,6 +25,7 @@ ;; GCC, and set up the preprocessor and include paths. (require 'semantic/dep) +(require 'cl-lib) (defvar semantic-lex-c-preprocessor-symbol-file) (defvar semantic-lex-c-preprocessor-symbol-map) @@ -88,9 +89,7 @@ to give to the program." (let ((path (substring line 1))) (when (and (file-accessible-directory-p path) (file-name-absolute-p path)) - (add-to-list 'inc-path - (expand-file-name path) - t)))))))) + (cl-pushnew (expand-file-name path) inc-path)))))))) inc-path)) @@ -101,7 +100,7 @@ to give to the program." (dolist (L lines) (let ((dat (split-string L))) (when (= (length dat) 3) - (add-to-list 'lst (cons (nth 1 dat) (nth 2 dat)))))) + (push (cons (nth 1 dat) (nth 2 dat)) lst)))) lst)) (defun semantic-gcc-fields (str) @@ -142,6 +141,8 @@ This is an alist, and should include keys of: `--prefix' - where GCC was installed. It should also include other symbols GCC was compiled with.") +(defvar c++-include-path) + ;;;###autoload (defun semantic-gcc-setup () "Setup Semantic C/C++ parsing based on GCC output." diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index 0a80b428e8e..c83505818f5 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el @@ -867,9 +867,8 @@ Expected return values are: ;; * semantic-collector-try-completion ;; * semantic-collector-all-completions -(defvar semantic-collector-per-buffer-list nil +(defvar-local semantic-collector-per-buffer-list nil "List of collectors active in this buffer.") -(make-variable-buffer-local 'semantic-collector-per-buffer-list) (defvar semantic-collector-list nil "List of global collectors active this session.") diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el index 4d2defde35b..8d5b5dcdbdf 100644 --- a/lisp/cedet/semantic/ctxt.el +++ b/lisp/cedet/semantic/ctxt.el @@ -32,17 +32,15 @@ (require 'semantic) ;;; Code: -(defvar semantic-command-separation-character +(defvar-local semantic-command-separation-character ";" "String which indicates the end of a command. Used for identifying the end of a single command.") -(make-variable-buffer-local 'semantic-command-separation-character) -(defvar semantic-function-argument-separation-character +(defvar-local semantic-function-argument-separation-character "," "String which indicates the end of an argument. Used for identifying arguments to functions.") -(make-variable-buffer-local 'semantic-function-argument-separation-character) ;;; Local Contexts ;; diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el index 14726e503d5..db88463bfd1 100644 --- a/lisp/cedet/semantic/db-find.el +++ b/lisp/cedet/semantic/db-find.el @@ -426,17 +426,15 @@ Default action as described in `semanticdb-find-translate-path'." ;; searchable item, then instead do the regular thing without caching. (semanticdb-find-translate-path-includes--internal path)))) -(defvar semanticdb-find-lost-includes nil +(defvar-local semanticdb-find-lost-includes nil "Include files that we cannot find associated with this buffer.") -(make-variable-buffer-local 'semanticdb-find-lost-includes) -(defvar semanticdb-find-scanned-include-tags nil +(defvar-local semanticdb-find-scanned-include-tags nil "All include tags scanned, plus action taken on the tag. Each entry is an alist: (ACTION . TAG) where ACTION is one of `scanned', `duplicate', `lost' and TAG is a clone of the include tag that was found.") -(make-variable-buffer-local 'semanticdb-find-scanned-include-tags) (defvar semanticdb-implied-include-tags nil "Include tags implied for all files of a given mode. diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index b9b10917dc6..8f9eceea554 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -50,27 +50,23 @@ (defvar semanticdb-database-list nil "List of all active databases.") -(defvar semanticdb-new-database-class 'semanticdb-project-database-file +(defvar-local semanticdb-new-database-class 'semanticdb-project-database-file "The default type of database created for new files. This can be changed on a per file basis, so that some directories are saved using one mechanism, and some directories via a different mechanism.") -(make-variable-buffer-local 'semanticdb-new-database-class) -(defvar semanticdb-default-find-index-class 'semanticdb-find-search-index +(defvar-local semanticdb-default-find-index-class 'semanticdb-find-search-index "The default type of search index to use for a `semanticdb-table's. This can be changed to try out new types of search indices.") -(make-variable-buffer-local 'semanticdb-default-find=index-class) ;;;###autoload -(defvar semanticdb-current-database nil +(defvar-local semanticdb-current-database nil "For a given buffer, this is the currently active database.") -(make-variable-buffer-local 'semanticdb-current-database) ;;;###autoload -(defvar semanticdb-current-table nil +(defvar-local semanticdb-current-table nil "For a given buffer, this is the currently active database table.") -(make-variable-buffer-local 'semanticdb-current-table) ;;; ABSTRACT CLASSES ;; @@ -825,13 +821,12 @@ must return a string, (the root directory) or a list of strings (multiple root directories in a more complex system). This variable should be used by project management programs like EDE or JDE.") -(defvar semanticdb-project-system-databases nil +(defvar-local semanticdb-project-system-databases nil "List of databases containing system library information. Mode authors can create their own system databases which know detailed information about the system libraries for querying purposes. Put those into this variable as a buffer-local, or mode-local value.") -(make-variable-buffer-local 'semanticdb-project-system-databases) (defvar semanticdb-search-system-databases t "Non-nil if search routines are to include a system database.") @@ -1016,10 +1011,9 @@ DONTLOAD does not affect the creation of new database objects." ) ))) -(defvar semanticdb-out-of-buffer-create-table-fcn nil +(defvar-local semanticdb-out-of-buffer-create-table-fcn nil "When non-nil, a function for creating a semanticdb table. This should take a filename to be parsed.") -(make-variable-buffer-local 'semanticdb-out-of-buffer-create-table-fcn) (defun semanticdb-create-table-for-file-not-in-buffer (filename) "Create a table for the file FILENAME. diff --git a/lisp/cedet/semantic/debug.el b/lisp/cedet/semantic/debug.el index b3e8f076d07..ce4afbbf26d 100644 --- a/lisp/cedet/semantic/debug.el +++ b/lisp/cedet/semantic/debug.el @@ -44,24 +44,18 @@ ;;; Code: ;;;###autoload -(defvar semantic-debug-parser-source nil +(defvar-local semantic-debug-parser-source nil "For any buffer, the file name (no path) of the parser. This would be a parser for a specific language, not the source to one of the parser generators.") -;;;###autoload -(make-variable-buffer-local 'semantic-debug-parser-source) ;;;###autoload -(defvar semantic-debug-parser-class nil +(defvar-local semantic-debug-parser-class nil "Class to create when building a debug parser object.") -;;;###autoload -(make-variable-buffer-local 'semantic-debug-parser-class) ;;;###autoload -(defvar semantic-debug-parser-debugger-source nil +(defvar-local semantic-debug-parser-debugger-source nil "Location of the debug parser class.") -;;;###autoload -(make-variable-buffer-local 'semantic-debug-parser-source) (defvar semantic-debug-enabled nil "Non-nil when debugging a parser.") diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el index 0fba2a2f091..db8be5ecf47 100644 --- a/lisp/cedet/semantic/dep.el +++ b/lisp/cedet/semantic/dep.el @@ -39,7 +39,7 @@ ;;; Code: -(defvar semantic-dependency-include-path nil +(defvar-local semantic-dependency-include-path nil "Defines the include path used when searching for files. This should be a list of directories to search which is specific to the file being included. @@ -56,9 +56,8 @@ reparsed, the cache will be reset. TODO: use ffap.el to locate such items? NOTE: Obsolete this, or use as special user") -(make-variable-buffer-local 'semantic-dependency-include-path) -(defvar semantic-dependency-system-include-path nil +(defvar-local semantic-dependency-system-include-path nil "Defines the system include path. This should be set with either `defvar-mode-local', or with `semantic-add-system-include'. @@ -71,7 +70,6 @@ When searching for a file associated with a name found in a tag of class include, this path will be inspected for includes of type `system'. Some include tags are agnostic to this setting and will check both the project and system directories.") -(make-variable-buffer-local 'semantic-dependency-system-include-path) (defmacro defcustom-mode-local-semantic-dependency-system-include-path (mode name value &optional docstring) diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el index f9c5365a29f..8927ccde843 100644 --- a/lisp/cedet/semantic/format.el +++ b/lisp/cedet/semantic/format.el @@ -78,13 +78,11 @@ Images can be used as icons instead of some types of text strings." :group 'semantic :type 'boolean) -(defvar semantic-function-argument-separator "," +(defvar-local semantic-function-argument-separator "," "Text used to separate arguments when creating text from tags.") -(make-variable-buffer-local 'semantic-function-argument-separator) -(defvar semantic-format-parent-separator "::" +(defvar-local semantic-format-parent-separator "::" "Text used to separate names when between namespaces/classes and functions.") -(make-variable-buffer-local 'semantic-format-parent-separator) (defvar semantic-format-face-alist `( (function . font-lock-function-name-face) diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index f034ba01a4f..91944c44f5e 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -243,9 +243,8 @@ Avoid using a large BODY since it is duplicated." ;;; Misc utilities ;; -(defvar semantic-new-buffer-fcn-was-run nil +(defvar-local semantic-new-buffer-fcn-was-run nil "Non-nil after `semantic-new-buffer-fcn' has been executed.") -(make-variable-buffer-local 'semantic-new-buffer-fcn-was-run) (defsubst semantic-active-p () "Return non-nil if the current buffer was set up for parsing." diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 7721a834ea4..4551811c235 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -432,9 +432,8 @@ Also load the specified macro libraries." defs))) (nreverse defs))) -(defvar semantic-grammar-macros nil +(defvar-local semantic-grammar-macros nil "List of associations (MACRO-NAME . EXPANDER).") -(make-variable-buffer-local 'semantic-grammar-macros) (defun semantic-grammar-macros () "Build and return the alist of defined macros." @@ -1054,8 +1053,7 @@ See also the variable `semantic-grammar-file-regexp'." ;;;; Macros highlighting ;;;; -(defvar semantic--grammar-macros-regexp-1 nil) -(make-variable-buffer-local 'semantic--grammar-macros-regexp-1) +(defvar-local semantic--grammar-macros-regexp-1 nil) (defun semantic--grammar-macros-regexp-1 () "Return font-lock keyword regexp for pre-installed macro names." @@ -1076,8 +1074,7 @@ See also the variable `semantic-grammar-file-regexp'." "\\<%use-macros\\>[ \t\r\n]+\\(\\sw\\|\\s_\\)+[ \t\r\n]+{" "Regexp that matches a macro declaration statement.") -(defvar semantic--grammar-macros-regexp-2 nil) -(make-variable-buffer-local 'semantic--grammar-macros-regexp-2) +(defvar-local semantic--grammar-macros-regexp-2 nil) (defun semantic--grammar-clear-macros-regexp-2 (&rest _) "Clear the cached regexp that match macros local in this grammar. diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 4898c85b216..5af4607abb8 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -1,4 +1,4 @@ -;;; idle.el --- Schedule parsing tasks in idle time +;;; idle.el --- Schedule parsing tasks in idle time -*- lexical-binding: t; -*- ;; Copyright (C) 2003-2006, 2008-2021 Free Software Foundation, Inc. @@ -135,10 +135,9 @@ it is unlikely the user would be ready to type again right away." :group 'semantic :type 'hook) -(defvar semantic-idle-scheduler-mode nil +(defvar-local semantic-idle-scheduler-mode nil "Non-nil if idle-scheduler minor mode is enabled. Use the command `semantic-idle-scheduler-mode' to change this variable.") -(make-variable-buffer-local 'semantic-idle-scheduler-mode) (defcustom semantic-idle-scheduler-max-buffer-size 0 "Maximum size in bytes of buffers where idle-scheduler is enabled. @@ -223,18 +222,18 @@ And also manages services that depend on tag values." (and (buffer-file-name b) b)) (buffer-list))))) - safe ;; This safe is not used, but could be. + ;; safe ;; This safe is not used, but could be. others mode) (when (semantic-idle-scheduler-enabled-p) (save-excursion ;; First, reparse the current buffer. - (setq mode major-mode - safe (semantic-safe "Idle Parse Error: %S" - ;(error "Goofy error 1") - (semantic-idle-scheduler-refresh-tags) - ) - ) + (setq mode major-mode) + ;; (setq safe + (semantic-safe "Idle Parse Error: %S" + ;(error "Goofy error 1") + (semantic-idle-scheduler-refresh-tags)) + ;; Now loop over other buffers with same major mode, trying to ;; update them as well. Stop on keypress. (dolist (b buffers) @@ -431,6 +430,8 @@ datasets." (message "Long Work Idle Timer...%s" exit-type))) ) +(defvar ede-auto-add-method) + (defun semantic-idle-scheduler-work-parse-neighboring-files () "Parse all the files in similar directories to buffers being edited." ;; Let's tell EDE to ignore all the files we're about to load @@ -565,11 +566,12 @@ DOC will be a documentation string describing FORMS. FORMS will be called during idle time after the current buffer's semantic tag information has been updated. This routine creates the following functions and variables:" + (declare (indent 1) (debug (&define name stringp def-body))) (let ((global (intern (concat "global-" (symbol-name name) "-mode"))) (mode (intern (concat (symbol-name name) "-mode"))) (hook (intern (concat (symbol-name name) "-mode-hook"))) (map (intern (concat (symbol-name name) "-mode-map"))) - (setup (intern (concat (symbol-name name) "-mode-setup"))) + ;; (setup (intern (concat (symbol-name name) "-mode-setup"))) (func (intern (concat (symbol-name name) "-idle-function")))) `(progn @@ -619,11 +621,6 @@ turned on in every Semantic-supported buffer.") ,(concat "Perform idle activity for the minor mode `" (symbol-name mode) "'.") ,@forms)))) -(put 'define-semantic-idle-service 'lisp-indent-function 1) -(add-hook 'edebug-setup-hook - (lambda () - (def-edebug-spec define-semantic-idle-service - (&define name stringp def-body)))) ;;; SUMMARY MODE ;; @@ -717,8 +714,7 @@ specific to a major mode. For example, in jde mode: (defun semantic-idle-summary-useful-context-p () "Non-nil if we should show a summary based on context." - (if (and (boundp 'font-lock-mode) - font-lock-mode + (if (and font-lock-mode (memq (get-text-property (point) 'face) semantic-idle-summary-out-of-context-faces)) ;; The best I can think of at the moment is to disable @@ -823,6 +819,8 @@ turned on in every Semantic-supported buffer." (make-obsolete-variable 'semantic-idle-symbol-highlight-face "customize the face `semantic-idle-symbol-highlight' instead" "24.4" 'set) +(defvar pulse-flag) + (defun semantic-idle-symbol-maybe-highlight (tag) "Perhaps add highlighting to the symbol represented by TAG. TAG was found as the symbol under point. If it happens to be @@ -900,7 +898,7 @@ Call `semantic-symref-hits-in-region' to identify local references." (when (semantic-tag-p target) (require 'semantic/symref/filter) (semantic-symref-hits-in-region - target (lambda (start end prefix) + target (lambda (start end _prefix) (when (/= start (car Hbounds)) (pulse-momentary-highlight-region start end semantic-idle-symbol-highlight-face)) @@ -1233,7 +1231,7 @@ shortened at the beginning." ) (defun semantic-idle-breadcrumbs--format-linear - (tag-list &optional max-length) + (tag-list &optional _max-length) "Format TAG-LIST as a linear list, starting with the outermost tag. MAX-LENGTH is not used." (require 'semantic/analyze/fcn) diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el index 2898f3711a0..4c13959ba1d 100644 --- a/lisp/cedet/semantic/imenu.el +++ b/lisp/cedet/semantic/imenu.el @@ -136,12 +136,11 @@ other buffer local ones based on the same semanticdb." "Non-nil if `semantic-imenu-rebuild-directory-indexes' is running.") ;;;###autoload -(defvar semantic-imenu-expandable-tag-classes '(type) +(defvar-local semantic-imenu-expandable-tag-classes '(type) "List of expandable tag classes. Tags of those classes will be given submenu with children. By default, a `type' has interesting children. In Texinfo, however, a `section' has interesting children.") -(make-variable-buffer-local 'semantic-imenu-expandable-tag-classes) ;;; Code: (defun semantic-imenu-tag-overlay (tag) diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 8b83c09eb16..408011c6286 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -73,28 +73,24 @@ (declare-function c-end-of-macro "cc-engine") ;;; Code: -(defvar semantic-lex-spp-macro-symbol-obarray nil +(defvar-local semantic-lex-spp-macro-symbol-obarray nil "Table of macro keywords used by the Semantic Preprocessor. These symbols will be used in addition to those in `semantic-lex-spp-dynamic-macro-symbol-obarray'.") -(make-variable-buffer-local 'semantic-lex-spp-macro-symbol-obarray) -(defvar semantic-lex-spp-project-macro-symbol-obarray nil +(defvar-local semantic-lex-spp-project-macro-symbol-obarray nil "Table of macro keywords for this project. These symbols will be used in addition to those in `semantic-lex-spp-dynamic-macro-symbol-obarray'.") -(make-variable-buffer-local 'semantic-lex-spp-project-macro-symbol-obarray) -(defvar semantic-lex-spp-dynamic-macro-symbol-obarray nil +(defvar-local semantic-lex-spp-dynamic-macro-symbol-obarray nil "Table of macro keywords used during lexical analysis. Macros are lexical symbols which are replaced by other lexical tokens during lexical analysis. During analysis symbols can be added and removed from this symbol table.") -(make-variable-buffer-local 'semantic-lex-spp-dynamic-macro-symbol-obarray) -(defvar semantic-lex-spp-dynamic-macro-symbol-obarray-stack nil +(defvar-local semantic-lex-spp-dynamic-macro-symbol-obarray-stack nil "A stack of obarrays for temporarily scoped macro values.") -(make-variable-buffer-local 'semantic-lex-spp-dynamic-macro-symbol-obarray-stack) (defvar semantic-lex-spp-expanded-macro-stack nil "The stack of lexical SPP macros we have expanded.") diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index 993c1dc14b6..ae70d5c730a 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -202,10 +202,9 @@ as a PROPERTY value. FUN receives a symbol as argument." ;; These keywords are keywords defined for using in a grammar with the ;; %keyword declaration, and are not keywords used in Emacs Lisp. -(defvar semantic-flex-keywords-obarray nil +(defvar-local semantic-flex-keywords-obarray nil "Buffer local keyword obarray for the lexical analyzer. These keywords are matched explicitly, and converted into special symbols.") -(make-variable-buffer-local 'semantic-flex-keywords-obarray) (defmacro semantic-lex-keyword-invalid (name) "Signal that NAME is an invalid keyword name." @@ -333,9 +332,8 @@ so that analysis can continue, if possible." ;; with the %type declaration. Types represent different syntaxes. ;; See code for `semantic-lex-preset-default-types' for the classic ;; types of syntax. -(defvar semantic-lex-types-obarray nil +(defvar-local semantic-lex-types-obarray nil "Buffer local types obarray for the lexical analyzer.") -(make-variable-buffer-local 'semantic-lex-types-obarray) (defun semantic-lex-type-invalid (type) "Signal that TYPE is an invalid lexical type name." @@ -471,12 +469,9 @@ PROPERTY set." ;;; Lexical Analyzer framework settings ;; -;; FIXME change to non-obsolete default. -(defvar semantic-lex-analyzer 'semantic-flex +(defvar-local semantic-lex-analyzer 'semantic-lex "The lexical analyzer used for a given buffer. -See `semantic-lex' for documentation. -For compatibility with Semantic 1.x it defaults to `semantic-flex'.") -(make-variable-buffer-local 'semantic-lex-analyzer) +See `semantic-lex' for documentation.") (defvar semantic-lex-tokens '( @@ -558,7 +553,7 @@ The key to this alist is the symbol representing token type that - whitespace: Characters that match `\\s-+' regexp. This token is produced with `semantic-lex-whitespace'.") -(defvar semantic-lex-syntax-modifications nil +(defvar-local semantic-lex-syntax-modifications nil "Changes to the syntax table for this buffer. These changes are active only while the buffer is being flexed. This is a list where each element has the form: @@ -566,20 +561,17 @@ This is a list where each element has the form: CHAR is the char passed to `modify-syntax-entry', and CLASS is the string also passed to `modify-syntax-entry' to define what syntax class CHAR has.") -(make-variable-buffer-local 'semantic-lex-syntax-modifications) -(defvar semantic-lex-syntax-table nil +(defvar-local semantic-lex-syntax-table nil "Syntax table used by lexical analysis. See also `semantic-lex-syntax-modifications'.") -(make-variable-buffer-local 'semantic-lex-syntax-table) -(defvar semantic-lex-comment-regex nil +(defvar-local semantic-lex-comment-regex nil "Regular expression for identifying comment start during lexical analysis. This may be automatically set when semantic initializes in a mode, but may need to be overridden for some special languages.") -(make-variable-buffer-local 'semantic-lex-comment-regex) -(defvar semantic-lex-number-expression +(defvar-local semantic-lex-number-expression ;; This expression was written by David Ponce for Java, and copied ;; here for C and any other similar language. (eval-when-compile @@ -628,12 +620,10 @@ FLOATING_POINT_LITERAL: | [0-9]+<EXPONENT>[fFdD]? | [0-9]+<EXPONENT>?[fFdD] ;") -(make-variable-buffer-local 'semantic-lex-number-expression) -(defvar semantic-lex-depth 0 +(defvar-local semantic-lex-depth 0 "Default lexing depth. This specifies how many lists to create tokens in.") -(make-variable-buffer-local 'semantic-lex-depth) (defvar semantic-lex-unterminated-syntax-end-function (lambda (_syntax _syntax-start lex-end) lex-end) @@ -1768,7 +1758,7 @@ when finding unterminated syntax.") (make-obsolete-variable 'semantic-flex-unterminated-syntax-end-function nil "28.1") -(defvar semantic-flex-extensions nil +(defvar-local semantic-flex-extensions nil "Buffer local extensions to the lexical analyzer. This should contain an alist with a key of a regex and a data element of a function. The function should both move point, and return a lexical @@ -1777,10 +1767,9 @@ token of the form: nil is also a valid return value. TYPE can be any type of symbol, as long as it doesn't occur as a nonterminal in the language definition.") -(make-variable-buffer-local 'semantic-flex-extensions) (make-obsolete-variable 'semantic-flex-extensions nil "28.1") -(defvar semantic-flex-syntax-modifications nil +(defvar-local semantic-flex-syntax-modifications nil "Changes to the syntax table for this buffer. These changes are active only while the buffer is being flexed. This is a list where each element has the form: @@ -1788,47 +1777,40 @@ This is a list where each element has the form: CHAR is the char passed to `modify-syntax-entry', and CLASS is the string also passed to `modify-syntax-entry' to define what syntax class CHAR has.") -(make-variable-buffer-local 'semantic-flex-syntax-modifications) (make-obsolete-variable 'semantic-flex-syntax-modifications nil "28.1") -(defvar semantic-ignore-comments t +(defvar-local semantic-ignore-comments t "Default comment handling. The value t means to strip comments when flexing; nil means to keep comments as part of the token stream.") -(make-variable-buffer-local 'semantic-ignore-comments) (make-obsolete-variable 'semantic-ignore-comments nil "28.1") -(defvar semantic-flex-enable-newlines nil +(defvar-local semantic-flex-enable-newlines nil "When flexing, report newlines as syntactic elements. Useful for languages where the newline is a special case terminator. Only set this on a per mode basis, not globally.") -(make-variable-buffer-local 'semantic-flex-enable-newlines) (make-obsolete-variable 'semantic-flex-enable-newlines nil "28.1") -(defvar semantic-flex-enable-whitespace nil +(defvar-local semantic-flex-enable-whitespace nil "When flexing, report whitespace as syntactic elements. Useful for languages where the syntax is whitespace dependent. Only set this on a per mode basis, not globally.") -(make-variable-buffer-local 'semantic-flex-enable-whitespace) (make-obsolete-variable 'semantic-flex-enable-whitespace nil "28.1") -(defvar semantic-flex-enable-bol nil +(defvar-local semantic-flex-enable-bol nil "When flexing, report beginning of lines as syntactic elements. Useful for languages like python which are indentation sensitive. Only set this on a per mode basis, not globally.") -(make-variable-buffer-local 'semantic-flex-enable-bol) (make-obsolete-variable 'semantic-flex-enable-bol nil "28.1") -(defvar semantic-number-expression semantic-lex-number-expression +(defvar-local semantic-number-expression semantic-lex-number-expression "See variable `semantic-lex-number-expression'.") -(make-variable-buffer-local 'semantic-number-expression) (make-obsolete-variable 'semantic-number-expression 'semantic-lex-number-expression "28.1") -(defvar semantic-flex-depth 0 +(defvar-local semantic-flex-depth 0 "Default flexing depth. This specifies how many lists to create tokens in.") -(make-variable-buffer-local 'semantic-flex-depth) (make-obsolete-variable 'semantic-flex-depth nil "28.1") (provide 'semantic/lex) diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el index 31576d29bc6..6bd04b2e346 100644 --- a/lisp/cedet/semantic/scope.el +++ b/lisp/cedet/semantic/scope.el @@ -1,4 +1,4 @@ -;;; semantic/scope.el --- Analyzer Scope Calculations +;;; semantic/scope.el --- Analyzer Scope Calculations -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -115,7 +115,7 @@ Saves scoping information between runs of the analyzer.") ) (cl-defmethod semanticdb-synchronize ((cache semantic-scope-cache) - new-tags) + _new-tags) "Synchronize a CACHE with some NEW-TAGS." (semantic-reset cache)) @@ -262,7 +262,7 @@ are from nesting data types." (semantic-go-to-tag pparent) (setq stack (semantic-find-tag-by-overlay (point))) ;; Step one, find the merged version of stack in the typecache. - (let* ((stacknames (reverse (mapcar 'semantic-tag-name stack))) + (let* ((stacknames (reverse (mapcar #'semantic-tag-name stack))) (tc nil) ) ;; @todo - can we use the typecache ability to @@ -317,7 +317,7 @@ are from nesting data types." ;; returnlist is empty. (while snlist (setq fullsearchname - (append (mapcar 'semantic-tag-name returnlist) + (append (mapcar #'semantic-tag-name returnlist) (list (car snlist)))) ;; Next one (setq ptag (semanticdb-typecache-find fullsearchname)) @@ -325,8 +325,8 @@ are from nesting data types." (when (or (not ptag) (not (semantic-tag-of-class-p ptag 'type))) (let ((rawscope - (apply 'append - (mapcar 'semantic-tag-type-members + (apply #'append + (mapcar #'semantic-tag-type-members (cons (car returnlist) scopetypes) ))) ) @@ -541,7 +541,7 @@ tag is not something you can complete from within TYPE." (setq leftover (cons S leftover))))) (nreverse leftover))) -(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit protection) +(defun semantic-analyze-scoped-type-parts (type &optional scope noinherit _protection) "Return all parts of TYPE, a tag representing a TYPE declaration. SCOPE is the scope object. NOINHERIT turns off searching of inherited tags. diff --git a/lisp/cedet/semantic/senator.el b/lisp/cedet/semantic/senator.el index 6768b432f69..f33356a170c 100644 --- a/lisp/cedet/semantic/senator.el +++ b/lisp/cedet/semantic/senator.el @@ -601,10 +601,9 @@ Makes C/C++ language like assumptions." ) (t nil))) -(defvar senator-isearch-semantic-mode nil +(defvar-local senator-isearch-semantic-mode nil "Non-nil if isearch does semantic search. This is a buffer local variable.") -(make-variable-buffer-local 'senator-isearch-semantic-mode) (defun senator-beginning-of-defun (&optional arg) "Move backward to the beginning of a defun. diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el index 154a56a27aa..19f46ff7f15 100644 --- a/lisp/cedet/semantic/sort.el +++ b/lisp/cedet/semantic/sort.el @@ -310,11 +310,10 @@ may re-organize the list with side-effects." ;; external members, and bring them together in a cloned copy of the ;; class tag. ;; -(defvar semantic-orphaned-member-metaparent-type "class" +(defvar-local semantic-orphaned-member-metaparent-type "class" "In `semantic-adopt-external-members', the type of 'type for metaparents. A metaparent is a made-up type semantic token used to hold the child list of orphaned members of a named type.") -(make-variable-buffer-local 'semantic-orphaned-member-metaparent-type) (defvar semantic-mark-external-member-function nil "Function called when an externally defined orphan is found. diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index d68ffa55d6e..85defe4f2c0 100644 --- a/lisp/cedet/semantic/tag.el +++ b/lisp/cedet/semantic/tag.el @@ -1194,7 +1194,7 @@ See also the function `semantic--expand-tag'." (setq tag (cdr tag))) (null tag))) -(defvar semantic-tag-expand-function nil +(defvar-local semantic-tag-expand-function nil "Function used to expand a tag. It is passed each tag production, and must return a list of tags derived from it, or nil if it does not need to be expanded. @@ -1207,7 +1207,6 @@ following definition is easily parsed into one tag: This function should take this compound tag and turn it into two tags, one for A, and the other for B.") -(make-variable-buffer-local 'semantic-tag-expand-function) (defun semantic--tag-expand (tag) "Convert TAG from a raw state to a cooked state, and expand it. diff --git a/lisp/cedet/semantic/util-modes.el b/lisp/cedet/semantic/util-modes.el index 45eef10f005..0de66d29e3e 100644 --- a/lisp/cedet/semantic/util-modes.el +++ b/lisp/cedet/semantic/util-modes.el @@ -498,10 +498,9 @@ non-nil if the minor mode is enabled." (semantic-add-minor-mode 'semantic-show-parser-state-mode "") -(defvar semantic-show-parser-state-string nil +(defvar-local semantic-show-parser-state-string nil "String showing the parser state for this buffer. See `semantic-show-parser-state-marker' for details.") -(make-variable-buffer-local 'semantic-show-parser-state-string) (defun semantic-show-parser-state-marker (&rest ignore) "Set `semantic-show-parser-state-string' to indicate parser state. @@ -692,10 +691,6 @@ non-nil if the minor mode is enabled." ;; Disable minor mode if semantic stuff not available (setq semantic-stickyfunc-mode nil) (error "Buffer %s was not set up for parsing" (buffer-name))) - (unless (boundp 'header-line-format) - ;; Disable if there are no header lines to use. - (setq semantic-stickyfunc-mode nil) - (error "Sticky Function mode requires Emacs")) ;; Enable the mode ;; Save previous buffer local value of header line format. (when (and (local-variable-p 'header-line-format (current-buffer)) @@ -713,10 +708,9 @@ non-nil if the minor mode is enabled." (setq header-line-format semantic-stickyfunc-old-hlf) (kill-local-variable 'semantic-stickyfunc-old-hlf))))) -(defvar semantic-stickyfunc-sticky-classes +(defvar-local semantic-stickyfunc-sticky-classes '(function type) "List of tag classes which stickyfunc will display in the header line.") -(make-variable-buffer-local 'semantic-stickyfunc-sticky-classes) (defcustom semantic-stickyfunc-show-only-functions-p nil "Non-nil means don't show lines that aren't part of a tag. @@ -886,9 +880,8 @@ Argument EVENT describes the event that caused this function to be called." ) (select-window startwin))) -(defvar semantic-highlight-func-ct-overlay nil +(defvar-local semantic-highlight-func-ct-overlay nil "Overlay used to highlight the tag the cursor is in.") -(make-variable-buffer-local 'semantic-highlight-func-ct-overlay) (defface semantic-highlight-func-current-tag-face '((((class color) (background dark)) diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el index 7d33d0e0886..8c487e14ed5 100644 --- a/lisp/cedet/semantic/util.el +++ b/lisp/cedet/semantic/util.el @@ -39,20 +39,18 @@ ;;; Code: -(defvar semantic-type-relation-separator-character '(".") +(defvar-local semantic-type-relation-separator-character '(".") "Character strings used to separate a parent/child relationship. This list of strings are used for displaying or finding separators in variable field dereferencing. The first character will be used for display. In C, a type field is separated like this: \"type.field\" thus, the character is a \".\". In C, and additional value of \"->\" would be in the list, so that \"type->field\" could be found.") -(make-variable-buffer-local 'semantic-type-relation-separator-character) -(defvar semantic-equivalent-major-modes nil +(defvar-local semantic-equivalent-major-modes nil "List of major modes which are considered equivalent. Equivalent modes share a parser, and a set of override methods. A value of nil means that the current major mode is the only one.") -(make-variable-buffer-local 'semantic-equivalent-major-modes) (declare-function semanticdb-file-stream "semantic/db" (file)) diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el index fb4d0b074ad..d5b73244a08 100644 --- a/lisp/cedet/semantic/wisent.el +++ b/lisp/cedet/semantic/wisent.el @@ -93,15 +93,13 @@ it to a form suitable for the Wisent's parser." ;;; Syntax analysis ;; -(defvar wisent-error-function nil +(defvar-local wisent-error-function nil "Function used to report parse error. By default use the function `wisent-message'.") -(make-variable-buffer-local 'wisent-error-function) -(defvar wisent-lexer-function 'wisent-lex +(defvar-local wisent-lexer-function 'wisent-lex "Function used to obtain the next lexical token in input. Should be a lexical analyzer created with `define-wisent-lexer'.") -(make-variable-buffer-local 'wisent-lexer-function) ;; Tag production ;; diff --git a/lisp/color.el b/lisp/color.el index 258acbe4053..fec36eecc33 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -33,11 +33,6 @@ ;;; Code: -;; Emacs < 23.3 -(eval-and-compile - (unless (boundp 'float-pi) - (defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...)."))) - ;;;###autoload (defun color-name-to-rgb (color &optional frame) "Convert COLOR string to a list of normalized RGB components. diff --git a/lisp/comint.el b/lisp/comint.el index e52d67d0e50..57df6bfb19f 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -700,8 +700,7 @@ Entry to this mode runs the hooks on `comint-mode-hook'." ;; https://lists.gnu.org/r/emacs-devel/2007-08/msg00827.html ;; ;; This makes it really work to keep point at the bottom. - ;; (make-local-variable 'scroll-conservatively) - ;; (setq scroll-conservatively 10000) + ;; (setq-local scroll-conservatively 10000) (add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom t t) (make-local-variable 'comint-ptyp) (make-local-variable 'comint-process-echoes) @@ -2253,15 +2252,23 @@ This function could be on `comint-output-filter-functions' or bound to a key." "Strip trailing `^M' characters from the current output group. This function could be on `comint-output-filter-functions' or bound to a key." (interactive) - (let ((pmark (process-mark (get-buffer-process (current-buffer))))) - (save-excursion - (condition-case nil - (goto-char - (if (called-interactively-p 'interactive) - comint-last-input-end comint-last-output-start)) - (error nil)) - (while (re-search-forward "\r+$" pmark t) - (replace-match "" t t))))) + (let ((process (get-buffer-process (current-buffer)))) + (if (not process) + ;; This function may be used in + ;; `comint-output-filter-functions', and in that case, if + ;; there's no process, then we should do nothing. If + ;; interactive, report an error. + (when (called-interactively-p 'interactive) + (error "No process in the current buffer")) + (let ((pmark (process-mark process))) + (save-excursion + (condition-case nil + (goto-char + (if (called-interactively-p 'interactive) + comint-last-input-end comint-last-output-start)) + (error nil)) + (while (re-search-forward "\r+$" pmark t) + (replace-match "" t t))))))) (define-obsolete-function-alias 'shell-strip-ctrl-m #'comint-strip-ctrl-m "27.1") (defun comint-show-maximum-output () @@ -2375,12 +2382,11 @@ a buffer local variable." ;; saved -- typically passwords to ftp, telnet, or somesuch. ;; Just enter m-x comint-send-invisible and type in your line. -(defvar comint-password-function nil +(defvar-local comint-password-function nil "Abnormal hook run when prompted for a password. This function gets one argument, a string containing the prompt. It may return a string containing the password, or nil if normal password prompting should occur.") -(make-variable-buffer-local 'comint-password-function) (defun comint-send-invisible (&optional prompt) "Read a string without echoing. diff --git a/lisp/completion.el b/lisp/completion.el index 8810a22d262..da2fb38febc 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -505,9 +505,8 @@ Used to decide whether to save completions.") ;; Old name, non-namespace-clean. (defvaralias 'cmpl-syntax-table 'completion-syntax-table) -(defvar completion-syntax-table completion-standard-syntax-table +(defvar-local completion-syntax-table completion-standard-syntax-table "This variable holds the current completion syntax table.") -(make-variable-buffer-local 'completion-syntax-table) ;;----------------------------------------------- ;; Symbol functions diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index 60dc0a91528..e2b73513bd5 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -179,7 +179,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (insert "\ ;; The remainder of this file is for handling :version. -;; We provide a minimum of information so that `customize-changed-options' +;; We provide a minimum of information so that `customize-changed' ;; can do its job. ;; For groups we set `custom-version', `group-documentation' and @@ -240,7 +240,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" This is an alist whose members have as car a version string, and as elements the files that have variables or faces that contain that version. These files should be loaded before showing the customization -buffer that `customize-changed-options' generates.\")\n\n")) +buffer that `customize-changed' generates.\")\n\n")) (save-buffer) (byte-compile-info (format "Generating %s...done" generated-custom-dependencies-file) t)) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index e52df4e6a2c..dde6e8997bf 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1206,7 +1206,7 @@ Show the buffer in another window, but don't select it." (message "`%s' is an alias for `%s'" symbol basevar)))) (defvar customize-changed-options-previous-release "26.3" - "Version for `customize-changed-options' to refer back to by default.") + "Version for `customize-changed' to refer back to by default.") ;; Packages will update this variable, so make it available. ;;;###autoload @@ -1242,10 +1242,11 @@ the user might see the value in an error message, a good choice is the official name of the package, such as MH-E or Gnus.") ;;;###autoload -(defalias 'customize-changed 'customize-changed-options) +(define-obsolete-function-alias 'customize-changed-options + #'customize-changed "28.1") ;;;###autoload -(defun customize-changed-options (&optional since-version) +(defun customize-changed (&optional since-version) "Customize all settings whose meanings have changed in Emacs itself. This includes new user options and faces, and new customization groups, as well as older options and faces whose meanings or diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 27fdb723441..c0a4a6dda06 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -343,7 +343,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (const :tag "Never" nil) (const :tag "Always" t) (repeat (symbol :tag "Parameter"))) - "25.1") + "27.1") (iconify-child-frame frames (choice (const :tag "Do nothing" nil) diff --git a/lisp/custom.el b/lisp/custom.el index 5e354c4c595..833810718b7 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -350,7 +350,7 @@ for more information." ;; if you need to recompile all the Lisp files using interpreted code. `(custom-declare-variable ',symbol - ,(if lexical-binding ;FIXME: This is not reliable, but is all we have. + ,(if lexical-binding ;; The STANDARD arg should be an expression that evaluates to ;; the standard value. The use of `eval' for it is spread ;; over many different places and hence difficult to @@ -627,6 +627,10 @@ property, or (ii) an alias for another customizable variable." (or (get variable 'standard-value) (get variable 'custom-autoload)))) +(defun custom--standard-value (variable) + "Return the standard value of VARIABLE." + (eval (car (get variable 'standard-value)) t)) + (define-obsolete-function-alias 'user-variable-p 'custom-variable-p "24.3") (defun custom-note-var-changed (variable) diff --git a/lisp/dframe.el b/lisp/dframe.el index 09d2fe40794..e61d2ea0581 100644 --- a/lisp/dframe.el +++ b/lisp/dframe.el @@ -5,10 +5,6 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: file, tags, tools -(defvar dframe-version "1.3" - "The current version of the dedicated frame library.") -(make-obsolete-variable 'dframe-version nil "28.1") - ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -150,42 +146,35 @@ selected frame and the focus will change to that frame." :group 'dframe :type 'hook) -(defvar dframe-track-mouse-function nil +(defvar-local dframe-track-mouse-function nil "A function to call when the mouse is moved in the given frame. Typically used to display info about the line under the mouse.") -(make-variable-buffer-local 'dframe-track-mouse-function) -(defvar dframe-help-echo-function nil +(defvar-local dframe-help-echo-function nil "A function to call when help-echo is used in newer versions of Emacs. Typically used to display info about the line under the mouse.") -(make-variable-buffer-local 'dframe-help-echo-function) -(defvar dframe-mouse-click-function nil +(defvar-local dframe-mouse-click-function nil "A function to call when the mouse is clicked. Valid clicks are mouse 2, our double mouse 1.") -(make-variable-buffer-local 'dframe-mouse-click-function) -(defvar dframe-mouse-position-function nil +(defvar-local dframe-mouse-position-function nil "A function to call to position the cursor for a mouse click.") -(make-variable-buffer-local 'dframe-mouse-position-function) (defvar dframe-power-click nil "Never set this by hand. Value is t when S-mouse activity occurs.") -(defvar dframe-timer nil +(defvar-local dframe-timer nil "The dframe timer used for updating the buffer.") -(make-variable-buffer-local 'dframe-timer) -(defvar dframe-attached-frame nil +(defvar-local dframe-attached-frame nil "The frame which started a frame mode. This is the frame from which all interesting activities will go for the mode using dframe.") -(make-variable-buffer-local 'dframe-attached-frame) -(defvar dframe-controlled nil +(defvar-local dframe-controlled nil "Is this buffer controlled by a dedicated frame. Local to those buffers, as a function called that created it.") -(make-variable-buffer-local 'dframe-controlled) (defun dframe-update-keymap (map) "Update the keymap MAP for dframe default bindings." @@ -686,28 +675,26 @@ Evaluates all cached timer functions in sequence." (funcall (car l))) (setq l (cdr l))))) -(defalias 'dframe-popup-kludge - (lambda (e) - "Pop up a menu related to the clicked on item. +(defun dframe-popup-kludge (e) + "Pop up a menu related to the clicked on item. Must be bound to event E." - (interactive "e") - (save-excursion - (mouse-set-point e) - ;; This gets the cursor where the user can see it. - (if (not (bolp)) (forward-char -1)) - (sit-for 0) - (popup-menu (mouse-menu-major-mode-map) e)))) + (interactive "e") + (save-excursion + (mouse-set-point e) + ;; This gets the cursor where the user can see it. + (if (not (bolp)) (forward-char -1)) + (sit-for 0) + (popup-menu (mouse-menu-major-mode-map) e))) ;;; Interactive user functions for the mouse ;; -(defalias 'dframe-mouse-event-p - (lambda (event) - "Return t if the event is a mouse related event." - (if (and (listp event) - (member (event-basic-type event) - '(mouse-1 mouse-2 mouse-3))) - t - nil))) +(defun dframe-mouse-event-p (event) + "Return t if the event is a mouse related event." + (if (and (listp event) + (member (event-basic-type event) + '(mouse-1 mouse-2 mouse-3))) + t + nil)) (defun dframe-track-mouse (event) "For motion EVENT, display info about the current line." @@ -836,6 +823,13 @@ the mode-line." (t (dframe-message "Click on the edge of the mode line to scroll left/right"))))) + +;;; Obsolete + +(defvar dframe-version "1.3" + "The current version of the dedicated frame library.") +(make-obsolete-variable 'dframe-version nil "28.1") + (provide 'dframe) ;;; dframe.el ends here diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index ec864d54d69..a94bdf5b42e 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -3148,7 +3148,7 @@ REGEXP should use constructs supported by your local `grep' command." (with-current-buffer (let ((xref-show-xrefs-function ;; Some future-proofing (bug#44905). - (eval (car (get 'xref-show-xrefs-function 'standard-value))))) + (custom--standard-value 'xref-show-xrefs-function))) (dired-do-find-regexp from)) (xref-query-replace-in-results from to))) diff --git a/lisp/dired.el b/lisp/dired.el index fe6ac1e2591..553fb64da05 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2332,19 +2332,9 @@ to relist the file at point or the marked files or a subdirectory, or type \\[dired-build-subdir-alist] to parse the buffer again for the directory tree. -Customization variables (rename this buffer and type \\[describe-variable] on each line -for more info): - - `dired-listing-switches' - `dired-trivial-filenames' - `dired-marker-char' - `dired-del-marker' - `dired-keep-marker-rename' - `dired-keep-marker-copy' - `dired-keep-marker-hardlink' - `dired-keep-marker-symlink' - -Hooks (use \\[describe-variable] to see their documentation): +See the `dired' customization group for a list of user options. + +This mode runs the following hooks: `dired-before-readin-hook' `dired-after-readin-hook' diff --git a/lisp/double.el b/lisp/double.el index 8bbbaa58189..7bc8d92e600 100644 --- a/lisp/double.el +++ b/lisp/double.el @@ -95,8 +95,7 @@ but not `C-u X' or `ESC X' since the X is not the prefix key." (global-set-key [ignore] 'ignore) -(or (boundp 'isearch-mode-map) - (load-library "isearch")) +(require 'isearch) (define-key isearch-mode-map [ignore] (lambda () (interactive) (isearch-update))) @@ -141,12 +140,6 @@ but not `C-u X' or `ESC X' since the X is not the prefix key." ;;; Mode -;; This feature seemed useless and it confused describe-mode, -;; so I deleted it. -;; (defvar double-mode-name "Double") -;; ;; Name of current double mode. -;; (make-variable-buffer-local 'double-mode-name) - ;;;###autoload (define-minor-mode double-mode "Toggle special insertion on double keypresses (Double mode). diff --git a/lisp/ehelp.el b/lisp/ehelp.el index 996b7db48f5..aa809d6f6f0 100644 --- a/lisp/ehelp.el +++ b/lisp/ehelp.el @@ -95,8 +95,7 @@ map) "Keymap defining commands available in `electric-help-mode'.") -(defvar electric-help-orig-major-mode nil) -(make-variable-buffer-local 'electric-help-orig-major-mode) +(defvar-local electric-help-orig-major-mode nil) (defun electric-help-mode () "`with-electric-help' temporarily places its buffer in this mode. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 66a117fccc8..8851f0ef32d 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -289,7 +289,7 @@ (byte-compile-preprocess (byte-compile--reify-function fn)))))) (if (eq (car-safe newfn) 'function) - (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form))) + (macroexp--unfold-lambda `(,(cadr newfn) ,@(cdr form))) ;; This can happen because of macroexp-warn-and-return &co. (byte-compile-warn "Inlining closure %S failed" name) @@ -297,77 +297,91 @@ (_ ;; Give up on inlining. form)))) - -;; ((lambda ...) ...) -(defun byte-compile-unfold-lambda (form &optional name) - ;; In lexical-binding mode, let and functions don't bind vars in the same way - ;; (let obey special-variable-p, but functions don't). But luckily, this - ;; doesn't matter here, because function's behavior is underspecified so it - ;; can safely be turned into a `let', even though the reverse is not true. - (or name (setq name "anonymous lambda")) - (let* ((lambda (car form)) - (values (cdr form)) - (arglist (nth 1 lambda)) - (body (cdr (cdr lambda))) - optionalp restp - bindings) - (if (and (stringp (car body)) (cdr body)) - (setq body (cdr body))) - (if (and (consp (car body)) (eq 'interactive (car (car body)))) - (setq body (cdr body))) - ;; FIXME: The checks below do not belong in an optimization phase. - (while arglist - (cond ((eq (car arglist) '&optional) - ;; ok, I'll let this slide because funcall_lambda() does... - ;; (if optionalp (error "multiple &optional keywords in %s" name)) - (if restp (error "&optional found after &rest in %s" name)) - (if (null (cdr arglist)) - (error "nothing after &optional in %s" name)) - (setq optionalp t)) - ((eq (car arglist) '&rest) - ;; ...but it is by no stretch of the imagination a reasonable - ;; thing that funcall_lambda() allows (&rest x y) and - ;; (&rest x &optional y) in arglists. - (if (null (cdr arglist)) - (error "nothing after &rest in %s" name)) - (if (cdr (cdr arglist)) - (error "multiple vars after &rest in %s" name)) - (setq restp t)) - (restp - (setq bindings (cons (list (car arglist) - (and values (cons 'list values))) - bindings) - values nil)) - ((and (not optionalp) (null values)) - (byte-compile-warn "attempt to open-code `%s' with too few arguments" name) - (setq arglist nil values 'too-few)) - (t - (setq bindings (cons (list (car arglist) (car values)) - bindings) - values (cdr values)))) - (setq arglist (cdr arglist))) - (if values - (progn - (or (eq values 'too-few) - (byte-compile-warn - "attempt to open-code `%s' with too many arguments" name)) - form) - - ;; The following leads to infinite recursion when loading a - ;; file containing `(defsubst f () (f))', and then trying to - ;; byte-compile that file. - ;(setq body (mapcar 'byte-optimize-form body))) - - (let ((newform - (if bindings - (cons 'let (cons (nreverse bindings) body)) - (cons 'progn body)))) - (byte-compile-log " %s\t==>\t%s" form newform) - newform)))) - ;;; implementing source-level optimizers +(defconst byte-optimize-enable-variable-constprop t + "If non-nil, enable constant propagation through local variables.") + +(defconst byte-optimize-warn-eliminated-variable nil + "Whether to warn when a variable is optimised away entirely. +This does usually not indicate a problem and makes the compiler +very chatty, but can be useful for debugging.") + +(defvar byte-optimize--lexvars nil + "Lexical variables in scope, in reverse order of declaration. +Each element is on the form (NAME KEEP [VALUE]), where: + NAME is the variable name, + KEEP is a boolean indicating whether the binding must be retained, + VALUE, if present, is a substitutable expression. +Earlier variables shadow later ones with the same name.") + +(defvar byte-optimize--vars-outside-condition nil + "Alist of variables lexically bound outside conditionally executed code. +Variables here are sensitive to mutation inside the conditional code, +since their contents in sequentially later code depends on the path taken +and may no longer be statically known. +Same format as `byte-optimize--lexvars', with shared structure and contents.") + +(defvar byte-optimize--vars-outside-loop nil + "Alist of variables lexically bound outside the innermost `while' loop. +Variables here are sensitive to mutation inside the loop, since this can +occur an indeterminate number of times and thus have effect on code +sequentially preceding the mutation itself. +Same format as `byte-optimize--lexvars', with shared structure and contents.") + +(defvar byte-optimize--dynamic-vars nil + "List of variables declared as dynamic during optimisation.") + +(defun byte-optimize--substitutable-p (expr) + "Whether EXPR is a constant that can be propagated." + ;; Only consider numbers, symbols and strings to be values for substitution + ;; purposes. Numbers and symbols are immutable, and mutating string + ;; literals (or results from constant-evaluated string-returning functions) + ;; can be considered undefined. + ;; (What about other quoted values, like conses?) + (or (booleanp expr) + (numberp expr) + (stringp expr) + (and (consp expr) + (eq (car expr) 'quote) + (symbolp (cadr expr))) + (keywordp expr))) + +(defmacro byte-optimize--pcase (exp &rest cases) + ;; When we do + ;; + ;; (pcase EXP + ;; (`(if ,exp ,then ,else) (DO-TEST)) + ;; (`(plus ,e2 ,e2) (DO-ADD)) + ;; (`(times ,e2 ,e2) (DO-MULT)) + ;; ...) + ;; + ;; we usually don't want to fall back to the default case if + ;; the value of EXP is of a form like `(if E1 E2)' or `(plus E1)' + ;; or `(times E1 E2 E3)', instead we either want to signal an error + ;; that EXP has an unexpected shape, or we want to carry on as if + ;; it had the right shape (ignore the extra data and pretend the missing + ;; data is nil) because it should simply never happen. + ;; + ;; The macro below implements the second option by rewriting patterns + ;; like `(if ,exp ,then ,else)' + ;; to `(if . (or `(,exp ,then ,else) pcase--dontcare))'. + ;; + ;; The resulting macroexpansion is also significantly cleaner/smaller/faster. + (declare (indent 1) (debug (form &rest (pcase-PAT body)))) + `(pcase ,exp + . ,(mapcar (lambda (case) + `(,(pcase (car case) + ((and `(,'\` (,_ . (,'\, ,_))) pat) pat) + (`(,'\` (,head . ,tail)) + (list '\` + (cons head + (list '\, `(or ,(list '\` tail) pcase--dontcare))))) + (pat pat)) + . ,(cdr case))) + cases))) + (defun byte-optimize-form-code-walker (form for-effect) ;; ;; For normal function calls, We can just mapcar the optimizer the cdr. But @@ -380,13 +394,26 @@ ;; have no place in an optimizer: the corresponding tests should be ;; performed in `macroexpand-all', or in `cconv', or in `bytecomp'. (let ((fn (car-safe form))) - (pcase form + (byte-optimize--pcase form ((pred (not consp)) - (if (not (and for-effect - (or byte-compile-delete-errors - (not (symbolp form)) - (eq form t)))) - form)) + (cond + ((and for-effect + (or byte-compile-delete-errors + (not (symbolp form)) + (eq form t))) + nil) + ((symbolp form) + (let ((lexvar (assq form byte-optimize--lexvars))) + (if (cddr lexvar) ; Value available? + (if (assq form byte-optimize--vars-outside-loop) + ;; Cannot substitute; mark for retention to avoid the + ;; variable being eliminated. + (progn + (setcar (cdr lexvar) t) + form) + (caddr lexvar)) ; variable value to use + form))) + (t form))) (`(quote . ,v) (if (cdr v) (byte-compile-warn "malformed quote form: `%s'" @@ -396,39 +423,28 @@ (and (car v) (not for-effect) form)) - (`(,(or 'let 'let*) . ,(or `(,bindings . ,exps) pcase--dontcare)) - ;; Recursively enter the optimizer for the bindings and body - ;; of a let or let*. This for depth-firstness: forms that - ;; are more deeply nested are optimized first. - (cons fn - (cons - (mapcar (lambda (binding) - (if (symbolp binding) - binding - (if (cdr (cdr binding)) - (byte-compile-warn "malformed let binding: `%s'" - (prin1-to-string binding))) - (list (car binding) - (byte-optimize-form (nth 1 binding) nil)))) - bindings) - (byte-optimize-body exps for-effect)))) + (`(,(or 'let 'let*) . ,rest) + (cons fn (byte-optimize-let-form fn rest for-effect))) (`(cond . ,clauses) - (cons fn - (mapcar (lambda (clause) - (if (consp clause) - (cons - (byte-optimize-form (car clause) nil) - (byte-optimize-body (cdr clause) for-effect)) - (byte-compile-warn "malformed cond form: `%s'" - (prin1-to-string clause)) - clause)) - clauses))) + ;; The condition in the first clause is always executed, but + ;; right now we treat all of them as conditional for simplicity. + (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) + (cons fn + (mapcar (lambda (clause) + (if (consp clause) + (cons + (byte-optimize-form (car clause) nil) + (byte-optimize-body (cdr clause) for-effect)) + (byte-compile-warn "malformed cond form: `%s'" + (prin1-to-string clause)) + clause)) + clauses)))) (`(progn . ,exps) ;; As an extra added bonus, this simplifies (progn <x>) --> <x>. (if (cdr exps) (macroexp-progn (byte-optimize-body exps for-effect)) (byte-optimize-form (car exps) for-effect))) - (`(prog1 . ,(or `(,exp . ,exps) pcase--dontcare)) + (`(prog1 ,exp . ,exps) (if exps `(prog1 ,(byte-optimize-form exp for-effect) . ,(byte-optimize-body exps t)) @@ -442,37 +458,54 @@ (cons fn (byte-optimize-body exps for-effect))) (`(if ,test ,then . ,else) - `(if ,(byte-optimize-form test nil) - ,(byte-optimize-form then for-effect) - . ,(byte-optimize-body else for-effect))) - (`(if . ,_) - (byte-compile-warn "too few arguments for `if'")) + ;; The test is always executed. + (let* ((test-opt (byte-optimize-form test nil)) + ;; The THEN and ELSE branches are executed conditionally. + ;; + ;; FIXME: We are conservative here: any variable changed in the + ;; THEN branch will be barred from substitution in the ELSE + ;; branch, despite the branches being mutually exclusive. + (byte-optimize--vars-outside-condition byte-optimize--lexvars) + (then-opt (byte-optimize-form then for-effect)) + (else-opt (byte-optimize-body else for-effect))) + `(if ,test-opt ,then-opt . ,else-opt))) (`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures. - ;; Take forms off the back until we can't any more. - ;; In the future it could conceivably be a problem that the - ;; subexpressions of these forms are optimized in the reverse - ;; order, but it's ok for now. - (if for-effect - (let ((backwards (reverse exps))) - (while (and backwards - (null (setcar backwards - (byte-optimize-form (car backwards) - for-effect)))) - (setq backwards (cdr backwards))) - (if (and exps (null backwards)) - (byte-compile-log - " all subforms of %s called for effect; deleted" form)) - (and backwards - (cons fn (nreverse (mapcar #'byte-optimize-form - backwards))))) - (cons fn (mapcar #'byte-optimize-form exps)))) + ;; FIXME: We have to traverse the expressions in left-to-right + ;; order (because that is the order of evaluation and variable + ;; mutations must be found prior to their use), but doing so we miss + ;; some optimisation opportunities: + ;; consider (and A B) in a for-effect context, where B => nil. + ;; Then A could be optimised in a for-effect context too. + (let ((tail exps) + (args nil)) + (when tail + ;; The first argument is always unconditional. + (push (byte-optimize-form + (car tail) (and for-effect (null (cdr tail)))) + args) + (setq tail (cdr tail)) + ;; Remaining arguments are conditional. + (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) + (while tail + (push (byte-optimize-form + (car tail) (and for-effect (null (cdr tail)))) + args) + (setq tail (cdr tail))))) + (cons fn (nreverse args)))) (`(while ,exp . ,exps) - `(while ,(byte-optimize-form exp nil) - . ,(byte-optimize-body exps t))) - (`(while . ,_) - (byte-compile-warn "too few arguments for `while'")) + ;; FIXME: We conservatively prevent the substitution of any variable + ;; bound outside the loop in case it is mutated later in the loop, + ;; but this misses many opportunities: variables not mutated in the + ;; loop at all, and variables affecting the initial condition (which + ;; is always executed unconditionally). + (let* ((byte-optimize--vars-outside-condition byte-optimize--lexvars) + (byte-optimize--vars-outside-loop byte-optimize--lexvars) + (condition (byte-optimize-form exp nil)) + (body (byte-optimize-body exps t))) + `(while ,condition . ,body))) + (`(interactive . ,_) (byte-compile-warn "misplaced interactive spec: `%s'" @@ -484,25 +517,36 @@ ;; all the subexpressions and compiling them separately. form) - (`(condition-case . ,(or `(,var ,exp . ,clauses) pcase--dontcare)) - `(condition-case ,var ;Not evaluated. - ,(byte-optimize-form exp for-effect) - ,@(mapcar (lambda (clause) - `(,(car clause) - ,@(byte-optimize-body (cdr clause) for-effect))) - clauses))) - - (`(unwind-protect . ,(or `(,exp . ,exps) pcase--dontcare)) - ;; The "protected" part of an unwind-protect is compiled (and thus - ;; optimized) as a top-level form, so don't do it here. But the - ;; non-protected part has the same for-effect status as the - ;; unwind-protect itself. (The protected part is always for effect, + (`(condition-case ,var ,exp . ,clauses) + (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) + `(condition-case ,var ;Not evaluated. + ,(byte-optimize-form exp for-effect) + ,@(mapcar (lambda (clause) + `(,(car clause) + ,@(byte-optimize-body (cdr clause) for-effect))) + clauses)))) + + (`(unwind-protect ,exp . ,exps) + ;; The unwinding part of an unwind-protect is compiled (and thus + ;; optimized) as a top-level form, but run the optimizer for it here + ;; anyway for lexical variable usage and substitution. But the + ;; protected part has the same for-effect status as the + ;; unwind-protect itself. (The unwinding part is always for effect, ;; but that isn't handled properly yet.) - `(unwind-protect ,(byte-optimize-form exp for-effect) . ,exps)) - - (`(catch . ,(or `(,tag . ,exps) pcase--dontcare)) - `(catch ,(byte-optimize-form tag nil) - . ,(byte-optimize-body exps for-effect))) + (let* ((byte-optimize--vars-outside-condition byte-optimize--lexvars) + (bodyform (byte-optimize-form exp for-effect))) + (pcase exps + (`(:fun-body ,f) + `(unwind-protect ,bodyform + :fun-body ,(byte-optimize-form f nil))) + (_ + `(unwind-protect ,bodyform + . ,(byte-optimize-body exps t)))))) + + (`(catch ,tag . ,exps) + (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) + `(catch ,(byte-optimize-form tag nil) + . ,(byte-optimize-body exps for-effect)))) (`(ignore . ,exps) ;; Don't treat the args to `ignore' as being @@ -512,10 +556,17 @@ `(prog1 nil . ,(mapcar #'byte-optimize-form exps))) ;; Needed as long as we run byte-optimize-form after cconv. - (`(internal-make-closure . ,_) form) + (`(internal-make-closure . ,_) + ;; Look up free vars and mark them to be kept, so that they + ;; won't be optimised away. + (dolist (var (caddr form)) + (let ((lexvar (assq var byte-optimize--lexvars))) + (when lexvar + (setcar (cdr lexvar) t)))) + form) (`((lambda . ,_) . ,_) - (let ((newform (byte-compile-unfold-lambda form))) + (let ((newform (macroexp--unfold-lambda form))) (if (eq newform form) ;; Some error occurred, avoid infinite recursion. form @@ -525,6 +576,36 @@ ;; is a *value* and shouldn't appear in the car. (`((closure . ,_) . ,_) form) + (`(setq . ,args) + (let ((var-expr-list nil)) + (while args + (unless (and (consp args) + (symbolp (car args)) (consp (cdr args))) + (byte-compile-warn "malformed setq form: %S" form)) + (let* ((var (car args)) + (expr (cadr args)) + (lexvar (assq var byte-optimize--lexvars)) + (value (byte-optimize-form expr nil))) + (when lexvar + ;; If it's bound outside conditional, invalidate. + (if (assq var byte-optimize--vars-outside-condition) + ;; We are in conditional code and the variable was + ;; bound outside: cancel substitutions. + (setcdr (cdr lexvar) nil) + ;; Set a new value (if substitutable). + (setcdr (cdr lexvar) + (and (byte-optimize--substitutable-p value) + (list value)))) + (setcar (cdr lexvar) t)) ; Mark variable to be kept. + (push var var-expr-list) + (push value var-expr-list)) + (setq args (cddr args))) + (cons fn (nreverse var-expr-list)))) + + (`(defvar ,(and (pred symbolp) name) . ,_) + (push name byte-optimize--dynamic-vars) + form) + (`(,(pred byte-code-function-p) . ,exps) (cons fn (mapcar #'byte-optimize-form exps))) @@ -582,6 +663,66 @@ new) form))) +(defun byte-optimize-let-form (head form for-effect) + ;; Recursively enter the optimizer for the bindings and body + ;; of a let or let*. This for depth-firstness: forms that + ;; are more deeply nested are optimized first. + (if (and lexical-binding byte-optimize-enable-variable-constprop) + (let* ((byte-optimize--lexvars byte-optimize--lexvars) + (new-lexvars nil) + (let-vars nil)) + (dolist (binding (car form)) + (let (name expr) + (cond ((consp binding) + (setq name (car binding)) + (unless (symbolp name) + (byte-compile-warn "let-bind nonvariable: `%S'" name)) + (setq expr (byte-optimize-form (cadr binding) nil))) + ((symbolp binding) + (setq name binding)) + (t (byte-compile-warn "malformed let binding: `%S'" binding))) + (let* ( + (value (and (byte-optimize--substitutable-p expr) + (list expr))) + (lexical (not (or (and (symbolp name) + (special-variable-p name)) + (memq name byte-compile-bound-variables) + (memq name byte-optimize--dynamic-vars)))) + (lexinfo (and lexical (cons name (cons nil value))))) + (push (cons name (cons expr (cdr lexinfo))) let-vars) + (when lexinfo + (push lexinfo (if (eq head 'let*) + byte-optimize--lexvars + new-lexvars)))))) + (setq byte-optimize--lexvars + (append new-lexvars byte-optimize--lexvars)) + ;; Walk the body expressions, which may mutate some of the records, + ;; and generate new bindings that exclude unused variables. + (let* ((byte-optimize--dynamic-vars byte-optimize--dynamic-vars) + (opt-body (byte-optimize-body (cdr form) for-effect)) + (bindings nil)) + (dolist (var let-vars) + ;; VAR is (NAME EXPR [KEEP [VALUE]]) + (if (and (nthcdr 3 var) (not (nth 2 var))) + ;; Value present and not marked to be kept: eliminate. + (when byte-optimize-warn-eliminated-variable + (byte-compile-warn "eliminating local variable %S" (car var))) + (push (list (nth 0 var) (nth 1 var)) bindings))) + (cons bindings opt-body))) + + ;; With dynamic binding, no substitutions are in effect. + (let ((byte-optimize--lexvars nil)) + (cons + (mapcar (lambda (binding) + (if (symbolp binding) + binding + (when (or (atom binding) (cddr binding)) + (byte-compile-warn "malformed let binding: `%S'" binding)) + (list (car binding) + (byte-optimize-form (nth 1 binding) nil)))) + (car form)) + (byte-optimize-body (cdr form) for-effect))))) + (defun byte-optimize-body (forms all-for-effect) ;; Optimize the cdr of a progn or implicit progn; all forms is a list of diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c0f8db69e51..709a310eb6c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -195,7 +195,6 @@ otherwise adds \".elc\"." (autoload 'byte-optimize-form "byte-opt") ;; This is the entry point to the lapcode optimizer pass2. (autoload 'byte-optimize-lapcode "byte-opt") -(autoload 'byte-compile-unfold-lambda "byte-opt") ;; This is the entry point to the decompiler, which is used by the ;; disassembler. The disassembler just requires 'byte-compile, but @@ -3365,7 +3364,7 @@ for symbols generated by the byte compiler itself." ((and (eq (car-safe (car form)) 'lambda) ;; if the form comes out the same way it went in, that's ;; because it was malformed, and we couldn't unfold it. - (not (eq form (setq form (byte-compile-unfold-lambda form))))) + (not (eq form (setq form (macroexp--unfold-lambda form))))) (byte-compile-form form byte-compile--for-effect) (setq byte-compile--for-effect nil)) ((byte-compile-normal-call form))) diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 2cd73225ff3..7d760ffc57f 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -67,9 +67,8 @@ (define-obsolete-variable-alias 'chart-map 'chart-mode-map "24.1") (defvar chart-mode-map (make-sparse-keymap) "Keymap used in chart mode.") -(defvar chart-local-object nil +(defvar-local chart-local-object nil "Local variable containing the locally displayed chart object.") -(make-variable-buffer-local 'chart-local-object) (defvar chart-face-color-list '("red" "green" "blue" "cyan" "yellow" "purple") diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 9722792a5a5..75aefdc7ba0 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -147,13 +147,6 @@ ;; ;; See the above section "Checking Parameters" for details about ;; parameter checking. -;; -;; Dependencies: -;; -;; This file requires lisp-mnt (Lisp maintenance routines) for the -;; comment checkers. -;; -;; Requires custom for Emacs v20. ;;; TO DO: ;; Hook into the byte compiler on a defun/defvar level to generate diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index f4dbcee4d69..2916ae4adea 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -278,11 +278,10 @@ For example, you could write ((not globalp) `(progn :autoload-end - (defvar ,mode ,init-value + (defvar-local ,mode ,init-value ,(concat (format "Non-nil if %s is enabled.\n" pretty-name) (internal--format-docstring-line - "Use the command `%s' to change this variable." mode))) - (make-variable-buffer-local ',mode))) + "Use the command `%s' to change this variable." mode))))) (t (let ((base-doc-string (concat "Non-nil if %s is enabled. @@ -419,6 +418,7 @@ on if the hook has explicitly disabled it. (pretty-global-name (easy-mmode-pretty-mode-name global-mode)) (group nil) (extra-keywords nil) + (MODE-variable mode) (MODE-buffers (intern (concat global-mode-name "-buffers"))) (MODE-enable-in-buffers (intern (concat global-mode-name "-enable-in-buffers"))) @@ -440,6 +440,7 @@ on if the hook has explicitly disabled it. (pcase keyw (:group (setq group (nconc group (list :group (pop body))))) (:global (pop body)) + (:variable (setq MODE-variable (pop body))) (:predicate (setq predicate (list (pop body))) (setq turn-on-function @@ -453,8 +454,7 @@ on if the hook has explicitly disabled it. (progn (put ',global-mode 'globalized-minor-mode t) :autoload-end - (defvar ,MODE-major-mode nil) - (make-variable-buffer-local ',MODE-major-mode)) + (defvar-local ,MODE-major-mode nil)) ;; The actual global minor-mode (define-minor-mode ,global-mode ,(concat (format "Toggle %s in all buffers.\n" pretty-name) @@ -543,7 +543,7 @@ list." (with-current-buffer buf (unless ,MODE-set-explicitly (unless (eq ,MODE-major-mode major-mode) - (if ,mode + (if ,MODE-variable (progn (,mode -1) (funcall ,turn-on-function)) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 1ded0e7b097..0733dcec27b 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -341,7 +341,7 @@ Return the result of the last expression in BODY." ;; FIXME: We should probably just be using `pop-to-buffer'. (setq window (cond - ((and (edebug-window-live-p window) + ((and (window-live-p window) (eq (window-buffer window) buffer)) window) ((eq (window-buffer) buffer) @@ -392,7 +392,7 @@ Return the result of the last expression in BODY." ;; Get either a full window configuration or some window information. (if (listp which-windows) (mapcar (lambda (window) - (if (edebug-window-live-p window) + (if (window-live-p window) (list window (window-buffer window) (window-point window) @@ -407,7 +407,7 @@ Return the result of the last expression in BODY." (mapcar (lambda (one-window-info) (if one-window-info (apply (lambda (window buffer point start hscroll) - (if (edebug-window-live-p window) + (if (window-live-p window) (progn (set-window-buffer window buffer) (set-window-point window point) @@ -1687,10 +1687,10 @@ contains a circular object." (first-char (and (symbolp spec) (aref (symbol-name spec) 0))) (match (cond ((eq ?& first-char);; "&" symbols take all following specs. - (funcall (get-edebug-spec spec) cursor (cdr specs))) + (edebug--handle-&-spec-op spec cursor (cdr specs))) ((eq ?: first-char);; ":" symbols take one following spec. (setq rest (cdr (cdr specs))) - (funcall (get-edebug-spec spec) cursor (car (cdr specs)))) + (edebug--handle-:-spec-op spec cursor (car (cdr specs)))) (t;; Any other normal spec. (setq rest (cdr specs)) (edebug-match-one-spec cursor spec))))) @@ -1721,16 +1721,10 @@ contains a circular object." ;; user may want to define macros or functions with the same names. ;; We could use an internal obarray for these primitive specs. -(dolist (pair '((&optional . edebug-match-&optional) - (&rest . edebug-match-&rest) - (&or . edebug-match-&or) - (form . edebug-match-form) +(dolist (pair '((form . edebug-match-form) (sexp . edebug-match-sexp) (body . edebug-match-body) - (&define . edebug-match-&define) (name . edebug-match-name) - (:name . edebug-match-colon-name) - (:unique . edebug-match-:unique) (arg . edebug-match-arg) (def-body . edebug-match-def-body) (def-form . edebug-match-def-form) @@ -1743,9 +1737,6 @@ contains a circular object." (cl-macrolet-expr . edebug-match-cl-macrolet-expr) (cl-macrolet-name . edebug-match-cl-macrolet-name) (cl-macrolet-body . edebug-match-cl-macrolet-body) - (¬ . edebug-match-¬) - (&key . edebug-match-&key) - (&error . edebug-match-&error) (place . edebug-match-place) (gate . edebug-match-gate) ;; (nil . edebug-match-nil) not this one - special case it. @@ -1793,7 +1784,7 @@ contains a circular object." (defsubst edebug-match-body (cursor) (edebug-forms cursor)) -(defun edebug-match-&optional (cursor specs) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &optional)) cursor specs) ;; Keep matching until one spec fails. (edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper)) @@ -1819,7 +1810,11 @@ contains a circular object." ;; Reuse the &optional handler with this as the remainder handler. (edebug-&optional-wrapper cursor specs remainder-handler)) -(defun edebug-match-&rest (cursor specs) +(cl-defgeneric edebug--handle-&-spec-op (op cursor specs) + "Handle &foo spec operators. +&foo spec operators operate on all the subsequent SPECS.") + +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &rest)) cursor specs) ;; Repeatedly use specs until failure. (let ((edebug-&rest specs) ;; remember these edebug-best-error @@ -1827,7 +1822,7 @@ contains a circular object." (edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper))) -(defun edebug-match-&or (cursor specs) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &or)) cursor specs) ;; Keep matching until one spec succeeds, and return its results. ;; If none match, fail. ;; This needs to be optimized since most specs spend time here. @@ -1852,23 +1847,24 @@ contains a circular object." )) -(defun edebug-match-¬ (cursor specs) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql ¬)) cursor specs) ;; If any specs match, then fail (if (null (catch 'no-match (let ((edebug-gate nil)) (save-excursion - (edebug-match-&or cursor specs))) + (edebug--handle-&-spec-op '&or cursor specs))) nil)) ;; This means something matched, so it is a no match. (edebug-no-match cursor "Unexpected")) ;; This means nothing matched, so it is OK. nil) ;; So, return nothing -(defun edebug-match-&key (cursor specs) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &key)) cursor specs) ;; Following specs must look like (<name> <spec>) ... ;; where <name> is the name of a keyword, and spec is its spec. ;; This really doesn't save much over the expanded form and takes time. - (edebug-match-&rest + (edebug--handle-&-spec-op + '&rest cursor (cons '&or (mapcar (lambda (pair) @@ -1876,7 +1872,7 @@ contains a circular object." (car (cdr pair)))) specs)))) -(defun edebug-match-&error (cursor specs) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &error)) cursor specs) ;; Signal an error, using the following string in the spec as argument. (let ((error-string (car specs)) (edebug-error-point (edebug-before-offset cursor))) @@ -1980,7 +1976,7 @@ contains a circular object." (defun edebug-match-function (_cursor) (error "Use function-form instead of function in edebug spec")) -(defun edebug-match-&define (cursor specs) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &define)) cursor specs) ;; Match a defining form. ;; Normally, &define is interpreted specially other places. ;; This should only be called inside of a spec list to match the remainder @@ -2034,7 +2030,11 @@ contains a circular object." (edebug-move-cursor cursor) (list name))) -(defun edebug-match-colon-name (_cursor spec) +(cl-defgeneric edebug--handle-:-spec-op (op cursor spec) + "Handle :foo spec operators. +:foo spec operators operate on just the one subsequent SPEC element.") + +(cl-defmethod edebug--handle-:-spec-op ((_ (eql :name)) _cursor spec) ;; Set the edebug-def-name to the spec. (setq edebug-def-name (if edebug-def-name @@ -2043,7 +2043,7 @@ contains a circular object." spec)) nil) -(defun edebug-match-:unique (_cursor spec) +(cl-defmethod edebug--handle-:-spec-op ((_ (eql :unique)) _cursor spec) "Match a `:unique PREFIX' specifier. SPEC is the symbol name prefix for `gensym'." (let ((suffix (gensym spec))) @@ -2641,12 +2641,11 @@ See `edebug-behavior-alist' for implementations.") ;; window-start now stored with each function. -;;(defvar edebug-window-start nil) +;;(defvar-local edebug-window-start nil) ;; Remember where each buffers' window starts between edebug calls. ;; This is to avoid spurious recentering. ;; Does this still need to be buffer-local?? ;;(setq-default edebug-window-start nil) -;;(make-variable-buffer-local 'edebug-window-start) ;; Dynamically declared unbound vars @@ -2689,7 +2688,7 @@ See `edebug-behavior-alist' for implementations.") (edebug-outside-window (selected-window)) (edebug-outside-buffer (current-buffer)) (edebug-outside-point (point)) - (edebug-outside-mark (edebug-mark)) + (edebug-outside-mark (mark t)) edebug-outside-windows ; Window or screen configuration. edebug-buffer-points @@ -2858,7 +2857,7 @@ See `edebug-behavior-alist' for implementations.") ;; Unrestore edebug-buffer's window-start, if displayed. (let ((window (car edebug-window-data))) - (if (and (edebug-window-live-p window) + (if (and (window-live-p window) (eq (window-buffer) edebug-buffer)) (progn (set-window-start window (cdr edebug-window-data) @@ -2877,7 +2876,7 @@ See `edebug-behavior-alist' for implementations.") ;; Since we may be in a save-excursion, in case of quit, ;; reselect the outside window only. ;; Only needed if we are not recovering windows?? - (if (edebug-window-live-p edebug-outside-window) + (if (window-live-p edebug-outside-window) (select-window edebug-outside-window)) ) ; if edebug-save-windows @@ -3802,9 +3801,10 @@ Print result in minibuffer." (interactive (list (read--expression "Eval: "))) (princ (edebug-outside-excursion - (setq values (cons (edebug-eval expr) values)) - (concat (edebug-safe-prin1-to-string (car values)) - (eval-expression-print-format (car values)))))) + (let ((result (edebug-eval expr))) + (values--store-value result) + (concat (edebug-safe-prin1-to-string result) + (eval-expression-print-format result)))))) (defun edebug-eval-last-sexp (&optional no-truncate) "Evaluate sexp before point in the outside environment. @@ -4541,11 +4541,6 @@ It is removed when you hit any char." ;;; Emacs version specific code -(defalias 'edebug-window-live-p 'window-live-p) - -(defun edebug-mark () - (mark t)) - (defun edebug-set-conditional-breakpoint (arg condition) "Set a conditional breakpoint at nearest sexp. The condition is evaluated in the outside context. @@ -4661,7 +4656,15 @@ instrumentation for, defaulting to all functions." (message "Removed edebug instrumentation from %s" (mapconcat #'symbol-name functions ", "))) + +;;; Obsolete. + +(defun edebug-mark () + (declare (obsolete mark "28.1")) + (mark t)) + (define-obsolete-function-alias 'edebug-mark-marker #'mark-marker "28.1") +(define-obsolete-function-alias 'edebug-window-live-p #'window-live-p "28.1") (provide 'edebug) ;;; edebug.el ends here diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index f551c0c36c3..cc2927caf40 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -110,8 +110,7 @@ ;; Boy Jim's profiler.el. Both were written for Emacs 18 and both were ;; pretty good first shots at profiling, but I found that they didn't ;; provide the functionality or interface that I wanted, so I wrote -;; this. I've tested elp in XEmacs 19 and Emacs 19. There's no point -;; in even trying to make this work with Emacs 18. +;; this. ;; Unlike previous profilers, elp uses Emacs 19's built-in function ;; current-time to return interval times. This obviates the need for diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el index 9eb6d959645..e45260c32ac 100644 --- a/lisp/emacs-lisp/generator.el +++ b/lisp/emacs-lisp/generator.el @@ -725,17 +725,20 @@ Return the value with which ITERATOR finished iteration." (condition-symbol (cps--gensym "iter-do-condition")) (it-symbol (cps--gensym "iter-do-iterator")) (result-symbol (cps--gensym "iter-do-result"))) - `(let (,var - ,result-symbol + `(let (,result-symbol (,done-symbol nil) (,it-symbol ,iterator)) - (while (not ,done-symbol) - (condition-case ,condition-symbol - (setf ,var (iter-next ,it-symbol)) - (iter-end-of-sequence - (setf ,result-symbol (cdr ,condition-symbol)) - (setf ,done-symbol t))) - (unless ,done-symbol ,@body)) + (while + (let ((,var + (condition-case ,condition-symbol + (iter-next ,it-symbol) + (iter-end-of-sequence + (setf ,result-symbol (cdr ,condition-symbol)) + (setf ,done-symbol t))))) + (unless ,done-symbol + ,@body + ;; Loop until done-symbol is set. + t))) ,result-symbol))) (defvar cl--loop-args) diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el index 6db1bbbb224..294aba66c3a 100644 --- a/lisp/emacs-lisp/generic.el +++ b/lisp/emacs-lisp/generic.el @@ -96,9 +96,8 @@ ;; Internal Variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar generic-font-lock-keywords nil +(defvar-local generic-font-lock-keywords nil "Keywords for `font-lock-defaults' in a generic mode.") -(make-variable-buffer-local 'generic-font-lock-keywords) ;;;###autoload (defvar generic-mode-list nil diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index adb9cb2372c..6d9c8c32794 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -495,7 +495,7 @@ absent, return nil." (concat "^;;;[[:blank:]]*\\(" lm-commentary-header "\\):[[:blank:]\n]*") - "^;;[[:blank:]]*" ; double semicolon prefix + "^;;[[:blank:]]?" ; double semicolon prefix "[[:blank:]\n]*\\'") ; trailing new-lines "" (buffer-substring-no-properties start (lm-commentary-end)))))))) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 3918fa01b2a..54089c4bc69 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -62,9 +62,6 @@ (modify-syntax-entry ?\t " " table) (modify-syntax-entry ?\f " " table) (modify-syntax-entry ?\n "> " table) - ;; This is probably obsolete since nowadays such features use overlays. - ;; ;; Give CR the same syntax as newline, for selective-display. - ;; (modify-syntax-entry ?\^m "> " table) (modify-syntax-entry ?\; "< " table) (modify-syntax-entry ?` "' " table) (modify-syntax-entry ?' "' " table) @@ -775,7 +772,8 @@ or to switch back to an existing one." (setq-local find-tag-default-function 'lisp-find-tag-default) (setq-local comment-start-skip "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *") - (setq-local comment-end "|#") + (setq-local comment-end-skip "[ \t]*\\(\\s>\\||#\\)") + (setq-local font-lock-comment-end-skip "|#") (setq imenu-case-fold-search t)) (defun lisp-find-tag-default () @@ -1372,7 +1370,24 @@ and initial semicolons." (derived-mode-p 'emacs-lisp-mode)) emacs-lisp-docstring-fill-column fill-column))) - (fill-paragraph justify)) + (save-restriction + (save-excursion + (let ((ppss (syntax-ppss))) + ;; If we're in a string, then narrow (roughly) to that + ;; string before filling. This avoids filling Lisp + ;; statements that follow the string. + (when (ppss-string-terminator ppss) + (goto-char (ppss-comment-or-string-start ppss)) + (beginning-of-line) + ;; The string may be unterminated -- in that case, don't + ;; narrow. + (when (ignore-errors + (progn + (forward-sexp 1) + t)) + (narrow-to-region (ppss-comment-or-string-start ppss) + (point)))) + (fill-paragraph justify))))) ;; Never return nil. t)) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index e842222b7c3..042061c44fc 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -200,6 +200,69 @@ and also to avoid outputting the warning during normal execution." new-form)) new-form))) +(defun macroexp--unfold-lambda (form &optional name) + ;; In lexical-binding mode, let and functions don't bind vars in the same way + ;; (let obey special-variable-p, but functions don't). But luckily, this + ;; doesn't matter here, because function's behavior is underspecified so it + ;; can safely be turned into a `let', even though the reverse is not true. + (or name (setq name "anonymous lambda")) + (let* ((lambda (car form)) + (values (cdr form)) + (arglist (nth 1 lambda)) + (body (cdr (cdr lambda))) + optionalp restp + bindings) + (if (and (stringp (car body)) (cdr body)) + (setq body (cdr body))) + (if (and (consp (car body)) (eq 'interactive (car (car body)))) + (setq body (cdr body))) + ;; FIXME: The checks below do not belong in an optimization phase. + (while arglist + (cond ((eq (car arglist) '&optional) + ;; ok, I'll let this slide because funcall_lambda() does... + ;; (if optionalp (error "multiple &optional keywords in %s" name)) + (if restp (error "&optional found after &rest in %s" name)) + (if (null (cdr arglist)) + (error "nothing after &optional in %s" name)) + (setq optionalp t)) + ((eq (car arglist) '&rest) + ;; ...but it is by no stretch of the imagination a reasonable + ;; thing that funcall_lambda() allows (&rest x y) and + ;; (&rest x &optional y) in arglists. + (if (null (cdr arglist)) + (error "nothing after &rest in %s" name)) + (if (cdr (cdr arglist)) + (error "multiple vars after &rest in %s" name)) + (setq restp t)) + (restp + (setq bindings (cons (list (car arglist) + (and values (cons 'list values))) + bindings) + values nil)) + ((and (not optionalp) (null values)) + (setq arglist nil values 'too-few)) + (t + (setq bindings (cons (list (car arglist) (car values)) + bindings) + values (cdr values)))) + (setq arglist (cdr arglist))) + (if values + (macroexp--warn-and-return + (format (if (eq values 'too-few) + "attempt to open-code `%s' with too few arguments" + "attempt to open-code `%s' with too many arguments") + name) + form) + + ;; The following leads to infinite recursion when loading a + ;; file containing `(defsubst f () (f))', and then trying to + ;; byte-compile that file. + ;;(setq body (mapcar 'byte-optimize-form body))) + + (if bindings + `(let ,(nreverse bindings) . ,body) + (macroexp-progn body))))) + (defun macroexp--expand-all (form) "Expand all macros in FORM. This is an internal version of `macroexpand-all'. @@ -245,12 +308,8 @@ Assumes the caller has bound `macroexpand-all-environment'." ;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the optimizer ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the ;; creation of a closure, thus resulting in much better code. - (let ((newform (if (not (fboundp 'byte-compile-unfold-lambda)) - 'macroexp--not-unfolded - ;; Don't unfold if byte-opt is not yet loaded. - (byte-compile-unfold-lambda form)))) - (if (or (eq newform 'macroexp--not-unfolded) - (eq newform form)) + (let ((newform (macroexp--unfold-lambda form))) + (if (eq newform form) ;; Unfolding failed for some reason, avoid infinite recursion. (macroexp--cons (macroexp--all-forms fun 2) (macroexp--all-forms args) diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index b723643ffb9..2e327d16de4 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el @@ -182,8 +182,7 @@ if it exists." ;; Check if `package-archive-upload-base' is valid. (when (or (not (stringp package-archive-upload-base)) (equal package-archive-upload-base - (car-safe - (get 'package-archive-upload-base 'standard-value)))) + (custom--standard-value 'package-archive-upload-base))) (setq package-archive-upload-base (read-directory-name "Base directory for package archive: "))) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index cf129c453ec..ec746fa4747 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -135,7 +135,6 @@ PATTERN matches. PATTERN can take one of the forms: (pred (not FUN)) matches if FUN called on EXPVAL returns nil. (app FUN PAT) matches if FUN called on EXPVAL matches PAT. (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. - (let PAT EXPR) matches if EXPR matches PAT. (and PAT...) matches if all the patterns match. (or PAT...) matches if any of the patterns matches. @@ -145,7 +144,7 @@ FUN in `pred' and `app' can take one of the forms: (F ARG1 .. ARGn) call F with ARG1..ARGn and EXPVAL as n+1'th argument -FUN, BOOLEXP, EXPR, and subsequent PAT can refer to variables +FUN, BOOLEXP, and subsequent PAT can refer to variables bound earlier in the pattern by a SYMBOL pattern. Additional patterns can be defined using `pcase-defmacro'. @@ -426,7 +425,6 @@ of the elements of LIST is performed as if by `pcase-let'. (if (pcase--self-quoting-p pat) `',pat pat)) ((memq head '(pred guard quote)) pat) ((memq head '(or and)) `(,head ,@(mapcar #'pcase--macroexpand (cdr pat)))) - ((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat))) ((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat)))) (t (let* ((expander (pcase--get-macroexpander head)) @@ -888,18 +886,9 @@ Otherwise, it defers to REST which is a list of branches of the form (if (not (assq upat vars)) (pcase--u1 matches code (cons (cons upat sym) vars) rest) ;; Non-linear pattern. Turn it into an `eq' test. - (pcase--u1 (cons `(match ,sym . (pred (eq ,(cdr (assq upat vars))))) + (pcase--u1 (cons `(match ,sym . (pred (eql ,(cdr (assq upat vars))))) matches) code vars rest))) - ((eq (car-safe upat) 'let) - ;; A upat of the form (let VAR EXP). - ;; (pcase--u1 matches code - ;; (cons (cons (nth 1 upat) (nth 2 upat)) vars) rest) - (macroexp-let2 - macroexp-copyable-p sym - (pcase--eval (nth 2 upat) vars) - (pcase--u1 (cons (pcase--match sym (nth 1 upat)) matches) - code vars rest))) ((eq (car-safe upat) 'app) ;; A upat of the form (app FUN PAT) (pcase--mark-used sym) @@ -1011,5 +1000,9 @@ The predicate is the logical-AND of: ;; compounded values that are not `consp' (t (error "Unknown QPAT: %S" qpat)))) +(pcase-defmacro let (pat expr) + "Matches if EXPR matches PAT." + `(app (lambda (_) ,expr) ,pat)) + (provide 'pcase) ;;; pcase.el ends here diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index ef4c9603284..2fd4724aef1 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -127,8 +127,9 @@ Also add the value to the front of the list in the variable `values'." (interactive (list (read--expression "Eval: "))) (message "Evaluating...") - (push (eval expression lexical-binding) values) - (pp-display-expression (car values) "*Pp Eval Output*")) + (let ((result (eval expression lexical-binding))) + (values--store-value result) + (pp-display-expression result "*Pp Eval Output*"))) ;;;###autoload (defun pp-macroexpand-expression (expression) diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 23221a2a00d..ce8d98df807 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -187,14 +187,14 @@ Set it to nil if you don't want limits here." (defvar reb-target-window nil "Window to which the RE is applied to.") -(defvar reb-regexp nil +(defvar-local reb-regexp nil "Last regexp used by RE Builder.") -(defvar reb-regexp-src nil +(defvar-local reb-regexp-src nil "Last regexp used by RE Builder before processing it. Except for Lisp syntax this is the same as `reb-regexp'.") -(defvar reb-overlays nil +(defvar-local reb-overlays nil "List of overlays of the RE Builder.") (defvar reb-window-config nil @@ -212,10 +212,6 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (defvar reb-valid-string "" "String in mode line showing validity of RE.") -(make-variable-buffer-local 'reb-overlays) -(make-variable-buffer-local 'reb-regexp) -(make-variable-buffer-local 'reb-regexp-src) - (defconst reb-buffer "*RE-Builder*" "Buffer to use for the RE Builder.") diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 62f213c57f7..bee2f9639e7 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -75,7 +75,7 @@ properties won't work properly.") (defvar syntax-propertize-chunk-size 500) -(defvar syntax-propertize-extend-region-functions +(defvar-local syntax-propertize-extend-region-functions '(syntax-propertize-wholelines) "Special hook run just before proceeding to propertize a region. This is used to allow major modes to help `syntax-propertize' find safe buffer @@ -89,7 +89,6 @@ These functions are run in turn repeatedly until they all return nil. Put first the functions more likely to cause a change and cheaper to compute.") ;; Mark it as a special hook which doesn't use any global setting ;; (i.e. doesn't obey the element t in the buffer-local value). -(make-variable-buffer-local 'syntax-propertize-extend-region-functions) (cl-defstruct (ppss (:constructor make-ppss) diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el index fb9cd8f47df..12b0dcfff95 100644 --- a/lisp/emacs-lisp/tcover-ses.el +++ b/lisp/emacs-lisp/tcover-ses.el @@ -6,6 +6,8 @@ ;; Keywords: spreadsheet lisp utility ;; Package: testcover +;; This file is part of GNU Emacs. + ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index 312e38769c5..75b27d08e56 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el @@ -258,10 +258,10 @@ vector. Return VALUE." (aset testcover-vector after-index (testcover--copy-object value))) ((eq 'maybe old-result) (aset testcover-vector after-index 'edebug-ok-coverage)) - ((eq '1value old-result) + ((eq 'testcover-1value old-result) (aset testcover-vector after-index (cons old-result (testcover--copy-object value)))) - ((and (eq (car-safe old-result) '1value) + ((and (eq (car-safe old-result) 'testcover-1value) (not (condition-case () (equal (cdr old-result) value) (circular-list t)))) @@ -358,11 +358,11 @@ eliminated by adding more test cases." data (aref coverage len)) (when (and (not (eq data 'edebug-ok-coverage)) (not (memq (car-safe data) - '(1value maybe noreturn))) + '(testcover-1value maybe noreturn))) (setq j (+ def-mark (aref points len)))) (setq ov (make-overlay (1- j) j)) (overlay-put ov 'face - (if (memq data '(edebug-unknown maybe 1value)) + (if (memq data '(edebug-unknown maybe testcover-1value)) 'testcover-nohits 'testcover-1value)))) (set-buffer-modified-p changed)))) @@ -450,12 +450,12 @@ or return multiple values." (`(defconst ,sym . ,args) (push sym testcover-module-constants) (testcover-analyze-coverage-progn args) - '1value) + 'testcover-1value) (`(defun ,name ,_ . ,doc-and-body) (let ((val (testcover-analyze-coverage-progn doc-and-body))) (cl-case val - ((1value) (push name testcover-module-1value-functions)) + ((testcover-1value) (push name testcover-module-1value-functions)) ((maybe) (push name testcover-module-potentially-1value-functions))) nil)) @@ -466,13 +466,13 @@ or return multiple values." ;; To avoid infinite recursion, don't examine quoted objects. ;; This will cause the coverage marks on an instrumented quoted ;; form to look odd. See bug#25316. - '1value) + 'testcover-1value) (`(\` ,bq-form) (testcover-analyze-coverage-backquote-form bq-form)) ((or 't 'nil (pred keywordp)) - '1value) + 'testcover-1value) ((pred vectorp) (testcover-analyze-coverage-compose (append form nil) @@ -482,7 +482,7 @@ or return multiple values." nil) ((pred atom) - '1value) + 'testcover-1value) (_ ;; Whatever we have here, it's not wrapped, so treat it as a list of forms. @@ -494,7 +494,7 @@ Analyze all the forms in FORMS and return 1value, maybe or nil depending on the analysis of the last one. Find the coverage vectors referenced by `edebug-enter' forms nested within FORMS and update them with the results of the analysis." - (let ((result '1value)) + (let ((result 'testcover-1value)) (while (consp forms) (setq result (testcover-analyze-coverage (pop forms)))) result)) @@ -518,7 +518,7 @@ form to be treated accordingly." (setq val (testcover-analyze-coverage-wrapped-form wrapped-form)) (when (or (eq wrapper '1value) val) ;; The form is 1-valued or potentially 1-valued. - (aset testcover-vector after-id (or val '1value))) + (aset testcover-vector after-id (or val 'testcover-1value))) (cond ((or (eq wrapper 'noreturn) @@ -526,13 +526,13 @@ form to be treated accordingly." ;; This function won't return, so indicate to testcover-before that ;; it should record coverage. (aset testcover-vector before-id (cons 'noreturn after-id)) - (aset testcover-vector after-id '1value) - (setq val '1value)) + (aset testcover-vector after-id 'testcover-1value) + (setq val 'testcover-1value)) ((eq (car-safe wrapped-form) '1value) ;; This function is always supposed to return the same value. - (setq val '1value) - (aset testcover-vector after-id '1value))) + (setq val 'testcover-1value) + (aset testcover-vector after-id 'testcover-1value))) val)) (defun testcover-analyze-coverage-wrapped-form (form) @@ -540,26 +540,26 @@ form to be treated accordingly." FORM is treated as if it will be evaluated." (pcase form ((pred keywordp) - '1value) + 'testcover-1value) ((pred symbolp) (when (or (memq form testcover-constants) (memq form testcover-module-constants)) - '1value)) + 'testcover-1value)) ((pred atom) - '1value) + 'testcover-1value) (`(\` ,bq-form) (testcover-analyze-coverage-backquote-form bq-form)) (`(defconst ,sym ,val . ,_) (push sym testcover-module-constants) (testcover-analyze-coverage val) - '1value) + 'testcover-1value) (`(,(or 'dotimes 'dolist) (,_ ,expr . ,result) . ,body) ;; These always return RESULT if provided. (testcover-analyze-coverage expr) (testcover-analyze-coverage-progn body) (let ((val (testcover-analyze-coverage-progn result))) ;; If the third value is not present, the loop always returns nil. - (if result val '1value))) + (if result val 'testcover-1value))) (`(,(or 'let 'let*) ,bindings . ,body) (testcover-analyze-coverage-progn bindings) (testcover-analyze-coverage-progn body)) @@ -604,12 +604,12 @@ FORM is treated as if it will be evaluated." (defun testcover-analyze-coverage-wrapped-application (func args) "Analyze the application of FUNC to ARGS for code coverage." (cond - ((eq func 'quote) '1value) + ((eq func 'quote) 'testcover-1value) ((or (memq func testcover-1value-functions) (memq func testcover-module-1value-functions)) ;; The function should always return the same value. (testcover-analyze-coverage-progn args) - '1value) + 'testcover-1value) ((or (memq func testcover-potentially-1value-functions) (memq func testcover-module-potentially-1value-functions)) ;; The function might always return the same value. @@ -635,14 +635,14 @@ If either argument is nil, return nil, otherwise if either argument is maybe, return maybe. Return 1value only if both arguments are 1value." (cl-case val - (1value result) + (testcover-1value result) (maybe (and result 'maybe)) (nil nil))) (defun testcover-analyze-coverage-compose (forms func) "Analyze a list of FORMS for code coverage using FUNC. The list is 1valued if all of its constituent elements are also 1valued." - (let ((result '1value)) + (let ((result 'testcover-1value)) (while (consp forms) (setq result (testcover-coverage-combine result (funcall func (car forms)))) (setq forms (cdr forms))) @@ -652,7 +652,7 @@ The list is 1valued if all of its constituent elements are also 1valued." (defun testcover-analyze-coverage-backquote (bq-list) "Analyze BQ-LIST, the body of a backquoted list, for code coverage." - (let ((result '1value)) + (let ((result 'testcover-1value)) (while (consp bq-list) (let ((form (car bq-list)) val) @@ -670,7 +670,7 @@ The list is 1valued if all of its constituent elements are also 1valued." "Analyze a single FORM from a backquoted list for code coverage." (cond ((vectorp form) (testcover-analyze-coverage-backquote (append form nil))) - ((atom form) '1value) + ((atom form) 'testcover-1value) ((memq (car form) (list '\, '\,@)) (testcover-analyze-coverage (cadr form))) (t (testcover-analyze-coverage-backquote form)))) diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 881eff7f801..a64274bc0c1 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -634,9 +634,8 @@ a cons (TYPE . COLOR), then both properties are affected." ;;; Low-level Interface -(defvar cua-inhibit-cua-keys nil +(defvar-local cua-inhibit-cua-keys nil "Buffer-local variable that may disable the CUA keymappings.") -(make-variable-buffer-local 'cua-inhibit-cua-keys) ;;; Aux. variables @@ -644,9 +643,8 @@ a cons (TYPE . COLOR), then both properties are affected." ;; checked in post-command hook to see if point was moved (defvar cua--buffer-and-point-before-command nil) -;; status string for mode line indications -(defvar cua--status-string nil) -(make-variable-buffer-local 'cua--status-string) +(defvar-local cua--status-string nil + "Status string for mode line indications.") (defvar cua--debug nil) diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index ea5dad2aa0b..be2d7c0fd8a 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -37,7 +37,7 @@ (require 'rect) -(defvar cua--rectangle nil +(defvar-local cua--rectangle nil "If non-nil, restrict current region to this rectangle. A cua-rectangle definition is a vector used for all actions in `cua-rectangle-mark-mode', of the form: @@ -59,7 +59,6 @@ If VIRT is non-nil, virtual straight edges are enabled. If SELECT is a regexp, only lines starting with that regexp are affected.") -(make-variable-buffer-local 'cua--rectangle) (defvar cua--last-rectangle nil "Most recent rectangle geometry. @@ -85,9 +84,8 @@ See `cua--rectangle'.") ;; "active " "sert on" " straig" " lines ") (defvar cua--last-killed-rectangle nil) -(defvar cua--rectangle-overlays nil +(defvar-local cua--rectangle-overlays nil "List of overlays used to display current rectangle.") -(make-variable-buffer-local 'cua--rectangle-overlays) (put 'cua--rectangle-overlays 'permanent-local t) (defvar cua--overlay-keymap diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 1e235831d6f..f38be908897 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -1624,7 +1624,7 @@ invokes the command before that, etc." ;; The following two functions are used to set up undo properly. ;; In VI, unlike Emacs, if you open a line, say, and add a bunch of lines, ;; they are undone all at once. -(viper-deflocalvar viper--undo-change-group-handle nil) +(defvar-local viper--undo-change-group-handle nil) (put 'viper--undo-change-group-handle 'permanent-local t) (defun viper-adjust-undo () diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index cede99bff73..c05cf6a48b4 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -91,11 +91,9 @@ In all likelihood, you don't need to bother with this setting." "Define VAR as a buffer-local variable. DEFAULT-VALUE is the default value, and DOCUMENTATION is the docstring. The variable becomes buffer-local whenever set." - (declare (indent defun)) - `(progn - (defvar ,var ,default-value - ,(format "%s\n(buffer local)" documentation)) - (make-variable-buffer-local ',var))) + (declare (indent defun) + (obsolete defvar-local "28.1")) + `(defvar-local ,var ,default-value ,documentation)) ;; (viper-loop COUNT BODY) Execute BODY COUNT times. (defmacro viper-loop (count &rest body) @@ -161,87 +159,87 @@ docstring. The variable becomes buffer-local whenever set." ;;; Viper minor modes ;; Mode for vital things like \e, C-z. -(viper-deflocalvar viper-vi-intercept-minor-mode nil) +(defvar-local viper-vi-intercept-minor-mode nil) -(viper-deflocalvar viper-vi-basic-minor-mode nil +(defvar-local viper-vi-basic-minor-mode nil "Viper's minor mode for Vi bindings.") -(viper-deflocalvar viper-vi-local-user-minor-mode nil +(defvar-local viper-vi-local-user-minor-mode nil "Auxiliary minor mode for user-defined local bindings in Vi state.") -(viper-deflocalvar viper-vi-global-user-minor-mode nil +(defvar-local viper-vi-global-user-minor-mode nil "Auxiliary minor mode for user-defined global bindings in Vi state.") -(viper-deflocalvar viper-vi-state-modifier-minor-mode nil +(defvar-local viper-vi-state-modifier-minor-mode nil "Minor mode used to make major-mode-specific modification to Vi state.") -(viper-deflocalvar viper-vi-diehard-minor-mode nil +(defvar-local viper-vi-diehard-minor-mode nil "This minor mode is in effect when the user wants Viper to be Vi.") -(viper-deflocalvar viper-vi-kbd-minor-mode nil +(defvar-local viper-vi-kbd-minor-mode nil "Minor mode for Ex command macros in Vi state. The corresponding keymap stores key bindings of Vi macros defined with the Ex command :map.") ;; Mode for vital things like \e, C-z. -(viper-deflocalvar viper-insert-intercept-minor-mode nil) +(defvar-local viper-insert-intercept-minor-mode nil) -(viper-deflocalvar viper-insert-basic-minor-mode nil +(defvar-local viper-insert-basic-minor-mode nil "Viper's minor mode for bindings in Insert mode.") -(viper-deflocalvar viper-insert-local-user-minor-mode nil +(defvar-local viper-insert-local-user-minor-mode nil "Auxiliary minor mode for buffer-local user-defined bindings in Insert state. This is a way to overshadow normal Insert mode bindings locally to certain designated buffers.") -(viper-deflocalvar viper-insert-global-user-minor-mode nil +(defvar-local viper-insert-global-user-minor-mode nil "Auxiliary minor mode for global user-defined bindings in Insert state.") -(viper-deflocalvar viper-insert-state-modifier-minor-mode nil +(defvar-local viper-insert-state-modifier-minor-mode nil "Minor mode used to make major-mode-specific modification to Insert state.") -(viper-deflocalvar viper-insert-diehard-minor-mode nil +(defvar-local viper-insert-diehard-minor-mode nil "Minor mode that simulates Vi very closely. Not recommended, except for the novice user.") -(viper-deflocalvar viper-insert-kbd-minor-mode nil +(defvar-local viper-insert-kbd-minor-mode nil "Minor mode for Ex command macros Insert state. The corresponding keymap stores key bindings of Vi macros defined with the Ex command :map!.") -(viper-deflocalvar viper-replace-minor-mode nil +(defvar-local viper-replace-minor-mode nil "Minor mode in effect in replace state (cw, C, and the like commands).") ;; Mode for vital things like \C-z and \C-x) This is set to t, when viper-mode ;; is invoked. So, any new buffer will have C-z defined as switch to Vi, ;; unless we switched states in this buffer -(viper-deflocalvar viper-emacs-intercept-minor-mode nil) +(defvar-local viper-emacs-intercept-minor-mode nil) -(viper-deflocalvar viper-emacs-local-user-minor-mode nil +(defvar-local viper-emacs-local-user-minor-mode nil "Minor mode for local user bindings effective in Emacs state. Users can use it to override Emacs bindings when Viper is in its Emacs state.") -(viper-deflocalvar viper-emacs-global-user-minor-mode nil +(defvar-local viper-emacs-global-user-minor-mode nil "Minor mode for global user bindings in effect in Emacs state. Users can use it to override Emacs bindings when Viper is in its Emacs state.") -(viper-deflocalvar viper-emacs-kbd-minor-mode nil +(defvar-local viper-emacs-kbd-minor-mode nil "Minor mode for Vi style macros in Emacs state. The corresponding keymap stores key bindings of Vi macros defined with `viper-record-kbd-macro' command. There is no Ex-level command to do this interactively.") -(viper-deflocalvar viper-emacs-state-modifier-minor-mode nil +(defvar-local viper-emacs-state-modifier-minor-mode nil "Minor mode used to make major-mode-specific modification to Emacs state. For instance, a Vi purist may want to bind `dd' in Dired mode to a function that deletes a file.") -(viper-deflocalvar viper-vi-minibuffer-minor-mode nil +(defvar-local viper-vi-minibuffer-minor-mode nil "Minor mode that forces Vi-style when the Minibuffer is in Vi state.") -(viper-deflocalvar viper-insert-minibuffer-minor-mode nil +(defvar-local viper-insert-minibuffer-minor-mode nil "Minor mode that forces Vi-style when the Minibuffer is in Insert state.") @@ -284,7 +282,7 @@ Use `\\[viper-set-expert-level]' to change this.") ;; If non-nil, ISO accents will be turned on in insert/replace emacs states and ;; turned off in vi-state. For some users, this behavior may be too ;; primitive. In this case, use insert/emacs/vi state hooks. -(viper-deflocalvar viper-automatic-iso-accents nil "") +(defvar-local viper-automatic-iso-accents nil "") ;; Set iso-accents-mode to ARG. Check if it is bound first (defsubst viper-set-iso-accents-mode (arg) (if (boundp 'iso-accents-mode) @@ -294,7 +292,7 @@ Use `\\[viper-set-expert-level]' to change this.") ;; Don't change this! (defvar viper-mule-hook-flag t) ;; If non-nil, the default intl. input method is turned on. -(viper-deflocalvar viper-special-input-method nil "") +(defvar-local viper-special-input-method nil "") ;; viper hook to run on input-method activation (defun viper-activate-input-method-action () @@ -357,7 +355,7 @@ it better fits your working style." ;; Replace mode and changing text ;; Hack used to pass global states around for short period of time -(viper-deflocalvar viper-intermediate-command nil "") +(defvar-local viper-intermediate-command nil "") ;; This is used to pass the right Vi command key sequence to ;; viper-set-destructive-command whenever (this-command-keys) doesn't give the @@ -367,7 +365,7 @@ it better fits your working style." (defconst viper-this-command-keys nil) ;; Indicates that the current destructive command has started in replace mode. -(viper-deflocalvar viper-began-as-replace nil "") +(defvar-local viper-began-as-replace nil "") (defcustom viper-allow-multiline-replace-regions t "If non-nil, Viper will allow multi-line replace regions. @@ -398,7 +396,7 @@ delete the text being replaced, as in standard Vi." ;; internal var, used to remember the default cursor color of emacs frames (defvar viper-vi-state-cursor-color nil) -(viper-deflocalvar viper-replace-overlay nil "") +(defvar-local viper-replace-overlay nil "") (put 'viper-replace-overlay 'permanent-local t) (defcustom viper-replace-region-end-delimiter "$" @@ -430,24 +428,24 @@ color displays. By default, the delimiters are used only on TTYs." ;; `viper-move-marker-locally' ;; ;; Remember the last position inside the replace region. -(viper-deflocalvar viper-last-posn-in-replace-region nil) +(defvar-local viper-last-posn-in-replace-region nil) ;; Remember the last position while inserting -(viper-deflocalvar viper-last-posn-while-in-insert-state nil) +(defvar-local viper-last-posn-while-in-insert-state nil) (put 'viper-last-posn-in-replace-region 'permanent-local t) (put 'viper-last-posn-while-in-insert-state 'permanent-local t) -(viper-deflocalvar viper-sitting-in-replace nil "") +(defvar-local viper-sitting-in-replace nil "") (put 'viper-sitting-in-replace 'permanent-local t) ;; Remember the number of characters that have to be deleted in replace ;; mode to compensate for the inserted characters. -(viper-deflocalvar viper-replace-chars-to-delete 0 "") +(defvar-local viper-replace-chars-to-delete 0 "") ;; This variable is used internally by the before/after changed functions to ;; determine how many chars were deleted by the change. This can't be ;; determined inside after-change-functions because those get the length of the ;; deleted region, not the number of chars deleted (which are two different ;; things under MULE). -(viper-deflocalvar viper-replace-region-chars-deleted 0 "") +(defvar-local viper-replace-region-chars-deleted 0 "") ;; Insertion ring and command ring (defcustom viper-insertion-ring-size 14 @@ -490,28 +488,28 @@ will make it hard to use Vi-style timeout macros." ;; Modes and related variables ;; Current mode. One of: `emacs-state', `vi-state', `insert-state' -(viper-deflocalvar viper-current-state 'emacs-state) +(defvar-local viper-current-state 'emacs-state) ;; Autoindent in insert ;; Variable that keeps track of whether C-t has been pressed. -(viper-deflocalvar viper-cted nil "") +(defvar-local viper-cted nil "") ;; Preserve the indent value, used by C-d in insert mode. -(viper-deflocalvar viper-current-indent 0) +(defvar-local viper-current-indent 0) ;; Whether to preserve the indent, used by C-d in insert mode. -(viper-deflocalvar viper-preserve-indent nil) +(defvar-local viper-preserve-indent nil) -(viper-deflocalvar viper-auto-indent nil "") +(defvar-local viper-auto-indent nil "") (defcustom viper-auto-indent nil "Enable autoindent, if t. This is a buffer-local variable." :type 'boolean :group 'viper) -(viper-deflocalvar viper-electric-mode t "") +(defvar-local viper-electric-mode t "") (defcustom viper-electric-mode t "If t, electrify Viper. Currently, this only electrifies auto-indentation, making it appropriate to the @@ -541,7 +539,7 @@ to a new place after repeating previous Vi command." ;; Remember insert point as a marker. This is a local marker that must be ;; initialized to nil and moved with `viper-move-marker-locally'. -(viper-deflocalvar viper-insert-point nil) +(defvar-local viper-insert-point nil) (put 'viper-insert-point 'permanent-local t) ;; This remembers the point before dabbrev-expand was called. @@ -562,7 +560,7 @@ to a new place after repeating previous Vi command." ;; problem. However, the same trick can be used if such a command is ;; discovered later. ;; -(viper-deflocalvar viper-pre-command-point nil) +(defvar-local viper-pre-command-point nil) (put 'viper-pre-command-point 'permanent-local t) ; this is probably an overkill ;; This is used for saving inserted text. @@ -573,7 +571,7 @@ to a new place after repeating previous Vi command." ;; Remember com point as a marker. ;; This is a local marker. Should be moved with `viper-move-marker-locally' -(viper-deflocalvar viper-com-point nil) +(defvar-local viper-com-point nil) ;; If non-nil, the value is a list (M-COM VAL COM REG inserted-text cmd-keys) ;; It is used to re-execute last destructive command. @@ -660,14 +658,14 @@ negative number." :type 'boolean :group 'viper) -(viper-deflocalvar viper-ex-style-motion t "") +(defvar-local viper-ex-style-motion t "") (defcustom viper-ex-style-motion t "If t, the commands l,h do not cross lines, etc (Ex-style). If nil, these commands cross line boundaries." :type 'boolean :group 'viper) -(viper-deflocalvar viper-ex-style-editing t "") +(defvar-local viper-ex-style-editing t "") (defcustom viper-ex-style-editing t "If t, Ex-style behavior while editing in Vi command and insert states. `Backspace' and `Delete' don't cross line boundaries in insert. @@ -679,14 +677,14 @@ If nil, the above commands can work across lines." :type 'boolean :group 'viper) -(viper-deflocalvar viper-ESC-moves-cursor-back viper-ex-style-editing "") +(defvar-local viper-ESC-moves-cursor-back viper-ex-style-editing "") (defcustom viper-ESC-moves-cursor-back nil "If t, ESC moves cursor back when changing from insert to vi state. If nil, the cursor stays where it was when ESC was hit." :type 'boolean :group 'viper) -(viper-deflocalvar viper-delete-backwards-in-replace nil "") +(defvar-local viper-delete-backwards-in-replace nil "") (defcustom viper-delete-backwards-in-replace nil "If t, DEL key will delete characters while moving the cursor backwards. If nil, the cursor will move backwards without deleting anything." @@ -704,7 +702,7 @@ If nil, the cursor will move backwards without deleting anything." :tag "Search Wraps Around" :group 'viper-search) -(viper-deflocalvar viper-related-files-and-buffers-ring nil "") +(defvar-local viper-related-files-and-buffers-ring nil "") (defcustom viper-related-files-and-buffers-ring nil "List of file and buffer names to consider related to the current buffer. Related buffers can be cycled through via :R and :P commands." @@ -713,12 +711,12 @@ Related buffers can be cycled through via :R and :P commands." (put 'viper-related-files-and-buffers-ring 'permanent-local t) ;; Used to find out if we are done with searching the current buffer. -(viper-deflocalvar viper-local-search-start-marker nil) +(defvar-local viper-local-search-start-marker nil) ;; As above, but global (defvar viper-search-start-marker (make-marker)) ;; the search overlay -(viper-deflocalvar viper-search-overlay nil) +(defvar-local viper-search-overlay nil) (defvar viper-heading-start @@ -745,9 +743,9 @@ Related buffers can be cycled through via :R and :P commands." ;; inside the lines. ;; Remembers position of the last jump done using ``'. -(viper-deflocalvar viper-last-jump nil) +(defvar-local viper-last-jump nil) ;; Remembers position of the last jump done using `''. -(viper-deflocalvar viper-last-jump-ignore 0) +(defvar-local viper-last-jump-ignore 0) ;; History variables @@ -841,7 +839,7 @@ to customize the actual face object `viper-minibuffer-vi' this variable represents.") ;; the current face to be used in the minibuffer -(viper-deflocalvar +(defvar-local viper-minibuffer-current-face viper-minibuffer-emacs-face "") @@ -877,7 +875,7 @@ Should be set in `viper-custom-file-name'." :group 'viper) ;; overlay used in the minibuffer to indicate which state it is in -(viper-deflocalvar viper-minibuffer-overlay nil) +(defvar-local viper-minibuffer-overlay nil) (put 'viper-minibuffer-overlay 'permanent-local t) ;; Hook, specific to Viper, which is run just *before* exiting the minibuffer. @@ -946,9 +944,4 @@ on a dumb terminal." (provide 'viper-init) - -;; Local Variables: -;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) -;; End: - ;;; viper-init.el ends here diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index 7209dc664b5..1d80c9cd026 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -82,7 +82,7 @@ major mode in effect." (defvar viper-insert-intercept-map (make-sparse-keymap)) (defvar viper-emacs-intercept-map (make-sparse-keymap)) -(viper-deflocalvar viper-vi-local-user-map (make-sparse-keymap) +(defvar-local viper-vi-local-user-map (make-sparse-keymap) "Keymap for user-defined local bindings. Useful for changing bindings such as ZZ in certain major modes. For instance, in letter-mode, one may want to bind ZZ to @@ -106,7 +106,7 @@ This map is global, shared by all buffers.") This happens when viper-expert-level is 1 or 2. See viper-set-expert-level.") -(viper-deflocalvar viper-insert-local-user-map (make-sparse-keymap) +(defvar-local viper-insert-local-user-map (make-sparse-keymap) "Auxiliary map for per-buffer user-defined keybindings in Insert state.") (put 'viper-insert-local-user-map 'permanent-local t) @@ -133,7 +133,7 @@ viper-insert-basic-map. Not recommended, except for novice users.") (defvar viper-emacs-kbd-map (make-sparse-keymap) "This keymap keeps Vi-style kbd macros for Emacs mode.") -(viper-deflocalvar viper-emacs-local-user-map (make-sparse-keymap) +(defvar-local viper-emacs-local-user-map (make-sparse-keymap) "Auxiliary map for local user-defined bindings in Emacs state.") (put 'viper-emacs-local-user-map 'permanent-local t) @@ -209,22 +209,22 @@ In insert mode, this key also functions as Meta." (defvar viper-emacs-state-modifier-alist nil) ;; The list of viper keymaps. Set by viper-normalize-minor-mode-map-alist -(viper-deflocalvar viper--key-maps nil) -(viper-deflocalvar viper--intercept-key-maps nil) +(defvar-local viper--key-maps nil) +(defvar-local viper--intercept-key-maps nil) ;; Tells viper-add-local-keys to create a new viper-vi-local-user-map for new ;; buffers. Not a user option. -(viper-deflocalvar viper-need-new-vi-local-map t "") +(defvar-local viper-need-new-vi-local-map t "") (put 'viper-need-new-vi-local-map 'permanent-local t) ;; Tells viper-add-local-keys to create a new viper-insert-local-user-map for ;; new buffers. Not a user option. -(viper-deflocalvar viper-need-new-insert-local-map t "") +(defvar-local viper-need-new-insert-local-map t "") (put 'viper-need-new-insert-local-map 'permanent-local t) ;; Tells viper-add-local-keys to create a new viper-emacs-local-user-map for ;; new buffers. Not a user option. -(viper-deflocalvar viper-need-new-emacs-local-map t "") +(defvar-local viper-need-new-emacs-local-map t "") (put 'viper-need-new-emacs-local-map 'permanent-local t) @@ -654,10 +654,4 @@ form ((key . function) (key . function) ... )." (provide 'viper-keym) - -;; Local Variables: -;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) -;; End: - - ;;; viper-keym.el ends here diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index eec83dd05b5..71e40ee023e 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -74,10 +74,10 @@ considered related." :group 'viper-mouse) ;; Local variable used to toggle wraparound search on click. -(viper-deflocalvar viper-mouse-click-search-noerror t) +(defvar-local viper-mouse-click-search-noerror t) ;; Local variable used to delimit search after wraparound. -(viper-deflocalvar viper-mouse-click-search-limit nil) +(defvar-local viper-mouse-click-search-limit nil) ;; remembers prefix argument to pass along to commands invoked by second ;; click. @@ -592,11 +592,4 @@ This buffer may be different from the one where the click occurred." :set 'viper-reset-mouse-insert-key :group 'viper-mouse) - - -;; Local Variables: -;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) -;; End: - - ;;; viper-mous.el ends here diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 07a234bab9b..1bdb155538a 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -1085,10 +1085,10 @@ the `Local variables' section of a file." ;; These are characters that are not to be considered as parts of a word in ;; Viper. ;; Set each time state changes and at loading time -(viper-deflocalvar viper-non-word-characters nil) +(defvar-local viper-non-word-characters nil) ;; must be buffer-local -(viper-deflocalvar viper-ALPHA-char-class "w" +(defvar-local viper-ALPHA-char-class "w" "String of syntax classes characterizing Viper's alphanumeric symbols. In addition, the symbol `_' may be considered alphanumeric if `viper-syntax-preference' is `strict-vi' or `reformed-vi'.") @@ -1375,10 +1375,4 @@ This option is appropriate if you like Emacs-style words." (setq i (1+ i) start (1+ start))) res)))))) - - -;; Local Variables: -;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) -;; End: - ;;; viper-util.el ends here diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 6c9428060fc..df5a083a08a 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -1256,9 +1256,4 @@ These two lines must come in the order given.")) (provide 'viper) - -;; Local Variables: -;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) -;; End: - ;;; viper.el ends here diff --git a/lisp/epa.el b/lisp/epa.el index 197cd92f977..572c947e4b2 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -379,8 +379,7 @@ DOC is documentation text to insert at the start." (goto-char point)) (epa--insert-keys (epg-list-keys context name secret))) - (make-local-variable 'epa-list-keys-arguments) - (setq epa-list-keys-arguments (list name secret)) + (setq-local epa-list-keys-arguments (list name secret)) (goto-char (point-min)) (pop-to-buffer (current-buffer))) @@ -500,8 +499,7 @@ If SECRET is non-nil, list secret keys instead of public keys." (format "*Key*%s" (epg-sub-key-id primary-sub-key))))) (set-buffer (cdr entry)) (epa-key-mode) - (make-local-variable 'epa-key) - (setq epa-key key) + (setq-local epa-key key) (erase-buffer) (setq pointer (epg-key-user-id-list key)) (while pointer diff --git a/lisp/epg.el b/lisp/epg.el index b1f37cbbdcf..36515ef4e5f 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -332,7 +332,6 @@ callback data (if any)." (cl-defstruct (epg-key (:constructor nil) (:constructor epg-make-key (owner-trust)) - (:copier nil) (:predicate nil)) (owner-trust nil :read-only t) sub-key-list user-id-list) @@ -642,22 +641,14 @@ callback data (if any)." (with-current-buffer buffer (if (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil)) - (make-local-variable 'epg-last-status) - (setq epg-last-status nil) - (make-local-variable 'epg-read-point) - (setq epg-read-point (point-min)) - (make-local-variable 'epg-process-filter-running) - (setq epg-process-filter-running nil) - (make-local-variable 'epg-pending-status-list) - (setq epg-pending-status-list nil) - (make-local-variable 'epg-key-id) - (setq epg-key-id nil) - (make-local-variable 'epg-context) - (setq epg-context context) - (make-local-variable 'epg-agent-file) - (setq epg-agent-file agent-file) - (make-local-variable 'epg-agent-mtime) - (setq epg-agent-mtime agent-mtime)) + (setq-local epg-last-status nil) + (setq-local epg-read-point (point-min)) + (setq-local epg-process-filter-running nil) + (setq-local epg-pending-status-list nil) + (setq-local epg-key-id nil) + (setq-local epg-context context) + (setq-local epg-agent-file agent-file) + (setq-local epg-agent-mtime agent-mtime)) (setq error-process (make-pipe-process :name "epg-error" :buffer (generate-new-buffer " *epg-error*") @@ -1383,11 +1374,22 @@ NAME is either a string or a list of strings." keys)) (defun epg--filter-revoked-keys (keys) - (seq-remove (lambda (key) - (seq-find (lambda (user) - (eq (epg-user-id-validity user) 'revoked)) - (epg-key-user-id-list key))) - keys)) + (mapcar + (lambda (key) + ;; We have something revoked, so copy the key and remove the + ;; revoked bits. + (if (seq-find (lambda (user) + (eq (epg-user-id-validity user) 'revoked)) + (epg-key-user-id-list key)) + (let ((copy (copy-epg-key key))) + (setf (epg-key-user-id-list copy) + (seq-remove (lambda (user) + (eq (epg-user-id-validity user) 'revoked)) + (epg-key-user-id-list copy))) + copy) + ;; Nothing to delete; return the key. + key)) + keys)) (defun epg--args-from-sig-notations (notations) (apply #'nconc diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 487dc7692ef..4cabd42f532 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -120,38 +120,31 @@ ;;; User data -(defvar erc-server-current-nick nil +(defvar-local erc-server-current-nick nil "Nickname on the current server. Use `erc-current-nick' to access this.") -(make-variable-buffer-local 'erc-server-current-nick) ;;; Server attributes -(defvar erc-server-process nil +(defvar-local erc-server-process nil "The process object of the corresponding server connection.") -(make-variable-buffer-local 'erc-server-process) -(defvar erc-session-server nil +(defvar-local erc-session-server nil "The server name used to connect to for this session.") -(make-variable-buffer-local 'erc-session-server) -(defvar erc-session-connector nil +(defvar-local erc-session-connector nil "The function used to connect to this session (nil for the default).") -(make-variable-buffer-local 'erc-session-connector) -(defvar erc-session-port nil +(defvar-local erc-session-port nil "The port used to connect to.") -(make-variable-buffer-local 'erc-session-port) -(defvar erc-server-announced-name nil +(defvar-local erc-server-announced-name nil "The name the server announced to use.") -(make-variable-buffer-local 'erc-server-announced-name) -(defvar erc-server-version nil +(defvar-local erc-server-version nil "The name and version of the server's ircd.") -(make-variable-buffer-local 'erc-server-version) -(defvar erc-server-parameters nil +(defvar-local erc-server-parameters nil "Alist listing the supported server parameters. This is only set if the server sends 005 messages saying what is @@ -177,86 +170,70 @@ RFC2812 - server supports RFC 2812 features SILENCE=10 - supports the SILENCE command, maximum allowed number of entries TOPICLEN=160 - maximum allowed topic length WALLCHOPS - supports sending messages to all operators in a channel") -(make-variable-buffer-local 'erc-server-parameters) ;;; Server and connection state (defvar erc-server-ping-timer-alist nil "Mapping of server buffers to their specific ping timer.") -(defvar erc-server-connected nil +(defvar-local erc-server-connected nil "Non-nil if the current buffer has been used by ERC to establish an IRC connection. If you wish to determine whether an IRC connection is currently active, use the `erc-server-process-alive' function instead.") -(make-variable-buffer-local 'erc-server-connected) -(defvar erc-server-reconnect-count 0 +(defvar-local erc-server-reconnect-count 0 "Number of times we have failed to reconnect to the current server.") -(make-variable-buffer-local 'erc-server-reconnect-count) -(defvar erc-server-quitting nil +(defvar-local erc-server-quitting nil "Non-nil if the user requests a quit.") -(make-variable-buffer-local 'erc-server-quitting) -(defvar erc-server-reconnecting nil +(defvar-local erc-server-reconnecting nil "Non-nil if the user requests an explicit reconnect, and the current IRC process is still alive.") -(make-variable-buffer-local 'erc-server-reconnecting) -(defvar erc-server-timed-out nil +(defvar-local erc-server-timed-out nil "Non-nil if the IRC server failed to respond to a ping.") -(make-variable-buffer-local 'erc-server-timed-out) -(defvar erc-server-banned nil +(defvar-local erc-server-banned nil "Non-nil if the user is denied access because of a server ban.") -(make-variable-buffer-local 'erc-server-banned) -(defvar erc-server-error-occurred nil +(defvar-local erc-server-error-occurred nil "Non-nil if the user triggers some server error.") -(make-variable-buffer-local 'erc-server-error-occurred) -(defvar erc-server-lines-sent nil +(defvar-local erc-server-lines-sent nil "Line counter.") -(make-variable-buffer-local 'erc-server-lines-sent) -(defvar erc-server-last-peers '(nil . nil) +(defvar-local erc-server-last-peers '(nil . nil) "Last peers used, both sender and receiver. Those are used for /MSG destination shortcuts.") -(make-variable-buffer-local 'erc-server-last-peers) -(defvar erc-server-last-sent-time nil +(defvar-local erc-server-last-sent-time nil "Time the message was sent. This is useful for flood protection.") -(make-variable-buffer-local 'erc-server-last-sent-time) -(defvar erc-server-last-ping-time nil +(defvar-local erc-server-last-ping-time nil "Time the last ping was sent. This is useful for flood protection.") -(make-variable-buffer-local 'erc-server-last-ping-time) -(defvar erc-server-last-received-time nil +(defvar-local erc-server-last-received-time nil "Time the last message was received from the server. This is useful for detecting hung connections.") -(make-variable-buffer-local 'erc-server-last-received-time) -(defvar erc-server-lag nil +(defvar-local erc-server-lag nil "Calculated server lag time in seconds. This variable is only set in a server buffer.") -(make-variable-buffer-local 'erc-server-lag) -(defvar erc-server-filter-data nil +(defvar-local erc-server-filter-data nil "The data that arrived from the server but has not been processed yet.") -(make-variable-buffer-local 'erc-server-filter-data) -(defvar erc-server-duplicates (make-hash-table :test 'equal) +(defvar-local erc-server-duplicates (make-hash-table :test 'equal) "Internal variable used to track duplicate messages.") -(make-variable-buffer-local 'erc-server-duplicates) ;; From Circe -(defvar erc-server-processing-p nil +(defvar-local erc-server-processing-p nil "Non-nil when we're currently processing a message. When ERC receives a private message, it sets up a new buffer for @@ -267,23 +244,19 @@ network exceptions. So, if someone sends you two messages quickly after each other, ispell is started for the first, but might take long enough for the second message to be processed first.") -(make-variable-buffer-local 'erc-server-processing-p) -(defvar erc-server-flood-last-message 0 +(defvar-local erc-server-flood-last-message 0 "When we sent the last message. See `erc-server-flood-margin' for an explanation of the flood protection algorithm.") -(make-variable-buffer-local 'erc-server-flood-last-message) -(defvar erc-server-flood-queue nil +(defvar-local erc-server-flood-queue nil "The queue of messages waiting to be sent to the server. See `erc-server-flood-margin' for an explanation of the flood protection algorithm.") -(make-variable-buffer-local 'erc-server-flood-queue) -(defvar erc-server-flood-timer nil +(defvar-local erc-server-flood-timer nil "The timer to resume sending.") -(make-variable-buffer-local 'erc-server-flood-timer) ;;; IRC protocol and misc options @@ -453,9 +426,8 @@ If this is set to nil, never try to reconnect." :type '(choice (const :tag "Disabled" nil) (integer :tag "Seconds"))) -(defvar erc-server-ping-handler nil +(defvar-local erc-server-ping-handler nil "This variable holds the periodic ping timer.") -(make-variable-buffer-local 'erc-server-ping-handler) ;;;; Helper functions diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el index 06d4fbd9f6a..4e4d012545a 100644 --- a/lisp/erc/erc-capab.el +++ b/lisp/erc/erc-capab.el @@ -113,13 +113,11 @@ character not found in IRC nicknames to avoid confusion." ;;; Variables: -(defvar erc-capab-identify-activated nil +(defvar-local erc-capab-identify-activated nil "CAPAB IDENTIFY-MSG has been activated.") -(make-variable-buffer-local 'erc-capab-identify-activated) -(defvar erc-capab-identify-sent nil +(defvar-local erc-capab-identify-sent nil "CAPAB IDENTIFY-MSG and IDENTIFY-CTCP messages have been sent.") -(make-variable-buffer-local 'erc-capab-identify-sent) ;;; Functions: diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 590785e91c2..9dedd3cda86 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -538,8 +538,7 @@ PROC is the server process." nil '(notice error) 'active 'dcc-get-notfound ?n nick ?f filename)))) -(defvar erc-dcc-byte-count nil) -(make-variable-buffer-local 'erc-dcc-byte-count) +(defvar-local erc-dcc-byte-count nil) (defun erc-dcc-do-LIST-command (proc) "This is the handler for the /dcc list command. @@ -751,9 +750,8 @@ the matching regexp, or nil if none found." 'dcc-malformed ?n nick ?u login ?h host ?q query))))) -(defvar erc-dcc-entry-data nil +(defvar-local erc-dcc-entry-data nil "Holds the `erc-dcc-list' entry for this DCC connection.") -(make-variable-buffer-local 'erc-dcc-entry-data) ;;; SEND handling @@ -905,8 +903,7 @@ other client." :group 'erc-dcc :type 'integer) -(defvar erc-dcc-file-name nil) -(make-variable-buffer-local 'erc-dcc-file-name) +(defvar-local erc-dcc-file-name nil) (defun erc-dcc-get-file (entry file parent-proc) "Set up a transfer from the remote client to the local over a TCP connection. diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el index 62238dd4344..8378ff53742 100644 --- a/lisp/erc/erc-ezbounce.el +++ b/lisp/erc/erc-ezbounce.el @@ -61,9 +61,8 @@ The alist's format is as follows: "Alist of actions to take on NOTICEs from EZBounce.") -(defvar erc-ezb-session-list '() +(defvar-local erc-ezb-session-list '() "List of detached EZBounce sessions.") -(make-variable-buffer-local 'erc-ezb-session-list) (defvar erc-ezb-inside-session-listing nil "Indicate whether current notices are expected to be EZB session listings.") diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el index 1a2d8e2755f..ecdfc2a04b5 100644 --- a/lisp/erc/erc-imenu.el +++ b/lisp/erc/erc-imenu.el @@ -73,13 +73,11 @@ Don't rely on this function, read it first!" (topic-change-alist '()) prev-pos) (goto-char (point-max)) - (imenu-progress-message prev-pos 0) (while (if (bolp) (> (forward-line -1) -1) (progn (forward-line 0) t)) - (imenu-progress-message prev-pos nil t) (save-match-data (when (looking-at (concat (regexp-quote erc-notice-prefix) "\\(.+\\)$")) diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index 947b2949690..e6e50707830 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -105,8 +105,7 @@ servers, presumably in the same domain." :group 'erc-autojoin :type 'boolean) -(defvar erc--autojoin-timer nil) -(make-variable-buffer-local 'erc--autojoin-timer) +(defvar-local erc--autojoin-timer nil) (defun erc-autojoin-channels-delayed (server nick buffer) "Attempt to autojoin channels. diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el index 9fd3cfe1cc4..37fc4cf16c1 100644 --- a/lisp/erc/erc-netsplit.el +++ b/lisp/erc/erc-netsplit.el @@ -82,12 +82,11 @@ Args: PROC is the process the netjoin originated from and :group 'erc-hooks :type 'hook) -(defvar erc-netsplit-list nil +(defvar-local erc-netsplit-list nil "This is a list of the form \((\"a.b.c.d e.f.g\" TIMESTAMP FIRST-JOIN \"nick1\" ... \"nickn\") ...) where FIRST-JOIN is t or nil, depending on whether or not the first join from that split has been detected or not.") -(make-variable-buffer-local 'erc-netsplit-list) (defun erc-netsplit-install-message-catalogs () (erc-define-catalog diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 9c2bb9dfee3..9926255e3aa 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -722,9 +722,8 @@ MATCHER is used to find a corresponding network to a server while (regexp) (const :tag "Network has no common server ending" nil))))) -(defvar erc-network nil +(defvar-local erc-network nil "The name of the network you are connected to (a symbol).") -(make-variable-buffer-local 'erc-network) ;; Functions: diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el index 098049edc68..e133e05a7d3 100644 --- a/lisp/erc/erc-notify.el +++ b/lisp/erc/erc-notify.el @@ -75,13 +75,11 @@ strings." ;;;; Internal variables -(defvar erc-last-ison nil +(defvar-local erc-last-ison nil "Last ISON information received through `erc-notify-timer'.") -(make-variable-buffer-local 'erc-last-ison) -(defvar erc-last-ison-time 0 +(defvar-local erc-last-ison-time 0 "Last time ISON was sent to the server in `erc-notify-timer'.") -(make-variable-buffer-local 'erc-last-ison-time) ;;;; Setup diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index ab4c7c580c6..ddaf78774a6 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -89,7 +89,7 @@ for use on `completion-at-point-function'." (defun pcomplete-erc-setup () "Setup `erc-mode' to use pcomplete." - (setq-local pcomplete-ignore-case t) + (setq-local completion-ignore-case t) (setq-local pcomplete-use-paring nil) (setq-local pcomplete-parse-arguments-function #'pcomplete-erc-parse-arguments) diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el index 3813eafe004..71a9f8ef3da 100644 --- a/lisp/erc/erc-ring.el +++ b/lisp/erc/erc-ring.el @@ -53,16 +53,14 @@ be recalled using M-p and M-n." (define-key erc-mode-map "\M-p" 'undefined) (define-key erc-mode-map "\M-n" 'undefined))) -(defvar erc-input-ring nil "Input ring for erc.") -(make-variable-buffer-local 'erc-input-ring) +(defvar-local erc-input-ring nil "Input ring for erc.") -(defvar erc-input-ring-index nil +(defvar-local erc-input-ring-index nil "Position in the input ring for erc. If nil, the input line is blank and the user is conceptually after the most recently added item in the ring. If an integer, the input line is non-blank and displays the item from the ring indexed by this variable.") -(make-variable-buffer-local 'erc-input-ring-index) (defun erc-input-ring-setup () "Do the setup required so that we can use comint style input rings. diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index c7dfb0807bc..2c42a18081e 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -191,21 +191,18 @@ or `erc-send-modify-hook'." (list (lambda (_window _before dir) (erc-echo-timestamp dir ct)))))))) -(defvar erc-timestamp-last-inserted nil +(defvar-local erc-timestamp-last-inserted nil "Last timestamp inserted into the buffer.") -(make-variable-buffer-local 'erc-timestamp-last-inserted) -(defvar erc-timestamp-last-inserted-left nil +(defvar-local erc-timestamp-last-inserted-left nil "Last timestamp inserted into the left side of the buffer. This is used when `erc-insert-timestamp-function' is set to `erc-timestamp-left-and-right'") -(make-variable-buffer-local 'erc-timestamp-last-inserted-left) -(defvar erc-timestamp-last-inserted-right nil +(defvar-local erc-timestamp-last-inserted-right nil "Last timestamp inserted into the right side of the buffer. This is used when `erc-insert-timestamp-function' is set to `erc-timestamp-left-and-right'") -(make-variable-buffer-local 'erc-timestamp-last-inserted-right) (defcustom erc-timestamp-only-if-changed-flag t "Insert timestamp only if its value changed since last insertion. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index bb68173b6dc..dd7f50fb381 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -270,9 +270,8 @@ A typical value would be \((\"#emacs\" \"QUIT\" \"JOIN\") :group 'erc-ignore :type 'erc-message-type) -(defvar erc-session-password nil +(defvar-local erc-session-password nil "The password used for the current session.") -(make-variable-buffer-local 'erc-session-password) (defcustom erc-disconnected-hook nil "Run this hook with arguments (NICK IP REASON) when disconnected. @@ -337,18 +336,16 @@ Functions are passed a buffer as the first argument." :type 'hook) -(defvar erc-channel-users nil +(defvar-local erc-channel-users nil "A hash table of members in the current channel, which associates nicknames with cons cells of the form: \(USER . MEMBER-DATA) where USER is a pointer to an erc-server-user struct, and MEMBER-DATA is a pointer to an erc-channel-user struct.") -(make-variable-buffer-local 'erc-channel-users) -(defvar erc-server-users nil +(defvar-local erc-server-users nil "A hash table of users on the current server, which associates nicknames with erc-server-user struct instances.") -(make-variable-buffer-local 'erc-server-users) (defun erc-downcase (string) "Convert STRING to IRC standard conforming downcase." @@ -632,23 +629,19 @@ See also: `erc-get-channel-user-list'." (or (not nicky) (string-lessp nickx nicky)))))))) -(defvar erc-channel-topic nil +(defvar-local erc-channel-topic nil "A topic string for the channel. Should only be used in channel-buffers.") -(make-variable-buffer-local 'erc-channel-topic) -(defvar erc-channel-modes nil +(defvar-local erc-channel-modes nil "List of strings representing channel modes. E.g. (\"i\" \"m\" \"s\" \"b Quake!*@*\") \(not sure the ban list will be here, but why not)") -(make-variable-buffer-local 'erc-channel-modes) -(defvar erc-insert-marker nil +(defvar-local erc-insert-marker nil "The place where insertion of new text in erc buffers should happen.") -(make-variable-buffer-local 'erc-insert-marker) -(defvar erc-input-marker nil +(defvar-local erc-input-marker nil "The marker where input should be inserted.") -(make-variable-buffer-local 'erc-input-marker) (defun erc-string-no-properties (string) "Return a copy of STRING will all text-properties removed." @@ -900,9 +893,8 @@ directory in the list." :group 'erc-scripts :type 'boolean) -(defvar erc-last-saved-position nil +(defvar-local erc-last-saved-position nil "A marker containing the position the current buffer was last saved at.") -(make-variable-buffer-local 'erc-last-saved-position) (defcustom erc-kill-buffer-on-part nil "Kill the channel buffer on PART. @@ -1271,8 +1263,7 @@ See also `erc-show-my-nick'." (defvar erc-debug-log-file (expand-file-name "ERC.debug") "Debug log file name.") -(defvar erc-dbuf nil) -(make-variable-buffer-local 'erc-dbuf) +(defvar-local erc-dbuf nil) (defmacro define-erc-module (name alias doc enable-body disable-body &optional local-p) @@ -1462,11 +1453,10 @@ If BUFFER is nil, the current buffer is used." ;; Last active buffer, to print server messages in the right place -(defvar erc-active-buffer nil +(defvar-local erc-active-buffer nil "The current active buffer, the one where the user typed the last command. Defaults to the server buffer, and should only be set in the server buffer.") -(make-variable-buffer-local 'erc-active-buffer) (defun erc-active-buffer () "Return the value of `erc-active-buffer' for the current server. @@ -1820,52 +1810,41 @@ all channel buffers on all servers." ;; Some local variables -(defvar erc-default-recipients nil +(defvar-local erc-default-recipients nil "List of default recipients of the current buffer.") -(make-variable-buffer-local 'erc-default-recipients) -(defvar erc-session-user-full-name nil +(defvar-local erc-session-user-full-name nil "Full name of the user on the current server.") -(make-variable-buffer-local 'erc-session-user-full-name) -(defvar erc-channel-user-limit nil +(defvar-local erc-channel-user-limit nil "Limit of users per channel.") -(make-variable-buffer-local 'erc-channel-user-limit) -(defvar erc-channel-key nil +(defvar-local erc-channel-key nil "Key needed to join channel.") -(make-variable-buffer-local 'erc-channel-key) -(defvar erc-invitation nil +(defvar-local erc-invitation nil "Last invitation channel.") -(make-variable-buffer-local 'erc-invitation) -(defvar erc-away nil +(defvar-local erc-away nil "Non-nil indicates that we are away. Use `erc-away-time' to access this if you might be in a channel buffer rather than a server buffer.") -(make-variable-buffer-local 'erc-away) -(defvar erc-channel-list nil +(defvar-local erc-channel-list nil "Server channel list.") -(make-variable-buffer-local 'erc-channel-list) -(defvar erc-bad-nick nil +(defvar-local erc-bad-nick nil "Non-nil indicates that we got a `nick in use' error while connecting.") -(make-variable-buffer-local 'erc-bad-nick) -(defvar erc-logged-in nil +(defvar-local erc-logged-in nil "Non-nil indicates that we are logged in.") -(make-variable-buffer-local 'erc-logged-in) -(defvar erc-default-nicks nil +(defvar-local erc-default-nicks nil "The local copy of `erc-nick' - the list of nicks to choose from.") -(make-variable-buffer-local 'erc-default-nicks) -(defvar erc-nick-change-attempt-count 0 +(defvar-local erc-nick-change-attempt-count 0 "Used to keep track of how many times an attempt at changing nick is made.") -(make-variable-buffer-local 'erc-nick-change-attempt-count) (defun erc-migrate-modules (mods) "Migrate old names of ERC modules to new ones." @@ -2764,8 +2743,7 @@ present." (let ((prop-val (erc-get-parsed-vector position))) (and prop-val (member (erc-response.command prop-val) list)))) -(defvar erc-send-input-line-function 'erc-send-input-line) -(make-variable-buffer-local 'erc-send-input-line-function) +(defvar-local erc-send-input-line-function 'erc-send-input-line) (defun erc-send-input-line (target line &optional force) "Send LINE to TARGET. @@ -3181,12 +3159,11 @@ were most recently invited. See also `invitation'." (defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN) (defalias 'erc-cmd-J 'erc-cmd-JOIN) -(defvar erc-channel-new-member-names nil +(defvar-local erc-channel-new-member-names nil "If non-nil, a names list is currently being received. If non-nil, this variable is a hash-table that associates received nicks with t.") -(make-variable-buffer-local 'erc-channel-new-member-names) (defun erc-cmd-NAMES (&optional channel) "Display the users in CHANNEL. @@ -3833,7 +3810,7 @@ If CHANNEL is not specified, clear the topic for the default channel." ;;; Banlists -(defvar erc-channel-banlist nil +(defvar-local erc-channel-banlist nil "A list of bans seen for the current channel. Each ban is an alist of the form: @@ -3841,7 +3818,6 @@ Each ban is an alist of the form: The property `received-from-server' indicates whether or not the ban list has been requested from the server.") -(make-variable-buffer-local 'erc-channel-banlist) (put 'erc-channel-banlist 'received-from-server nil) (defun erc-cmd-BANLIST () @@ -6488,32 +6464,31 @@ if `erc-away' is non-nil." (setq mode-line-buffer-identification (list (format-spec erc-mode-line-format spec))) (setq mode-line-process (list process-status)) - (when (boundp 'header-line-format) - (let ((header (if erc-header-line-format - (format-spec erc-header-line-format spec) - nil))) - (cond (erc-header-line-uses-tabbar-p - (setq-local tabbar--local-hlf header-line-format) - (kill-local-variable 'header-line-format)) - ((null header) - (setq header-line-format nil)) - (erc-header-line-uses-help-echo-p - (let ((help-echo (with-temp-buffer - (insert header) - (fill-region (point-min) (point-max)) - (buffer-string)))) - (setq header-line-format - (replace-regexp-in-string - "%" - "%%" - (if face - (propertize header 'help-echo help-echo - 'face face) - (propertize header 'help-echo help-echo)))))) - (t (setq header-line-format - (if face - (propertize header 'face face) - header))))))) + (let ((header (if erc-header-line-format + (format-spec erc-header-line-format spec) + nil))) + (cond (erc-header-line-uses-tabbar-p + (setq-local tabbar--local-hlf header-line-format) + (kill-local-variable 'header-line-format)) + ((null header) + (setq header-line-format nil)) + (erc-header-line-uses-help-echo-p + (let ((help-echo (with-temp-buffer + (insert header) + (fill-region (point-min) (point-max)) + (buffer-string)))) + (setq header-line-format + (replace-regexp-in-string + "%" + "%%" + (if face + (propertize header 'help-echo help-echo + 'face face) + (propertize header 'help-echo help-echo)))))) + (t (setq header-line-format + (if face + (propertize header 'face face) + header)))))) (force-mode-line-update))) (defun erc-update-mode-line (&optional buffer) @@ -6783,8 +6758,7 @@ functions." ""))))) -(defvar erc-current-message-catalog 'english) -(make-variable-buffer-local 'erc-current-message-catalog) +(defvar-local erc-current-message-catalog 'english) (defun erc-retrieve-catalog-entry (entry &optional catalog) "Retrieve ENTRY from CATALOG. diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index 0200631da66..cbfe0b81545 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -91,27 +91,23 @@ variable names, arguments, etc." (defcustom eshell-cmpl-load-hook nil "A list of functions to run when `eshell-cmpl' is loaded." :version "24.1" ; removed eshell-cmpl-initialize - :type 'hook - :group 'eshell-cmpl) + :type 'hook) (defcustom eshell-show-lisp-completions nil "If non-nil, include Lisp functions in the command completion list. If this variable is nil, Lisp completion can still be done in command position by using M-TAB instead of TAB." - :type 'boolean - :group 'eshell-cmpl) + :type 'boolean) (defcustom eshell-show-lisp-alternatives t "If non-nil, and no other completions found, show Lisp functions. Setting this variable means nothing if `eshell-show-lisp-completions' is non-nil." - :type 'boolean - :group 'eshell-cmpl) + :type 'boolean) (defcustom eshell-no-completion-during-jobs t "If non-nil, don't allow completion while a process is running." - :type 'boolean - :group 'eshell-cmpl) + :type 'boolean) (defcustom eshell-command-completions-alist '(("acroread" . "\\.pdf\\'") @@ -136,8 +132,7 @@ is non-nil." "An alist that defines simple argument type correlations. This is provided for common commands, as a simplistic alternative to writing a completion function." - :type '(repeat (cons string regexp)) - :group 'eshell-cmpl) + :type '(repeat (cons string regexp))) (defun eshell-cmpl--custom-variable-docstring (pcomplete-var) "Generate the docstring of a variable derived from a pcomplete-* variable." @@ -148,23 +143,19 @@ to writing a completion function." (defcustom eshell-cmpl-file-ignore "~\\'" (eshell-cmpl--custom-variable-docstring 'pcomplete-file-ignore) - :type (get 'pcomplete-file-ignore 'custom-type) - :group 'eshell-cmpl) + :type (get 'pcomplete-file-ignore 'custom-type)) (defcustom eshell-cmpl-dir-ignore "\\`\\(\\.\\.?\\|CVS\\)/\\'" (eshell-cmpl--custom-variable-docstring 'pcomplete-dir-ignore) - :type (get 'pcomplete-dir-ignore 'custom-type) - :group 'eshell-cmpl) + :type (get 'pcomplete-dir-ignore 'custom-type)) (defcustom eshell-cmpl-ignore-case (eshell-under-windows-p) - (eshell-cmpl--custom-variable-docstring 'pcomplete-ignore-case) - :type (get 'pcomplete-ignore-case 'custom-type) - :group 'eshell-cmpl) + (eshell-cmpl--custom-variable-docstring 'completion-ignore-case) + :type (get 'completion-ignore-case 'custom-type)) (defcustom eshell-cmpl-autolist nil (eshell-cmpl--custom-variable-docstring 'pcomplete-autolist) - :type (get 'pcomplete-autolist 'custom-type) - :group 'eshell-cmpl) + :type (get 'pcomplete-autolist 'custom-type)) (defcustom eshell-cmpl-suffix-list (list ?/ ?:) (eshell-cmpl--custom-variable-docstring 'pcomplete-suffix-list) @@ -176,51 +167,42 @@ to writing a completion function." (defcustom eshell-cmpl-recexact nil (eshell-cmpl--custom-variable-docstring 'pcomplete-recexact) - :type (get 'pcomplete-recexact 'custom-type) - :group 'eshell-cmpl) + :type (get 'pcomplete-recexact 'custom-type)) -(defcustom eshell-cmpl-man-function 'man +(defcustom eshell-cmpl-man-function #'man (eshell-cmpl--custom-variable-docstring 'pcomplete-man-function) - :type (get 'pcomplete-man-function 'custom-type) - :group 'eshell-cmpl) + :type (get 'pcomplete-man-function 'custom-type)) -(defcustom eshell-cmpl-compare-entry-function 'file-newer-than-file-p +(defcustom eshell-cmpl-compare-entry-function #'file-newer-than-file-p (eshell-cmpl--custom-variable-docstring 'pcomplete-compare-entry-function) - :type (get 'pcomplete-compare-entry-function 'custom-type) - :group 'eshell-cmpl) + :type (get 'pcomplete-compare-entry-function 'custom-type)) (defcustom eshell-cmpl-expand-before-complete nil (eshell-cmpl--custom-variable-docstring 'pcomplete-expand-before-complete) - :type (get 'pcomplete-expand-before-complete 'custom-type) - :group 'eshell-cmpl) + :type (get 'pcomplete-expand-before-complete 'custom-type)) (defcustom eshell-cmpl-cycle-completions t (eshell-cmpl--custom-variable-docstring 'pcomplete-cycle-completions) - :type (get 'pcomplete-cycle-completions 'custom-type) - :group 'eshell-cmpl) + :type (get 'pcomplete-cycle-completions 'custom-type)) (defcustom eshell-cmpl-cycle-cutoff-length 5 (eshell-cmpl--custom-variable-docstring 'pcomplete-cycle-cutoff-length) - :type (get 'pcomplete-cycle-cutoff-length 'custom-type) - :group 'eshell-cmpl) + :type (get 'pcomplete-cycle-cutoff-length 'custom-type)) (defcustom eshell-cmpl-restore-window-delay 1 (eshell-cmpl--custom-variable-docstring 'pcomplete-restore-window-delay) - :type (get 'pcomplete-restore-window-delay 'custom-type) - :group 'eshell-cmpl) + :type (get 'pcomplete-restore-window-delay 'custom-type)) (defcustom eshell-command-completion-function (lambda () - (pcomplete-here (eshell-complete-commands-list))) + (pcomplete-here (eshell--complete-commands-list))) (eshell-cmpl--custom-variable-docstring 'pcomplete-command-completion-function) - :type (get 'pcomplete-command-completion-function 'custom-type) - :group 'eshell-cmpl) + :type (get 'pcomplete-command-completion-function 'custom-type)) (defcustom eshell-cmpl-command-name-function - 'eshell-completion-command-name + #'eshell-completion-command-name (eshell-cmpl--custom-variable-docstring 'pcomplete-command-name-function) - :type (get 'pcomplete-command-name-function 'custom-type) - :group 'eshell-cmpl) + :type (get 'pcomplete-command-name-function 'custom-type)) (defcustom eshell-default-completion-function (lambda () @@ -229,13 +211,11 @@ to writing a completion function." (cdr (assoc (funcall eshell-cmpl-command-name-function) eshell-command-completions-alist)))))) (eshell-cmpl--custom-variable-docstring 'pcomplete-default-completion-function) - :type (get 'pcomplete-default-completion-function 'custom-type) - :group 'eshell-cmpl) + :type (get 'pcomplete-default-completion-function 'custom-type)) (defcustom eshell-cmpl-use-paring t (eshell-cmpl--custom-variable-docstring 'pcomplete-use-paring) - :type (get 'pcomplete-use-paring 'custom-type) - :group 'eshell-cmpl) + :type (get 'pcomplete-use-paring 'custom-type)) ;;; Functions: @@ -274,12 +254,12 @@ to writing a completion function." (setq-local pcomplete-default-completion-function eshell-default-completion-function) (setq-local pcomplete-parse-arguments-function - 'eshell-complete-parse-arguments) + #'eshell-complete-parse-arguments) (setq-local pcomplete-file-ignore eshell-cmpl-file-ignore) (setq-local pcomplete-dir-ignore eshell-cmpl-dir-ignore) - (setq-local pcomplete-ignore-case + (setq-local completion-ignore-case eshell-cmpl-ignore-case) (setq-local pcomplete-autolist eshell-cmpl-autolist) @@ -403,64 +383,65 @@ to writing a completion function." args) posns))) -(defun eshell-complete-commands-list () +(defun eshell--complete-commands-list () "Generate list of applicable, visible commands." - (let ((filename (pcomplete-arg)) glob-name) - (if (file-name-directory filename) - (if eshell-force-execution - (pcomplete-dirs-or-entries nil #'file-readable-p) - (pcomplete-executables)) - (if (and (> (length filename) 0) - (eq (aref filename 0) eshell-explicit-command-char)) - (setq filename (substring filename 1) - pcomplete-stub filename - glob-name t)) - (let* ((paths (eshell-get-path)) - (cwd (file-name-as-directory - (expand-file-name default-directory))) - (path "") (comps-in-path ()) - (file "") (filepath "") (completions ())) - ;; Go thru each path in the search path, finding completions. - (while paths - (setq path (file-name-as-directory - (expand-file-name (or (car paths) "."))) - comps-in-path - (and (file-accessible-directory-p path) - (file-name-all-completions filename path))) - ;; Go thru each completion found, to see whether it should - ;; be used. - (while comps-in-path - (setq file (car comps-in-path) - filepath (concat path file)) - (if (and (not (member file completions)) ; - (or (string-equal path cwd) - (not (file-directory-p filepath))) - (if eshell-force-execution - (file-readable-p filepath) - (file-executable-p filepath))) - (setq completions (cons file completions))) - (setq comps-in-path (cdr comps-in-path))) - (setq paths (cdr paths))) - ;; Add aliases which are currently visible, and Lisp functions. - (pcomplete-uniquify-list - (if glob-name - completions - (setq completions - (append (if (fboundp 'eshell-alias-completions) - (eshell-alias-completions filename)) - (eshell-winnow-list - (mapcar - (lambda (name) - (substring name 7)) - (all-completions (concat "eshell/" filename) - obarray #'functionp)) - nil '(eshell-find-alias-function)) - completions)) - (append (and (or eshell-show-lisp-completions - (and eshell-show-lisp-alternatives - (null completions))) - (all-completions filename obarray #'functionp)) - completions))))))) + ;; Building the commands list can take quite a while, especially over Tramp + ;; (bug#41423), so do it lazily. + (let ((glob-name + ;; When a command is specified using `eshell-explicit-command-char', + ;; that char is not part of the command and hence not part of what + ;; we complete. Adjust `pcomplete-stub' accordingly! + (if (and (> (length pcomplete-stub) 0) + (eq (aref pcomplete-stub 0) eshell-explicit-command-char)) + (setq pcomplete-stub (substring pcomplete-stub 1))))) + (completion-table-dynamic + (lambda (filename) + (if (file-name-directory filename) + (if eshell-force-execution + (pcomplete-dirs-or-entries nil #'file-readable-p) + (pcomplete-executables)) + (let* ((paths (eshell-get-path)) + (cwd (file-name-as-directory + (expand-file-name default-directory))) + (filepath "") (completions ())) + ;; Go thru each path in the search path, finding completions. + (dolist (path paths) + (setq path (file-name-as-directory + (expand-file-name (or path ".")))) + ;; Go thru each completion found, to see whether it should + ;; be used. + (dolist (file (and (file-accessible-directory-p path) + (file-name-all-completions filename path))) + (setq filepath (concat path file)) + (if (and (not (member file completions)) ; + (or (string-equal path cwd) + (not (file-directory-p filepath))) + ;; FIXME: Those repeated file tests end up + ;; very costly over Tramp, we should cache the result. + (if eshell-force-execution + (file-readable-p filepath) + (file-executable-p filepath))) + (push file completions)))) + ;; Add aliases which are currently visible, and Lisp functions. + (pcomplete-uniquify-list + (if glob-name + completions + (setq completions + (append (if (fboundp 'eshell-alias-completions) + (eshell-alias-completions filename)) + (eshell-winnow-list + (mapcar + (lambda (name) + (substring name 7)) + (all-completions (concat "eshell/" filename) + obarray #'functionp)) + nil '(eshell-find-alias-function)) + completions)) + (append (and (or eshell-show-lisp-completions + (and eshell-show-lisp-alternatives + (null completions))) + (all-completions filename obarray #'functionp)) + completions))))))))) (define-obsolete-function-alias 'eshell-pcomplete #'completion-at-point "27.1") diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 0d09ef4a12e..b7b1778ebb1 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -99,8 +99,12 @@ If it is nil, Eshell will use the value of HISTFILE." (defcustom eshell-hist-ignoredups nil "If non-nil, don't add input matching the last on the input ring. -This mirrors the optional behavior of bash." - :type 'boolean) +The value `erase' mirrors the \"erasedups\" value of HISTCONTROL +in bash, and any other non-nil value mirrors the \"ignoredups\" +value." + :type '(choice (const :tag "Don't ignore anything" nil) + (const :tag "Ignore consecutive duplicates" t) + (const :tag "Only keep last duplicate" 'erase))) (defcustom eshell-save-history-on-exit t "Determine if history should be automatically saved. @@ -371,12 +375,22 @@ unless a different file is specified on the command line.") Input is entered into the input history ring, if the value of variable `eshell-input-filter' returns non-nil when called on the input." - (if (and (funcall eshell-input-filter input) - (or (null eshell-hist-ignoredups) - (not (ring-p eshell-history-ring)) - (ring-empty-p eshell-history-ring) - (not (string-equal (eshell-get-history 0) input)))) - (eshell-put-history input)) + (when (and (funcall eshell-input-filter input) + (if (eq eshell-hist-ignoredups 'erase) + ;; Remove any old occurrences of the input, and put + ;; the new one at the end. + (progn + (ring-remove eshell-history-ring + (ring-member eshell-history-ring input)) + t) + ;; Always add... + (or (null eshell-hist-ignoredups) + ;; ... or add if it's not already present at the + ;; end. + (not (ring-p eshell-history-ring)) + (ring-empty-p eshell-history-ring) + (not (string-equal (eshell-get-history 0) input))))) + (eshell-put-history input)) (setq eshell-save-history-index eshell-history-index) (setq eshell-history-index nil)) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 4d63467899b..daca035ea49 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -1001,7 +1001,7 @@ be finished later after the completion of an asynchronous subprocess." ;; expand any macros directly into the form. This is done so that ;; we can modify any `let' forms to evaluate only once. (if (macrop (car form)) - (let ((exp (eshell-copy-tree (macroexpand form)))) + (let ((exp (copy-tree (macroexpand form)))) (eshell-manipulate (format-message "expanding macro `%s'" (symbol-name (car form))) (setcar form (car exp)) @@ -1009,7 +1009,7 @@ be finished later after the completion of an asynchronous subprocess." (let ((args (cdr form))) (cond ((eq (car form) 'while) - ;; `eshell-copy-tree' is needed here so that the test argument + ;; `copy-tree' is needed here so that the test argument ;; doesn't get modified and thus always yield the same result. (when (car eshell-command-body) (cl-assert (not synchronous-p)) @@ -1017,27 +1017,27 @@ be finished later after the completion of an asynchronous subprocess." (setcar eshell-command-body nil) (setcar eshell-test-body nil)) (unless (car eshell-test-body) - (setcar eshell-test-body (eshell-copy-tree (car args)))) + (setcar eshell-test-body (copy-tree (car args)))) (while (cadr (eshell-do-eval (car eshell-test-body))) (setcar eshell-command-body (if (cddr args) - `(progn ,@(eshell-copy-tree (cdr args))) - (eshell-copy-tree (cadr args)))) + `(progn ,@(copy-tree (cdr args))) + (copy-tree (cadr args)))) (eshell-do-eval (car eshell-command-body) synchronous-p) (setcar eshell-command-body nil) - (setcar eshell-test-body (eshell-copy-tree (car args)))) + (setcar eshell-test-body (copy-tree (car args)))) (setcar eshell-command-body nil)) ((eq (car form) 'if) - ;; `eshell-copy-tree' is needed here so that the test argument + ;; `copy-tree' is needed here so that the test argument ;; doesn't get modified and thus always yield the same result. (if (car eshell-command-body) (progn (cl-assert (not synchronous-p)) (eshell-do-eval (car eshell-command-body))) (unless (car eshell-test-body) - (setcar eshell-test-body (eshell-copy-tree (car args)))) + (setcar eshell-test-body (copy-tree (car args)))) (setcar eshell-command-body - (eshell-copy-tree + (copy-tree (if (cadr (eshell-do-eval (car eshell-test-body))) (cadr args) (car (cddr args))))) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 872e3b52046..8ef1ac9c345 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -235,11 +235,10 @@ If N or M is nil, it means the end of the list." a (last a))) a)) -(defvar eshell-path-env (getenv "PATH") +(defvar-local eshell-path-env (getenv "PATH") "Content of $PATH. It might be different from \(getenv \"PATH\"), when `default-directory' points to a remote host.") -(make-variable-buffer-local 'eshell-path-env) (defun eshell-get-path () "Return $PATH as a list. @@ -486,8 +485,6 @@ list." "Return the user id for user NAME." (car (rassoc name (eshell-read-user-names)))) -(defalias 'eshell-user-name 'user-login-name) - (autoload 'pcomplete-read-hosts-file "pcomplete") (autoload 'pcomplete-read-hosts "pcomplete") (autoload 'pcomplete-read-host-names "pcomplete") @@ -644,8 +641,6 @@ gid format. Valid values are `string' and `integer', defaulting to entry) (file-attributes file id-format)))) -(defalias 'eshell-copy-tree 'copy-tree) - (defsubst eshell-processp (proc) "If the `processp' function does not exist, PROC is not a process." (and (fboundp 'processp) (processp proc))) @@ -715,6 +710,9 @@ gid format. Valid values are `string' and `integer', defaulting to ; (or result ; (file-attributes filename)))) +(define-obsolete-function-alias 'eshell-copy-tree #'copy-tree "28.1") +(define-obsolete-function-alias 'eshell-user-name #'user-login-name "28.1") + (provide 'esh-util) ;;; esh-util.el ends here diff --git a/lisp/expand.el b/lisp/expand.el index 5c0b5f42817..9df8d9f15ac 100644 --- a/lisp/expand.el +++ b/lisp/expand.el @@ -289,17 +289,14 @@ If ARG is omitted, point is placed at the end of the expanded text." (defvar expand-list nil "Temporary variable used by the Expand package.") -(defvar expand-pos nil +(defvar-local expand-pos nil "If non-nil, store a vector with position markers defined by the last expansion.") -(make-variable-buffer-local 'expand-pos) -(defvar expand-index 0 +(defvar-local expand-index 0 "Index of the last marker used in `expand-pos'.") -(make-variable-buffer-local 'expand-index) -(defvar expand-point nil +(defvar-local expand-point nil "End of the expanded region.") -(make-variable-buffer-local 'expand-point) (defun expand-add-abbrev (table abbrev expansion arg) "Add one abbreviation and provide the hook to move to the specified positions." diff --git a/lisp/face-remap.el b/lisp/face-remap.el index c53b20f3338..5914ee4a202 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -217,21 +217,17 @@ Each positive or negative step scales the default face height by this amount." :type 'number :version "23.1") -;; current remapping cookie for text-scale-mode -(defvar text-scale-mode-remapping nil) -(make-variable-buffer-local 'text-scale-mode-remapping) +(defvar-local text-scale-mode-remapping nil + "Current remapping cookie for text-scale-mode.") -;; Lighter displayed for text-scale-mode in mode-line minor-mode list -(defvar text-scale-mode-lighter "+0") -(make-variable-buffer-local 'text-scale-mode-lighter) +(defvar-local text-scale-mode-lighter "+0" + "Lighter displayed for text-scale-mode in mode-line minor-mode list.") -;; Number of steps that text-scale-mode will increase/decrease text height -(defvar text-scale-mode-amount 0) -(make-variable-buffer-local 'text-scale-mode-amount) +(defvar-local text-scale-mode-amount 0 + "Number of steps that text-scale-mode will increase/decrease text height.") -(defvar text-scale-remap-header-line nil +(defvar-local text-scale-remap-header-line nil "If non-nil, text scaling may change font size of header lines too.") -(make-variable-buffer-local 'text-scale-header-line) (defun face-remap--clear-remappings () (dolist (remapping @@ -358,9 +354,9 @@ INC may be passed as a numeric prefix argument. The actual adjustment made depends on the final component of the key-binding used to invoke the command, with all modifiers removed: - +, = Increase the default face height by one step - - Decrease the default face height by one step - 0 Reset the default face height to the global default + +, = Increase the height of the default face by one step + - Decrease the height of the default face by one step + 0 Reset the height of the default face to the global default After adjusting, continue to read input events and further adjust the face height as long as the input event read @@ -413,8 +409,7 @@ plist, etc." :version "23.1") ;; current remapping cookie for buffer-face-mode -(defvar buffer-face-mode-remapping nil) -(make-variable-buffer-local 'buffer-face-mode-remapping) +(defvar-local buffer-face-mode-remapping nil) ;;;###autoload (define-minor-mode buffer-face-mode diff --git a/lisp/facemenu.el b/lisp/facemenu.el index dc5f8f46aba..6290b02add2 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -85,10 +85,6 @@ ;;; Code: -;; Global bindings: -(define-key global-map [C-down-mouse-2] 'facemenu-menu) -(define-key global-map "\M-o" 'facemenu-keymap) - (defgroup facemenu nil "Create a face menu for interactively adding fonts to text." :group 'faces diff --git a/lisp/ffap.el b/lisp/ffap.el index 1f43bafdb93..6faf8d50b26 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1675,9 +1675,8 @@ For example, try \":/\" for URL (and some FTP) references." :type '(choice (const nil) regexp) :group 'ffap) -(defvar ffap-menu-alist nil +(defvar-local ffap-menu-alist nil "Buffer local cache of menu presented by `ffap-menu'.") -(make-variable-buffer-local 'ffap-menu-alist) (defvar ffap-menu-text-plist (cond diff --git a/lisp/files-x.el b/lisp/files-x.el index 628bf180929..526a128623c 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -570,13 +570,12 @@ from the MODE alist ignoring the input argument VALUE." (defvar enable-connection-local-variables t "Non-nil means enable use of connection-local variables.") -(defvar connection-local-variables-alist nil +(defvar-local connection-local-variables-alist nil "Alist of connection-local variable settings in the current buffer. Each element in this list has the form (VAR . VALUE), where VAR is a connection-local variable (a symbol) and VALUE is its value. The actual value in the buffer may differ from VALUE, if it is changed by the user.") -(make-variable-buffer-local 'connection-local-variables-alist) (setq ignored-local-variables (cons 'connection-local-variables-alist ignored-local-variables)) diff --git a/lisp/files.el b/lisp/files.el index 5adbb43c7fb..4c56b5fd4f1 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -191,20 +191,18 @@ if the file has changed on disk and you have not edited the buffer." :type '(repeat regexp) :group 'find-file) -(defvar buffer-file-number nil +(defvar-local buffer-file-number nil "The device number and file number of the file visited in the current buffer. The value is a list of the form (FILENUM DEVNUM). This pair of numbers uniquely identifies the file. If the buffer is visiting a new file, the value is nil.") -(make-variable-buffer-local 'buffer-file-number) (put 'buffer-file-number 'permanent-local t) (defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt))) "Non-nil means that `buffer-file-number' uniquely identifies files.") -(defvar buffer-file-read-only nil +(defvar-local buffer-file-read-only nil "Non-nil if visited file was read-only when visited.") -(make-variable-buffer-local 'buffer-file-read-only) (defcustom small-temporary-file-directory (if (eq system-type 'ms-dos) (getenv "TMPDIR")) @@ -529,15 +527,14 @@ updates before the buffer is saved, use `before-save-hook'.") (put 'write-file-functions 'permanent-local t) ;; I found some files still using the obsolete form in 2018. -(defvar local-write-file-hooks nil) -(make-variable-buffer-local 'local-write-file-hooks) +(defvar-local local-write-file-hooks nil) (put 'local-write-file-hooks 'permanent-local t) (make-obsolete-variable 'local-write-file-hooks 'write-file-functions "22.1") ;; I found some files still using the obsolete form in 2018. (define-obsolete-variable-alias 'write-contents-hooks 'write-contents-functions "22.1") -(defvar write-contents-functions nil +(defvar-local write-contents-functions nil "List of functions to be called before writing out a buffer to a file. Used only by `save-buffer'. If one of them returns non-nil, the @@ -556,7 +553,6 @@ For hooks that _do_ pertain to the particular visited file, use `write-file-functions' relate to how a buffer is saved to file. To perform various checks or updates before the buffer is saved, use `before-save-hook'.") -(make-variable-buffer-local 'write-contents-functions) (defcustom enable-local-variables t "Control use of local variables in files you visit. @@ -2539,13 +2535,11 @@ unless NOMODES is non-nil." (msg (cond ((not warn) nil) - ((and error (file-attributes buffer-file-name)) + ((and error (file-exists-p buffer-file-name)) (setq buffer-read-only t) - (if (and (file-symlink-p buffer-file-name) - (not (file-exists-p - (file-chase-links buffer-file-name)))) - "Symbolic link that points to nonexistent file" - "File exists, but cannot be read")) + "File exists, but cannot be read") + ((and error (file-symlink-p buffer-file-name)) + "Symbolic link that points to nonexistent file") ((not buffer-read-only) (if (and warn ;; No need to warn if buffer is auto-saved @@ -2562,13 +2556,12 @@ unless NOMODES is non-nil." ((not error) (setq not-serious t) "Note: file is write protected") - ((file-attributes (directory-file-name default-directory)) + ((file-accessible-directory-p default-directory) "File not found and directory write-protected") - ((file-exists-p (file-name-directory buffer-file-name)) - (setq buffer-read-only nil)) (t (setq buffer-read-only nil) - "Use M-x make-directory RET RET to create the directory and its parents")))) + (unless (file-directory-p default-directory) + "Use M-x make-directory RET RET to create the directory and its parents"))))) (when msg (message "%s" msg) (or not-serious (sit-for 1 t)))) @@ -3448,23 +3441,21 @@ asking you for confirmation." (put 'c-set-style 'safe-local-eval-function t) -(defvar file-local-variables-alist nil +(defvar-local file-local-variables-alist nil "Alist of file-local variable settings in the current buffer. Each element in this list has the form (VAR . VALUE), where VAR is a file-local variable (a symbol) and VALUE is the value specified. The actual value in the buffer may differ from VALUE, if it is changed by the major or minor modes, or by the user.") -(make-variable-buffer-local 'file-local-variables-alist) (put 'file-local-variables-alist 'permanent-local t) -(defvar dir-local-variables-alist nil +(defvar-local dir-local-variables-alist nil "Alist of directory-local variable settings in the current buffer. Each element in this list has the form (VAR . VALUE), where VAR is a directory-local variable (a symbol) and VALUE is the value specified in .dir-locals.el. The actual value in the buffer may differ from VALUE, if it is changed by the major or minor modes, or by the user.") -(make-variable-buffer-local 'dir-local-variables-alist) (defvar before-hack-local-variables-hook nil "Normal hook run before setting file-local variables. @@ -5238,7 +5229,7 @@ Used only by `save-buffer'." :type 'hook :group 'files) -(defvar save-buffer-coding-system nil +(defvar-local save-buffer-coding-system nil "If non-nil, use this coding system for saving the buffer. More precisely, use this coding system in place of the value of `buffer-file-coding-system', when saving the buffer. @@ -5246,7 +5237,6 @@ Calling `write-region' for any purpose other than saving the buffer will still use `buffer-file-coding-system'; this variable has no effect in such cases.") -(make-variable-buffer-local 'save-buffer-coding-system) (put 'save-buffer-coding-system 'permanent-local t) (defun basic-save-buffer (&optional called-interactively) @@ -5515,9 +5505,8 @@ Before and after saving the buffer, this function runs "ACTION-ALIST argument used in call to `map-y-or-n-p'.") (put 'save-some-buffers-action-alist 'risky-local-variable t) -(defvar buffer-save-without-query nil +(defvar-local buffer-save-without-query nil "Non-nil means `save-some-buffers' should save this buffer without asking.") -(make-variable-buffer-local 'buffer-save-without-query) (defcustom save-some-buffers-default-predicate nil "Default predicate for `save-some-buffers'. diff --git a/lisp/foldout.el b/lisp/foldout.el index 4c479d68e9a..2de49d2839c 100644 --- a/lisp/foldout.el +++ b/lisp/foldout.el @@ -209,14 +209,12 @@ (require 'outline) -(defvar foldout-fold-list nil +(defvar-local foldout-fold-list nil "List of start and end markers for the folds currently entered. An end marker of nil means the fold ends after (point-max).") -(make-variable-buffer-local 'foldout-fold-list) -(defvar foldout-mode-line-string nil +(defvar-local foldout-mode-line-string nil "Mode line string announcing that we are in an outline fold.") -(make-variable-buffer-local 'foldout-mode-line-string) ;; put our minor mode string immediately following outline-minor-mode's (or (assq 'foldout-mode-line-string minor-mode-alist) diff --git a/lisp/follow.el b/lisp/follow.el index 292dc4a0225..069758747c1 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -1140,9 +1140,8 @@ Otherwise, return nil." ;; is nil. Start every window directly after the end of the previous ;; window, to make sure long lines are displayed correctly. -(defvar follow-start-end-invalid t +(defvar-local follow-start-end-invalid t "When non-nil, indicates `follow-windows-start-end-cache' is invalid.") -(make-variable-buffer-local 'follow-start-end-invalid) (defun follow-redisplay (&optional windows win preserve-win) "Reposition the WINDOWS around WIN. diff --git a/lisp/font-core.el b/lisp/font-core.el index 0f1a3d1c364..4b695424977 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el @@ -26,7 +26,7 @@ ;; This variable is used by mode packages that support Font Lock mode by ;; defining their own keywords to use for `font-lock-keywords'. (The mode ;; command should make it buffer-local and set it to provide the set up.) -(defvar font-lock-defaults nil +(defvar-local font-lock-defaults nil "Defaults for Font Lock mode specified by the major mode. Defaults should be of the form: @@ -66,7 +66,6 @@ functions, `font-lock-fontify-buffer-function', `font-lock-unfontify-region-function', and `font-lock-inhibit-thing-lock'.") ;;;###autoload (put 'font-lock-defaults 'risky-local-variable t) -(make-variable-buffer-local 'font-lock-defaults) (defvar font-lock-function 'font-lock-default-function "A function which is called when `font-lock-mode' is toggled. diff --git a/lisp/font-lock.el b/lisp/font-lock.el index a9fc69d419a..c344a612581 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -515,17 +515,15 @@ This is normally set via `font-lock-add-keywords' and "Non-nil means Font Lock should not fontify comments or strings. This is normally set via `font-lock-defaults'.") -(defvar font-lock-keywords-case-fold-search nil +(defvar-local font-lock-keywords-case-fold-search nil "Non-nil means the patterns in `font-lock-keywords' are case-insensitive. This is set via the function `font-lock-set-defaults', based on the CASE-FOLD argument of `font-lock-defaults'.") -(make-variable-buffer-local 'font-lock-keywords-case-fold-search) -(defvar font-lock-syntactically-fontified 0 +(defvar-local font-lock-syntactically-fontified 0 "Point up to which `font-lock-syntactic-keywords' has been applied. If nil, this is ignored, in which case the syntactic fontification may sometimes be slightly incorrect.") -(make-variable-buffer-local 'font-lock-syntactically-fontified) (defvar font-lock-syntactic-face-function (lambda (state) @@ -1026,7 +1024,7 @@ The value of this variable is used when Font Lock mode is turned on." ;; directives correctly and cleanly. (It is the same problem as fontifying ;; multi-line strings and comments; regexps are not appropriate for the job.) -(defvar font-lock-extend-after-change-region-function nil +(defvar-local font-lock-extend-after-change-region-function nil "A function that determines the region to refontify after a change. This variable is either nil, or is a function that determines the @@ -1040,7 +1038,6 @@ and end buffer positions \(in that order) of the region to refontify, or nil \(which directs the caller to fontify a default region). This function should preserve the match-data. The region it returns may start or end in the middle of a line.") -(make-variable-buffer-local 'font-lock-extend-after-change-region-function) (defun font-lock-fontify-buffer (&optional interactively) "Fontify the current buffer the way the function `font-lock-mode' would." @@ -1159,7 +1156,7 @@ a very meaningful entity to highlight.") (defvar font-lock-beg) (defvar font-lock-end) -(defvar font-lock-extend-region-functions +(defvar-local font-lock-extend-region-functions '(font-lock-extend-region-wholelines ;; This use of font-lock-multiline property is unreliable but is just ;; a handy heuristic: in case you don't have a function that does @@ -1181,7 +1178,6 @@ These functions are run in turn repeatedly until they all return nil. Put first the functions more likely to cause a change and cheaper to compute.") ;; Mark it as a special hook which doesn't use any global setting ;; (i.e. doesn't obey the element t in the buffer-local value). -(make-variable-buffer-local 'font-lock-extend-region-functions) (defun font-lock-extend-region-multiline () "Move fontification boundaries away from any `font-lock-multiline' property." @@ -1888,9 +1884,8 @@ preserve `hi-lock-mode' highlighting patterns." (kill-local-variable 'font-lock-set-defaults) (font-lock-mode 1)) -(defvar font-lock-major-mode nil +(defvar-local font-lock-major-mode nil "Major mode for which the font-lock settings have been setup.") -(make-variable-buffer-local 'font-lock-major-mode) (defun font-lock-set-defaults () "Set fontification defaults appropriately for this mode. diff --git a/lisp/forms.el b/lisp/forms.el index 5d7e6dde96c..62c4288869a 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -418,9 +418,8 @@ Also, initial position is at last record." (defvar forms--parser nil "Forms parser routine.") -(defvar forms--mode-setup nil +(defvar-local forms--mode-setup nil "To keep track of forms-mode being set-up.") -(make-variable-buffer-local 'forms--mode-setup) (defvar forms--dynamic-text nil "Array that holds dynamic texts to insert between fields.") diff --git a/lisp/frame.el b/lisp/frame.el index 06aab269ddd..ce4de83b8c5 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1370,6 +1370,7 @@ FRAME defaults to the selected frame." FRAME defaults to the selected frame." (setq frame (window-normalize-frame frame)) (- (frame-native-height frame) + (tab-bar-height frame t) (* 2 (frame-internal-border-width frame)))) (defun frame-outer-width (&optional frame) diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 4c6e1189003..0f4e1ae4a6e 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -23,7 +23,7 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: -;; + ;; This file contains a collection of generic modes. ;; ;; INSTALLATION: @@ -32,17 +32,6 @@ ;; ;; (require 'generic-x) ;; -;; You can decide which modes to load by setting the variable -;; `generic-extras-enable-list'. Its default value is platform- -;; specific. The recommended way to set this variable is through -;; customize: -;; -;; M-x customize-option RET generic-extras-enable-list RET -;; -;; This lets you select generic modes from the list of available -;; modes. If you manually set `generic-extras-enable-list' in your -;; .emacs, do it BEFORE loading generic-x with (require 'generic-x). -;; ;; You can also send in new modes; if the file types are reasonably ;; common, we would like to install them. ;; @@ -184,88 +173,7 @@ This hook will be installed if the variable ;; Other Generic modes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; If you add a generic mode to this file, put it in one of these four -;; lists as well. - -(defconst generic-default-modes - '(apache-conf-generic-mode - apache-log-generic-mode - hosts-generic-mode - java-manifest-generic-mode - java-properties-generic-mode - javascript-generic-mode - show-tabs-generic-mode - vrml-generic-mode) - "List of generic modes that are defined by default.") - -(defconst generic-mswindows-modes - '(bat-generic-mode - inf-generic-mode - ini-generic-mode - rc-generic-mode - reg-generic-mode - rul-generic-mode) - "List of generic modes that are defined by default on MS-Windows.") - -(defconst generic-unix-modes - '(alias-generic-mode - ansible-inventory-generic-mode - etc-fstab-generic-mode - etc-modules-conf-generic-mode - etc-passwd-generic-mode - etc-services-generic-mode - etc-sudoers-generic-mode - fvwm-generic-mode - inetd-conf-generic-mode - mailagent-rules-generic-mode - mailrc-generic-mode - named-boot-generic-mode - named-database-generic-mode - prototype-generic-mode - resolve-conf-generic-mode - samba-generic-mode - x-resource-generic-mode - xmodmap-generic-mode) - "List of generic modes that are defined by default on Unix.") - -(defconst generic-other-modes - '(astap-generic-mode - ibis-generic-mode - pkginfo-generic-mode - spice-generic-mode) - "List of generic modes that are not defined by default.") - -(defcustom generic-extras-enable-list - (append generic-default-modes - (if (memq system-type '(windows-nt ms-dos)) - generic-mswindows-modes - generic-unix-modes) - nil) - "List of generic modes to define. -Each entry in the list should be a symbol. If you set this variable -directly, without using customize, you must reload generic-x to put -your changes into effect." - :type (let (list) - (dolist (mode - (sort (append generic-default-modes - generic-mswindows-modes - generic-unix-modes - generic-other-modes - nil) - (lambda (a b) - (string< (symbol-name b) - (symbol-name a)))) - (cons 'set list)) - (push `(const ,mode) list))) - :set (lambda (s v) - (set-default s v) - (unless load-in-progress - (load "generic-x"))) - :version "22.1") - ;;; Apache -(when (memq 'apache-conf-generic-mode generic-extras-enable-list) - (define-generic-mode apache-conf-generic-mode '(?#) nil @@ -278,9 +186,7 @@ your changes into effect." '((nil "^\\([-A-Za-z0-9_]+\\)" 1) ("*Directories*" "^\\s-*<Directory\\s-*\\([^>]+\\)>" 1) ("*Locations*" "^\\s-*<Location\\s-*\\([^>]+\\)>" 1))))) - "Generic mode for Apache or HTTPD configuration files.")) - -(when (memq 'apache-log-generic-mode generic-extras-enable-list) + "Generic mode for Apache or HTTPD configuration files.") (define-generic-mode apache-log-generic-mode nil @@ -291,11 +197,9 @@ your changes into effect." (2 font-lock-variable-name-face))) '("access_log\\'") nil - "Generic mode for Apache log files.")) + "Generic mode for Apache log files.") ;;; Samba -(when (memq 'samba-generic-mode generic-extras-enable-list) - (define-generic-mode samba-generic-mode '(?\; ?#) nil @@ -305,13 +209,11 @@ your changes into effect." (2 font-lock-type-face))) '("smb\\.conf\\'") '(generic-bracket-support) - "Generic mode for Samba configuration files.")) + "Generic mode for Samba configuration files.") ;;; Fvwm ;; This is pretty basic. Also, modes for other window managers could ;; be defined as well. -(when (memq 'fvwm-generic-mode generic-extras-enable-list) - (define-generic-mode fvwm-generic-mode '(?#) '("AddToMenu" @@ -330,33 +232,28 @@ your changes into effect." nil '("\\.fvwmrc\\'" "\\.fvwm2rc\\'") nil - "Generic mode for FVWM configuration files.")) + "Generic mode for FVWM configuration files.") ;;; X Resource ;; I'm pretty sure I've seen an actual mode to do this, but I don't ;; think it's standard with Emacs -(when (memq 'x-resource-generic-mode generic-extras-enable-list) - (define-generic-mode x-resource-generic-mode '(?!) nil '(("^\\([^:\n]+:\\)" 1 font-lock-variable-name-face)) '("\\.Xdefaults\\'" "\\.Xresources\\'" "\\.Xenvironment\\'" "\\.ad\\'") nil - "Generic mode for X Resource configuration files.")) + "Generic mode for X Resource configuration files.") -(if (memq 'xmodmap-generic-mode generic-extras-enable-list) (define-generic-mode xmodmap-generic-mode '(?!) '("add" "clear" "keycode" "keysym" "remove" "pointer") nil '("[xX]modmap\\(rc\\)?\\'") nil - "Simple mode for xmodmap files.")) + "Simple mode for xmodmap files.") ;;; Hosts -(when (memq 'hosts-generic-mode generic-extras-enable-list) - (define-generic-mode hosts-generic-mode '(?#) '("localhost") @@ -364,27 +261,20 @@ your changes into effect." ("\\<\\([0-9A-Fa-f:]+\\)\\>" 1 font-lock-constant-face)) '("[hH][oO][sS][tT][sS]\\'") nil - "Generic mode for HOSTS files.")) + "Generic mode for HOSTS files.") ;;; Windows INF files -;; If i-g-m-f-f-h is defined, then so is i-g-m. -(declare-function ini-generic-mode "generic-x") - -(when (memq 'inf-generic-mode generic-extras-enable-list) - (define-generic-mode inf-generic-mode '(?\;) nil '(("^\\(\\[.*\\]\\)" 1 font-lock-constant-face)) '("\\.[iI][nN][fF]\\'") '(generic-bracket-support) - "Generic mode for MS-Windows INF files.")) + "Generic mode for MS-Windows INF files.") ;;; Windows INI files ;; Should define escape character as well! -(when (memq 'ini-generic-mode generic-extras-enable-list) - (define-generic-mode ini-generic-mode '(?\;) nil @@ -411,13 +301,9 @@ like an INI file. You can add this hook to `find-file-hook'." (goto-char (point-min)) (and (looking-at "^\\s-*\\[.*\\]") (ini-generic-mode))))) -(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook - 'ini-generic-mode-find-file-hook "28.1")) ;;; Windows REG files ;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax! -(when (memq 'reg-generic-mode generic-extras-enable-list) - (define-generic-mode reg-generic-mode '(?\;) '("key" "classes_root" "REGEDIT" "REGEDIT4") @@ -428,19 +314,11 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "^\\s-*\\(.*\\)\\s-*=" 1))))) - "Generic mode for MS-Windows Registry files.")) - -(declare-function w32-shell-name "w32-fns" ()) - -;;; DOS/Windows BAT files -(when (memq 'bat-generic-mode generic-extras-enable-list) - (define-obsolete-function-alias 'bat-generic-mode 'bat-mode "24.4")) + "Generic mode for MS-Windows Registry files.") ;;; Mailagent ;; Mailagent is a Unix mail filtering program. Anyone wanna do a ;; generic mode for procmail? -(when (memq 'mailagent-rules-generic-mode generic-extras-enable-list) - (define-generic-mode mailagent-rules-generic-mode '(?#) '("SAVE" "DELETE" "PIPE" "ANNOTATE" "REJECT") @@ -451,11 +329,9 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1))))) - "Generic mode for Mailagent rules files.")) + "Generic mode for Mailagent rules files.") ;; Solaris/Sys V prototype files -(when (memq 'prototype-generic-mode generic-extras-enable-list) - (define-generic-mode prototype-generic-mode '(?#) nil @@ -474,11 +350,9 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-variable-name-face))) '("prototype\\'") nil - "Generic mode for Sys V prototype files.")) + "Generic mode for Sys V prototype files.") ;; Solaris/Sys V pkginfo files -(when (memq 'pkginfo-generic-mode generic-extras-enable-list) - (define-generic-mode pkginfo-generic-mode '(?#) nil @@ -487,17 +361,9 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-variable-name-face))) '("pkginfo\\'") nil - "Generic mode for Sys V pkginfo files.")) - -;; Javascript mode -;; Obsolete; defer to js-mode from js.el. -(when (memq 'javascript-generic-mode generic-extras-enable-list) - (define-obsolete-function-alias 'javascript-generic-mode 'js-mode "24.3") - (define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3")) + "Generic mode for Sys V pkginfo files.") ;; VRML files -(when (memq 'vrml-generic-mode generic-extras-enable-list) - (define-generic-mode vrml-generic-mode '(?#) '("DEF" @@ -545,11 +411,9 @@ like an INI file. You can add this hook to `find-file-hook'." ("*Definitions*" "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{" 1))))) - "Generic Mode for VRML files.")) + "Generic Mode for VRML files.") ;; Java Manifests -(when (memq 'java-manifest-generic-mode generic-extras-enable-list) - (define-generic-mode java-manifest-generic-mode '(?#) '("Name" @@ -566,11 +430,9 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-constant-face))) '("[mM][aA][nN][iI][fF][eE][sS][tT]\\.[mM][fF]\\'") nil - "Generic mode for Java Manifest files.")) + "Generic mode for Java Manifest files.") ;; Java properties files -(when (memq 'java-properties-generic-mode generic-extras-enable-list) - (define-generic-mode java-properties-generic-mode '(?! ?#) nil @@ -596,11 +458,9 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "^\\([^#! \t\n\r=:]+\\)" 1))))) - "Generic mode for Java properties files.")) + "Generic mode for Java properties files.") ;; C shell alias definitions -(when (memq 'alias-generic-mode generic-extras-enable-list) - (define-generic-mode alias-generic-mode '(?#) '("alias" "unalias") @@ -613,11 +473,9 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2))))) - "Generic mode for C Shell alias files.")) + "Generic mode for C Shell alias files.") ;; Ansible inventory files -(when (memq 'ansible-inventory-generic-mode generic-extras-enable-list) - (define-generic-mode ansible-inventory-generic-mode '(?#) nil @@ -636,12 +494,10 @@ like an INI file. You can add this hook to `find-file-hook'." (setq imenu-generic-expression '((nil "^\\s-*\\[\\(.*\\)\\]" 1) ("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1))))) - "Generic mode for Ansible inventory files.")) + "Generic mode for Ansible inventory files.") ;;; Windows RC files ;; Contributed by ACorreir@pervasive-sw.com (Alfred Correira) -(when (memq 'rc-generic-mode generic-extras-enable-list) - (define-generic-mode rc-generic-mode ;; '(?\/) '("//") @@ -721,15 +577,13 @@ like an INI file. You can add this hook to `find-file-hook'." '("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t)))) - '("\\.[rR][cC]\\'") - nil - "Generic mode for MS-Windows Resource files.")) + '("\\.[rR][cC]\\'") + nil + "Generic mode for MS-Windows Resource files.") ;; InstallShield RUL files ;; Contributed by Alfred.Correira@Pervasive.Com ;; Bugfixes by "Rolf Sandau" <Rolf.Sandau@marconi.com> -(when (memq 'rul-generic-mode generic-extras-enable-list) - (eval-when-compile ;;; build the regexp strings using regexp-opt @@ -1372,11 +1226,9 @@ like an INI file. You can add this hook to `find-file-hook'." > "begin" \n > _ \n resume: - > "end;")) + > "end;") ;; Additions by ACorreir@pervasive-sw.com (Alfred Correira) -(when (memq 'mailrc-generic-mode generic-extras-enable-list) - (define-generic-mode mailrc-generic-mode '(?#) '("alias" @@ -1398,11 +1250,9 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-variable-name-face))) '("\\.mailrc\\'") nil - "Mode for mailrc files.")) + "Mode for mailrc files.") ;; Inetd.conf -(when (memq 'inetd-conf-generic-mode generic-extras-enable-list) - (define-generic-mode inetd-conf-generic-mode '(?#) '("stream" @@ -1417,11 +1267,9 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))) + '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))) ;; Services -(when (memq 'etc-services-generic-mode generic-extras-enable-list) - (define-generic-mode etc-services-generic-mode '(?#) '("tcp" @@ -1434,11 +1282,9 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))) + '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))) ;; Password and Group files -(when (memq 'etc-passwd-generic-mode generic-extras-enable-list) - (define-generic-mode etc-passwd-generic-mode nil ;; No comment characters '("root") ;; Only one keyword @@ -1476,11 +1322,9 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([-A-Za-z0-9_]+\\):" 1))))))) + '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))) ;; Fstab -(when (memq 'etc-fstab-generic-mode generic-extras-enable-list) - (define-generic-mode etc-fstab-generic-mode '(?#) '("adfs" @@ -1592,11 +1436,9 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([^# \t]+\\)\\s-+" 1))))))) + '((nil "^\\([^# \t]+\\)\\s-+" 1)))))) ;; /etc/sudoers -(when (memq 'etc-sudoers-generic-mode generic-extras-enable-list) - (define-generic-mode etc-sudoers-generic-mode '(?#) '("User_Alias" "Runas_Alias" "Host_Alias" "Cmnd_Alias" @@ -1607,11 +1449,9 @@ like an INI file. You can add this hook to `find-file-hook'." ("\\<\\(%[A-Za-z0-9_]+\\)\\>" 1 font-lock-variable-name-face)) '("/etc/sudoers\\'") nil - "Generic mode for sudoers configuration files.")) + "Generic mode for sudoers configuration files.") ;; From Jacques Duthen <jacques.duthen@sncf.fr> -(when (memq 'show-tabs-generic-mode generic-extras-enable-list) - (eval-when-compile (defconst show-tabs-generic-mode-font-lock-defaults-1 @@ -1649,14 +1489,12 @@ like an INI file. You can add this hook to `find-file-hook'." nil ;; no auto-mode-alist ;; '(show-tabs-generic-mode-hook-fun) nil - "Generic mode to show tabs and trailing spaces.")) + "Generic mode to show tabs and trailing spaces.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DNS modes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(when (memq 'named-boot-generic-mode generic-extras-enable-list) - (define-generic-mode named-boot-generic-mode ;; List of comment characters '(?\;) @@ -1672,9 +1510,7 @@ like an INI file. You can add this hook to `find-file-hook'." ;; List of additional automode-alist expressions '("/etc/named\\.boot\\'") ;; List of set up functions to call - nil)) - -(when (memq 'named-database-generic-mode generic-extras-enable-list) + nil) (define-generic-mode named-database-generic-mode ;; List of comment characters @@ -1695,9 +1531,7 @@ like an INI file. You can add this hook to `find-file-hook'." (defun named-database-print-serial () "Print a serial number based on the current date." (interactive) - (insert (format-time-string named-database-time-string)))) - -(when (memq 'resolve-conf-generic-mode generic-extras-enable-list) + (insert (format-time-string named-database-time-string))) (define-generic-mode resolve-conf-generic-mode ;; List of comment characters @@ -1709,14 +1543,12 @@ like an INI file. You can add this hook to `find-file-hook'." ;; List of additional auto-mode-alist expressions '("/etc/resolve?\\.conf\\'") ;; List of set up functions to call - nil)) + nil) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Modes for spice and common electrical engineering circuit netlist formats ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(when (memq 'spice-generic-mode generic-extras-enable-list) - (define-generic-mode spice-generic-mode nil '("and" @@ -1752,9 +1584,7 @@ like an INI file. You can add this hook to `find-file-hook'." ;; Make keywords case-insensitive (lambda () (setq font-lock-defaults '(generic-font-lock-keywords nil t)))) - "Generic mode for SPICE circuit netlist files.")) - -(when (memq 'ibis-generic-mode generic-extras-enable-list) + "Generic mode for SPICE circuit netlist files.") (define-generic-mode ibis-generic-mode '(?|) @@ -1763,9 +1593,7 @@ like an INI file. You can add this hook to `find-file-hook'." ("\\(\\(_\\|\\w\\)+\\)\\s-*=" 1 font-lock-variable-name-face)) '("\\.[iI][bB][sS]\\'") '(generic-bracket-support) - "Generic mode for IBIS circuit netlist files.")) - -(when (memq 'astap-generic-mode generic-extras-enable-list) + "Generic mode for IBIS circuit netlist files.") (define-generic-mode astap-generic-mode nil @@ -1799,9 +1627,7 @@ like an INI file. You can add this hook to `find-file-hook'." ;; Make keywords case-insensitive (lambda () (setq font-lock-defaults '(generic-font-lock-keywords nil t)))) - "Generic mode for ASTAP circuit netlist files.")) - -(when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list) + "Generic mode for ASTAP circuit netlist files.") (define-generic-mode etc-modules-conf-generic-mode ;; List of comment characters @@ -1843,7 +1669,98 @@ like an INI file. You can add this hook to `find-file-hook'." ;; List of additional automode-alist expressions '("/etc/modules\\.conf" "/etc/conf\\.modules") ;; List of set up functions to call - nil)) + nil) + +;; Obsolete + +(define-obsolete-function-alias 'javascript-generic-mode #'js-mode "24.3") +(define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3") + +(define-obsolete-function-alias 'bat-generic-mode #'bat-mode "24.4") + +(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook + #'ini-generic-mode-find-file-hook "28.1") + +(defconst generic-default-modes + '(apache-conf-generic-mode + apache-log-generic-mode + hosts-generic-mode + java-manifest-generic-mode + java-properties-generic-mode + javascript-generic-mode + show-tabs-generic-mode + vrml-generic-mode) + "List of generic modes that are defined by default.") +(make-obsolete-variable 'generic-default-modes "no longer used." "28.1") + +(defconst generic-mswindows-modes + '(bat-generic-mode + inf-generic-mode + ini-generic-mode + rc-generic-mode + reg-generic-mode + rul-generic-mode) + "List of generic modes that are defined by default on MS-Windows.") +(make-obsolete-variable 'generic-mswindows-modes "no longer used." "28.1") + +(defconst generic-unix-modes + '(alias-generic-mode + ansible-inventory-generic-mode + etc-fstab-generic-mode + etc-modules-conf-generic-mode + etc-passwd-generic-mode + etc-services-generic-mode + etc-sudoers-generic-mode + fvwm-generic-mode + inetd-conf-generic-mode + mailagent-rules-generic-mode + mailrc-generic-mode + named-boot-generic-mode + named-database-generic-mode + prototype-generic-mode + resolve-conf-generic-mode + samba-generic-mode + x-resource-generic-mode + xmodmap-generic-mode) + "List of generic modes that are defined by default on Unix.") +(make-obsolete-variable 'generic-unix-modes "no longer used." "28.1") + +(defconst generic-other-modes + '(astap-generic-mode + ibis-generic-mode + pkginfo-generic-mode + spice-generic-mode) + "List of generic modes that are not defined by default.") +(make-obsolete-variable 'generic-other-modes "no longer used." "28.1") + +(defcustom generic-extras-enable-list + (append generic-default-modes + (if (memq system-type '(windows-nt ms-dos)) + generic-mswindows-modes + generic-unix-modes) + nil) + "List of generic modes to define. +Each entry in the list should be a symbol. If you set this variable +directly, without using customize, you must reload generic-x to put +your changes into effect." + :type (let (list) + (dolist (mode + (sort (append generic-default-modes + generic-mswindows-modes + generic-unix-modes + generic-other-modes + nil) + (lambda (a b) + (string< (symbol-name b) + (symbol-name a)))) + (cons 'set list)) + (push `(const ,mode) list))) + :set (lambda (s v) + (set-default s v) + (unless load-in-progress + (load "generic-x"))) + :version "22.1") +(make-obsolete-variable 'generic-extras-enable-list "no longer used." "28.1") (provide 'generic-x) diff --git a/lisp/gnus/canlock.el b/lisp/gnus/canlock.el index 6c8c1a5927a..dbdbaa83d7e 100644 --- a/lisp/gnus/canlock.el +++ b/lisp/gnus/canlock.el @@ -1,4 +1,4 @@ -;;; canlock.el --- functions for Cancel-Lock feature +;;; canlock.el --- functions for Cancel-Lock feature -*- lexical-binding: t; -*- ;; Copyright (C) 1998-1999, 2001-2021 Free Software Foundation, Inc. @@ -30,7 +30,7 @@ ;; Key) header in a news article by using a hook which will be evaluated ;; just before sending an article as follows: ;; -;; (add-hook '*e**a*e-header-hook 'canlock-insert-header t) +;; (add-hook '*e**a*e-header-hook #'canlock-insert-header t) ;; ;; Verifying Cancel-Lock is mainly a function of news servers, however, ;; you can verify your own article using the command `canlock-verify' in @@ -52,20 +52,17 @@ (defcustom canlock-password nil "Password to use when signing a Cancel-Lock or a Cancel-Key header." :type '(radio (const :format "Not specified " nil) - (string :tag "Password")) - :group 'canlock) + (string :tag "Password"))) (defcustom canlock-password-for-verify canlock-password "Password to use when verifying a Cancel-Lock or a Cancel-Key header." :type '(radio (const :format "Not specified " nil) - (string :tag "Password")) - :group 'canlock) + (string :tag "Password"))) (defcustom canlock-force-insert-header nil "If non-nil, insert a Cancel-Lock or a Cancel-Key header even if the buffer does not look like a news message." - :type 'boolean - :group 'canlock) + :type 'boolean) (defun canlock-sha1 (message) "Make a SHA-1 digest of MESSAGE as a unibyte string of length 20 bytes." diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el index b77dcdd4624..08beef7db9f 100644 --- a/lisp/gnus/deuglify.el +++ b/lisp/gnus/deuglify.el @@ -1,4 +1,4 @@ -;;; deuglify.el --- deuglify broken Outlook (Express) articles +;;; deuglify.el --- deuglify broken Outlook (Express) articles -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. @@ -155,15 +155,15 @@ ;; To automatically invoke deuglification on every article you read, ;; put something like that in your .gnus: ;; -;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-unwrap-lines) +;; (add-hook 'gnus-article-decode-hook #'gnus-article-outlook-unwrap-lines) ;; ;; or _one_ of the following lines: ;; ;; ;; repair broken attribution lines -;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-repair-attribution) +;; (add-hook 'gnus-article-decode-hook #'gnus-article-outlook-repair-attribution) ;; ;; ;; repair broken attribution lines and citations -;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-rearrange-citation) +;; (add-hook 'gnus-article-decode-hook #'gnus-article-outlook-rearrange-citation) ;; ;; Note that there always may be some false positives, so I suggest ;; using the manual invocation. After deuglification you may want to @@ -234,20 +234,17 @@ (defcustom gnus-outlook-deuglify-unwrap-min 45 "Minimum length of the cited line above the (possibly) wrapped line." :version "22.1" - :type 'integer - :group 'gnus-outlook-deuglify) + :type 'integer) (defcustom gnus-outlook-deuglify-unwrap-max 95 "Maximum length of the cited line after unwrapping." :version "22.1" - :type 'integer - :group 'gnus-outlook-deuglify) + :type 'integer) (defcustom gnus-outlook-deuglify-cite-marks ">|#%" "Characters that indicate cited lines." :version "22.1" - :type 'string - :group 'gnus-outlook-deuglify) + :type 'string) (defcustom gnus-outlook-deuglify-unwrap-stop-chars nil ;; ".?!" or nil "Characters that, when at end of cited line, inhibit unwrapping. @@ -255,44 +252,38 @@ When one of these characters is the last one on the cited line above the possibly wrapped line, it disallows unwrapping." :version "22.1" :type '(radio (const :format "None " nil) - (string :value ".?!")) - :group 'gnus-outlook-deuglify) + (string :value ".?!"))) (defcustom gnus-outlook-deuglify-no-wrap-chars "`" "Characters that, when at beginning of line, inhibit unwrapping. When one of these characters is the first one in the possibly wrapped line, it disallows unwrapping." :version "22.1" - :type 'string - :group 'gnus-outlook-deuglify) + :type 'string) (defcustom gnus-outlook-deuglify-attrib-cut-regexp "\\(On \\|Am \\)?\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),[^,]+, " "Regexp matching beginning of attribution line that should be cut off." :version "22.1" - :type 'regexp - :group 'gnus-outlook-deuglify) + :type 'regexp) (defcustom gnus-outlook-deuglify-attrib-verb-regexp "wrote\\|writes\\|says\\|schrieb\\|schreibt\\|meinte\\|skrev\\|a écrit\\|schreef\\|escribió" "Regular expression matching the verb used in an attribution line." :version "22.1" - :type 'regexp - :group 'gnus-outlook-deuglify) + :type 'regexp) (defcustom gnus-outlook-deuglify-attrib-end-regexp ": *\\|\\.\\.\\." "Regular expression matching the end of an attribution line." :version "22.1" - :type 'regexp - :group 'gnus-outlook-deuglify) + :type 'regexp) (defcustom gnus-outlook-display-hook nil "A hook called after a deuglified article has been prepared. It is run after `gnus-article-prepare-hook'." :version "22.1" - :type 'hook - :group 'gnus-outlook-deuglify) + :type 'hook) ;; Functions @@ -345,7 +336,8 @@ NODISPLAY is non-nil, don't redisplay the article buffer." "Put text from ATTR-START to the end of buffer at the top of the article buffer." ;; FIXME: 1. (*) text/plain ( ) text/html (let ((inhibit-read-only t) - (cite-marks gnus-outlook-deuglify-cite-marks)) + ;; (cite-marks gnus-outlook-deuglify-cite-marks) + ) (gnus-with-article-buffer (article-goto-body) ;; article does not start with attribution diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index ab97c593d9c..bcf8dd014bc 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -1,4 +1,4 @@ -;;; gmm-utils.el --- Utility functions for Gnus, Message and MML +;;; gmm-utils.el --- Utility functions for Gnus, Message and MML -*- lexical-binding: t; -*- ;; Copyright (C) 2006-2021 Free Software Foundation, Inc. @@ -42,8 +42,7 @@ The higher the number, the more messages will flash to say what it did. At zero, it will be totally mute; at five, it will display most important messages; and at ten, it will keep on jabbering all the time." - :type 'integer - :group 'gmm) + :type 'integer) ;;;###autoload (defun gmm-regexp-concat (regexp) @@ -69,18 +68,18 @@ Guideline for numbers: 7 - not very important messages on stuff 9 - messages inside loops." (if (<= level gmm-verbose) - (apply 'message args) + (apply #'message args) ;; We have to do this format thingy here even if the result isn't ;; shown - the return value has to be the same as the return value ;; from `message'. - (apply 'format args))) + (apply #'format args))) ;;;###autoload (defun gmm-error (level &rest args) "Beep an error if LEVEL is equal to or less than `gmm-verbose'. ARGS are passed to `message'." (when (<= (floor level) gmm-verbose) - (apply 'message args) + (apply #'message args) (ding) (let (duration) (when (and (floatp level) @@ -175,8 +174,7 @@ ARGS are passed to `message'." 'retro) "Preferred tool bar style." :type '(choice (const :tag "GNOME style" gnome) - (const :tag "Retro look" retro)) - :group 'gmm) + (const :tag "Retro look" retro))) (defvar tool-bar-map) @@ -215,25 +213,25 @@ DEFAULT-MAP specifies the default key map for ICON-LIST." ;; The dummy `gmm-ignore', see `gmm-tool-bar-item' ;; widget. Suppress tooltip by adding `:enable nil'. (if (fboundp 'tool-bar-local-item) - (apply 'tool-bar-local-item icon nil nil + (apply #'tool-bar-local-item icon nil nil map :enable nil props) ;; (tool-bar-local-item ICON DEF KEY MAP &rest PROPS) ;; (tool-bar-add-item ICON DEF KEY &rest PROPS) - (apply 'tool-bar-add-item icon nil nil :enable nil props))) + (apply #'tool-bar-add-item icon nil nil :enable nil props))) ((equal fmap t) ;; Not a menu command - (apply 'tool-bar-local-item + (apply #'tool-bar-local-item icon command (intern icon) ;; reuse icon or fmap here? map props)) (t ;; A menu command - (apply 'tool-bar-local-item-from-menu + (apply #'tool-bar-local-item-from-menu ;; (apply 'tool-bar-local-item icon def key ;; tool-bar-map props) command icon map (symbol-value fmap) props))) t)) (if (symbolp icon-list) - (eval icon-list) + (symbol-value icon-list) icon-list)) map)) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 56640ea8302..cbe3505cd10 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -1,4 +1,4 @@ -;;; gnus-agent.el --- unplugged support for Gnus +;;; gnus-agent.el --- unplugged support for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. @@ -248,9 +248,9 @@ Actually a hash table holding subjects mapped to t.") (gnus-agent-read-servers) (gnus-category-read) (gnus-agent-create-buffer) - (add-hook 'gnus-group-mode-hook 'gnus-agent-mode) - (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode) - (add-hook 'gnus-server-mode-hook 'gnus-agent-mode)) + (add-hook 'gnus-group-mode-hook #'gnus-agent-mode) + (add-hook 'gnus-summary-mode-hook #'gnus-agent-mode) + (add-hook 'gnus-server-mode-hook #'gnus-agent-mode)) (defun gnus-agent-create-buffer () (if (gnus-buffer-live-p gnus-agent-overview-buffer) @@ -422,15 +422,13 @@ manipulated as follows: (defmacro gnus-agent-with-fetch (&rest forms) "Do FORMS safely." + (declare (indent 0) (debug t)) `(unwind-protect (let ((gnus-agent-fetching t)) (gnus-agent-start-fetch) ,@forms) (gnus-agent-stop-fetch))) -(put 'gnus-agent-with-fetch 'lisp-indent-function 0) -(put 'gnus-agent-with-fetch 'edebug-form-spec '(body)) - (defmacro gnus-agent-append-to-list (tail value) `(setq ,tail (setcdr ,tail (cons ,value nil)))) @@ -573,14 +571,12 @@ manipulated as follows: (set-buffer-modified-p t)) (defmacro gnus-agent-while-plugged (&rest body) + (declare (indent 0) (debug t)) `(let ((original-gnus-plugged gnus-plugged)) - (unwind-protect - (progn (gnus-agent-toggle-plugged t) - ,@body) - (gnus-agent-toggle-plugged original-gnus-plugged)))) - -(put 'gnus-agent-while-plugged 'lisp-indent-function 0) -(put 'gnus-agent-while-plugged 'edebug-form-spec '(body)) + (unwind-protect + (progn (gnus-agent-toggle-plugged t) + ,@body) + (gnus-agent-toggle-plugged original-gnus-plugged)))) (defun gnus-agent-close-connections () "Close all methods covered by the Gnus agent." @@ -705,7 +701,7 @@ be a select method." (message-narrow-to-headers) (let* ((gcc (mail-fetch-field "gcc" nil t)) (methods (and gcc - (mapcar 'gnus-inews-group-method + (mapcar #'gnus-inews-group-method (message-unquote-tokens (message-tokenize-header gcc " ,"))))) @@ -739,7 +735,7 @@ be a select method." (interactive "P") (unless gnus-plugged (error "Groups can't be fetched when Gnus is unplugged")) - (gnus-group-iterate n 'gnus-agent-fetch-group)) + (gnus-group-iterate n #'gnus-agent-fetch-group)) (defun gnus-agent-fetch-group (&optional group) "Put all new articles in GROUP into the Agent." @@ -824,7 +820,7 @@ be a select method." (condition-case err (while t (let ((bgn (point))) - (eval (read (current-buffer))) + (eval (read (current-buffer)) t) (delete-region bgn (point)))) (end-of-file (delete-file (gnus-agent-lib-file "flags"))) @@ -1061,7 +1057,8 @@ article's mark is toggled." (let* ((alist (gnus-agent-load-alist gnus-newsgroup-name)) (headers (sort (mapcar (lambda (h) (mail-header-number h)) - gnus-newsgroup-headers) '<)) + gnus-newsgroup-headers) + #'<)) (cached (and gnus-use-cache gnus-newsgroup-cached)) (undownloaded (list nil)) (tail-undownloaded undownloaded) @@ -1132,7 +1129,7 @@ downloadable." (when gnus-newsgroup-processable (setq gnus-newsgroup-downloadable (let* ((dl gnus-newsgroup-downloadable) - (processable (sort (copy-tree gnus-newsgroup-processable) '<)) + (processable (sort (copy-tree gnus-newsgroup-processable) #'<)) (gnus-newsgroup-downloadable processable)) (gnus-agent-summary-fetch-group) @@ -1824,7 +1821,7 @@ article numbers will be returned." (dolist (arts (gnus-info-marks (gnus-get-info group))) (unless (memq (car arts) '(seen recent killed cache)) (setq articles (gnus-range-add articles (cdr arts))))) - (setq articles (sort (gnus-uncompress-sequence articles) '<))) + (setq articles (sort (gnus-uncompress-sequence articles) #'<))) ;; At this point, I have the list of articles to consider for ;; fetching. This is the list that I'll return to my caller. Some @@ -2070,7 +2067,7 @@ doesn't exist, to valid the overview buffer." alist (cdr alist)) (while sequence (push (cons (pop sequence) state) uncomp))) - (setq alist (sort uncomp 'car-less-than-car))) + (setq alist (sort uncomp #'car-less-than-car))) (setq changed-version (not (= 2 gnus-agent-article-alist-save-format))))) (when changed-version (let ((gnus-agent-article-alist alist)) @@ -2412,13 +2409,13 @@ modified) original contents, they are first saved to their own file." (setq marked-articles (nconc (gnus-uncompress-range arts) marked-articles)) )))) - (setq marked-articles (sort marked-articles '<)) + (setq marked-articles (sort marked-articles #'<)) ;; Fetch any new articles from the server (setq articles (gnus-agent-fetch-headers group)) ;; Merge new articles with marked - (setq articles (sort (append marked-articles articles) '<)) + (setq articles (sort (append marked-articles articles) #'<)) (when articles ;; Parse them and see which articles we want to fetch. @@ -2669,7 +2666,7 @@ The following commands are available: (point) (prog1 (1+ (point)) ;; Insert the text. - (eval gnus-category-line-format-spec)) + (eval gnus-category-line-format-spec t)) (list 'gnus-category gnus-tmp-name)))) (defun gnus-enter-category-buffer () @@ -2779,16 +2776,15 @@ The following commands are available: (gnus-edit-form (gnus-agent-cat-predicate info) (format "Editing the select predicate for category %s" category) - `(lambda (predicate) - ;; Avoid run-time execution of setf form - ;; (setf (gnus-agent-cat-predicate (assq ',category gnus-category-alist)) - ;; predicate) - ;; use its expansion instead: - (gnus-agent-cat-set-property (assq ',category gnus-category-alist) - 'agent-predicate predicate) - - (gnus-category-write) - (gnus-category-list))))) + (lambda (predicate) + ;; Avoid run-time execution of setf form + ;; (setf (gnus-agent-cat-predicate (assq ',category gnus-category-alist)) + ;; predicate) + ;; use its expansion instead: + (gnus-agent-cat-set-property (assq category gnus-category-alist) + 'agent-predicate predicate) + (gnus-category-write) + (gnus-category-list))))) (defun gnus-category-edit-score (category) "Edit the score expression for CATEGORY." @@ -2797,16 +2793,15 @@ The following commands are available: (gnus-edit-form (gnus-agent-cat-score-file info) (format "Editing the score expression for category %s" category) - `(lambda (score-file) - ;; Avoid run-time execution of setf form - ;; (setf (gnus-agent-cat-score-file (assq ',category gnus-category-alist)) - ;; score-file) - ;; use its expansion instead: - (gnus-agent-cat-set-property (assq ',category gnus-category-alist) - 'agent-score-file score-file) - - (gnus-category-write) - (gnus-category-list))))) + (lambda (score-file) + ;; Avoid run-time execution of setf form + ;; (setf (gnus-agent-cat-score-file (assq ',category gnus-category-alist)) + ;; score-file) + ;; use its expansion instead: + (gnus-agent-cat-set-property (assq category gnus-category-alist) + 'agent-score-file score-file) + (gnus-category-write) + (gnus-category-list))))) (defun gnus-category-edit-groups (category) "Edit the group list for CATEGORY." @@ -2815,16 +2810,15 @@ The following commands are available: (gnus-edit-form (gnus-agent-cat-groups info) (format "Editing the group list for category %s" category) - `(lambda (groups) - ;; Avoid run-time execution of setf form - ;; (setf (gnus-agent-cat-groups (assq ',category gnus-category-alist)) - ;; groups) - ;; use its expansion instead: - (gnus-agent-set-cat-groups (assq ',category gnus-category-alist) - groups) - - (gnus-category-write) - (gnus-category-list))))) + (lambda (groups) + ;; Avoid run-time execution of setf form + ;; (setf (gnus-agent-cat-groups (assq category gnus-category-alist)) + ;; groups) + ;; use its expansion instead: + (gnus-agent-set-cat-groups (assq category gnus-category-alist) + groups) + (gnus-category-write) + (gnus-category-list))))) (defun gnus-category-kill (category) "Kill the current category." @@ -3131,7 +3125,7 @@ FORCE is equivalent to setting the expiration predicates to true." (gnus-uncompress-range (cons (caar alist) (caar (last alist)))) - (sort articles '<))))) + (sort articles #'<))))) (marked ;; More articles that are excluded from the ;; expiration process (cond (gnus-agent-expire-all @@ -3863,7 +3857,7 @@ If REREAD is not nil, downloaded articles are marked as unread." (string-to-number name))) (directory-files dir nil "\\`[0-9]+\\'" t))) - '>) + #'>) (progn (gnus-make-directory dir) nil))) nov-arts alist header @@ -4167,7 +4161,7 @@ modified." (path (gnus-agent-group-pathname group)) (entry (gethash path gnus-agent-total-fetched-hashtb))) (if entry - (apply '+ entry) + (apply #'+ entry) (let ((gnus-agent-inhibit-update-total-fetched-for (not no-inhibit))) (+ (gnus-agent-update-view-total-fetched-for group nil method path) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 4ade36f4b9c..c9afa3ac948 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1,4 +1,4 @@ -;;; gnus-art.el --- article mode commands for Gnus +;;; gnus-art.el --- article mode commands for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. @@ -1432,7 +1432,7 @@ See Info node `(gnus)Customizing Articles' and Info node (message "\ ** gnus-treat-display-xface is an obsolete variable;\ use gnus-treat-display-x-face instead") - (eval (car (get 'gnus-treat-display-xface 'saved-value)))) + (eval (car (get 'gnus-treat-display-xface 'saved-value)) t)) (t value))))) (put 'gnus-treat-display-x-face 'highlight t) @@ -1623,7 +1623,7 @@ It is a string, such as \"PGP\". If nil, ask user." :group 'gnus-article :type 'boolean) -(defcustom gnus-blocked-images 'gnus-block-private-groups +(defcustom gnus-blocked-images #'gnus-block-private-groups "Images that have URLs matching this regexp will be blocked. Note that the main reason external images are included in HTML emails (these days) is to allow tracking whether you've read the @@ -1738,6 +1738,7 @@ Initialized from `text-mode-syntax-table'.") ;;; Macros for dealing with the article buffer. (defmacro gnus-with-article-headers (&rest forms) + (declare (indent 0) (debug t)) `(with-current-buffer gnus-article-buffer (save-restriction (let ((inhibit-read-only t) @@ -1746,18 +1747,13 @@ Initialized from `text-mode-syntax-table'.") (article-narrow-to-head) ,@forms)))) -(put 'gnus-with-article-headers 'lisp-indent-function 0) -(put 'gnus-with-article-headers 'edebug-form-spec '(body)) - (defmacro gnus-with-article-buffer (&rest forms) + (declare (indent 0) (debug t)) `(when (buffer-live-p (get-buffer gnus-article-buffer)) (with-current-buffer gnus-article-buffer (let ((inhibit-read-only t)) ,@forms)))) -(put 'gnus-with-article-buffer 'lisp-indent-function 0) -(put 'gnus-with-article-buffer 'edebug-form-spec '(body)) - (defun gnus-article-goto-header (header) "Go to HEADER, which is a regular expression." (re-search-forward (concat "^\\(" header "\\):") nil t)) @@ -2166,6 +2162,8 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (put-text-property (point) (1+ (point)) 'face 'underline))))))))) +(defvar ansi-color-context-region) + (defun article-treat-ansi-sequences () "Translate ANSI SGR control sequences into overlays or extents." (interactive) @@ -2711,7 +2709,7 @@ If READ-CHARSET, ask for a coding system." "Format an HTML article." (interactive) (let ((handles nil) - (buffer-read-only nil)) + (inhibit-read-only t)) (when (gnus-buffer-live-p gnus-original-article-buffer) (with-current-buffer gnus-original-article-buffer (setq handles (mm-dissect-buffer t t)))) @@ -2897,7 +2895,7 @@ message header will be added to the bodies of the \"text/html\" parts." (t "<br>\n")))) (goto-char (point-min)) (while (re-search-forward "^[\t ]+" nil t) - (dotimes (i (prog1 + (dotimes (_ (prog1 (current-column) (delete-region (match-beginning 0) (match-end 0)))) @@ -2991,7 +2989,7 @@ message header will be added to the bodies of the \"text/html\" parts." (when tmp-file (add-to-list 'gnus-article-browse-html-temp-list tmp-file)) (add-hook 'gnus-summary-prepare-exit-hook - 'gnus-article-browse-delete-temp-files) + #'gnus-article-browse-delete-temp-files) (add-hook 'gnus-exit-gnus-hook (lambda () (gnus-article-browse-delete-temp-files t))) @@ -3012,8 +3010,7 @@ message header will be added to the bodies of the \"text/html\" parts." (when header (article-decode-encoded-words) (let ((gnus-visible-headers - (or (get 'gnus-visible-headers 'standard-value) - gnus-visible-headers))) + (custom--standard-value 'gnus-visible-headers))) (article-hide-headers)) (goto-char (point-min)) (search-forward "\n\n" nil 'move) @@ -3025,6 +3022,8 @@ message header will be added to the bodies of the \"text/html\" parts." (setq showed t))))) showed)) +(defvar gnus-mime-display-attachment-buttons-in-header) + (defun gnus-article-browse-html-article (&optional arg) "View \"text/html\" parts of the current article with a WWW browser. Inline images embedded in a message using the cid scheme, as they are @@ -3045,8 +3044,8 @@ images if any to the browser, and deletes them when exiting the group (interactive "P") (if arg (gnus-summary-show-article) - (let ((gnus-visible-headers (or (get 'gnus-visible-headers 'standard-value) - gnus-visible-headers)) + (let ((gnus-visible-headers + (custom--standard-value 'gnus-visible-headers)) (gnus-mime-display-attachment-buttons-in-header nil) ;; As we insert a <hr>, there's no need for the body boundary. (gnus-treat-body-boundary nil)) @@ -4326,74 +4325,65 @@ If variable `gnus-use-long-file-name' is non-nil, it is (if (gnus-buffer-live-p gnus-original-article-buffer) (canlock-verify gnus-original-article-buffer))) -(eval-and-compile - (mapc - (lambda (func) - (let (afunc gfunc) - (if (consp func) - (setq afunc (car func) - gfunc (cdr func)) - (setq afunc func - gfunc (intern (format "gnus-%s" func)))) - (defalias gfunc - (when (fboundp afunc) - `(lambda (&optional interactive &rest args) - ,(documentation afunc t) - (interactive (list t)) - (with-current-buffer gnus-article-buffer - (if interactive - (call-interactively ',afunc) - (apply #',afunc args)))))))) - '(article-hide-headers - article-verify-x-pgp-sig - article-verify-cancel-lock - article-hide-boring-headers - article-treat-overstrike - article-treat-ansi-sequences - article-fill-long-lines - article-capitalize-sentences - article-remove-cr - article-remove-leading-whitespace - article-display-x-face - article-display-face - article-de-quoted-unreadable - article-de-base64-unreadable - article-decode-HZ - article-wash-html - article-unsplit-urls - article-hide-list-identifiers - article-strip-banner - article-babel - article-hide-pem - article-hide-signature - article-strip-headers-in-body - article-remove-trailing-blank-lines - article-strip-leading-blank-lines - article-strip-multiple-blank-lines - article-strip-leading-space - article-strip-trailing-space - article-strip-blank-lines - article-strip-all-blank-lines - article-date-local - article-date-english - article-date-iso8601 - article-date-original - article-treat-date - article-date-ut - article-decode-mime-words - article-decode-charset - article-decode-encoded-words - article-date-user - article-date-lapsed - article-date-combined-lapsed - article-emphasize - article-treat-smartquotes - ;; Obsolete alias. - article-treat-dumbquotes - article-treat-non-ascii - article-normalize-headers))) +(gnus--\,@ + (mapcar (lambda (func) + `(defun ,(intern (format "gnus-%s" func)) + (&optional interactive &rest args) + ,(format "Run `%s' in the article buffer." func) + (interactive (list t)) + (with-current-buffer gnus-article-buffer + (if interactive + (call-interactively #',func) + (apply #',func args))))) + '(article-hide-headers + article-verify-x-pgp-sig + article-verify-cancel-lock + article-hide-boring-headers + article-treat-overstrike + article-treat-ansi-sequences + article-fill-long-lines + article-capitalize-sentences + article-remove-cr + article-remove-leading-whitespace + article-display-x-face + article-display-face + article-de-quoted-unreadable + article-de-base64-unreadable + article-decode-HZ + article-wash-html + article-unsplit-urls + article-hide-list-identifiers + article-strip-banner + article-babel + article-hide-pem + article-hide-signature + article-strip-headers-in-body + article-remove-trailing-blank-lines + article-strip-leading-blank-lines + article-strip-multiple-blank-lines + article-strip-leading-space + article-strip-trailing-space + article-strip-blank-lines + article-strip-all-blank-lines + article-date-local + article-date-english + article-date-iso8601 + article-date-original + article-treat-date + article-date-ut + article-decode-mime-words + article-decode-charset + article-decode-encoded-words + article-date-user + article-date-lapsed + article-date-combined-lapsed + article-emphasize + article-treat-smartquotes + ;;article-treat-dumbquotes ;; Obsolete alias. + article-treat-non-ascii + article-normalize-headers))) (define-obsolete-function-alias 'gnus-article-treat-dumbquotes - 'gnus-article-treat-smartquotes "27.1") + #'gnus-article-treat-smartquotes "27.1") ;;; ;;; Gnus article mode @@ -4721,8 +4711,6 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-run-hooks 'gnus-article-prepare-hook) t)))))) -(defvar gnus-mime-display-attachment-buttons-in-header) - ;;;###autoload (defun gnus-article-prepare-display () "Make the current buffer look like a nice article." @@ -5009,53 +4997,53 @@ General format specifiers can also be used. See Info node "ID of a mime part that should be buttonized. `gnus-mime-save-part-and-strip' and `gnus-mime-delete-part' bind it.") +(defvar message-options-set-recipient) + (eval-when-compile (defsubst gnus-article-edit-part (handles &optional current-id) "Edit an article in order to delete a mime part. This function is exclusively used by `gnus-mime-save-part-and-strip' and `gnus-mime-delete-part', and not provided at run-time normally." - (gnus-article-edit-article - `(lambda () - (buffer-disable-undo) - (let ((mail-parse-charset (or gnus-article-charset - ',gnus-newsgroup-charset)) - (mail-parse-ignored-charsets - (or gnus-article-ignored-charsets - ',gnus-newsgroup-ignored-charsets)) - (mbl mml-buffer-list)) - (setq mml-buffer-list nil) - ;; A new text must be inserted before deleting existing ones - ;; at the end so as not to move existing markers of which - ;; the insertion type is t. - (delete-region - (point-min) - (prog1 - (goto-char (point-max)) - (insert-buffer-substring gnus-original-article-buffer))) - (mime-to-mml ',handles) - (setq gnus-article-mime-handles nil) - (let ((mbl1 mml-buffer-list)) - (setq mml-buffer-list mbl) - (setq-local mml-buffer-list mbl1)) - (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) - `(lambda (no-highlight) - (let ((mail-parse-charset (or gnus-article-charset - ',gnus-newsgroup-charset)) - (message-options message-options) - (message-options-set-recipient) - (mail-parse-ignored-charsets - (or gnus-article-ignored-charsets - ',gnus-newsgroup-ignored-charsets))) - (mml-to-mime) - (mml-destroy-buffers) - (remove-hook 'kill-buffer-hook - 'mml-destroy-buffers t) - (kill-local-variable 'mml-buffer-list)) - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) - ,gnus-summary-buffer no-highlight)) - t) + (let ((charset gnus-newsgroup-charset) + (ign-cs gnus-newsgroup-ignored-charsets) + (gch (or (mail-header-references gnus-current-headers) "")) + (ro (gnus-group-read-only-p)) + (buf gnus-summary-buffer)) + (gnus-article-edit-article + (lambda () + (buffer-disable-undo) + (let ((mail-parse-charset (or gnus-article-charset charset)) + (mail-parse-ignored-charsets + (or gnus-article-ignored-charsets ign-cs)) + (mbl mml-buffer-list)) + (setq mml-buffer-list nil) + ;; A new text must be inserted before deleting existing ones + ;; at the end so as not to move existing markers of which + ;; the insertion type is t. + (delete-region + (point-min) + (prog1 + (goto-char (point-max)) + (insert-buffer-substring gnus-original-article-buffer))) + (mime-to-mml handles) + (setq gnus-article-mime-handles nil) + (let ((mbl1 mml-buffer-list)) + (setq mml-buffer-list mbl) + (setq-local mml-buffer-list mbl1)) + (add-hook 'kill-buffer-hook #'mml-destroy-buffers t t))) + (lambda (no-highlight) + (let ((mail-parse-charset (or gnus-article-charset charset)) + (message-options message-options) + (message-options-set-recipient) + (mail-parse-ignored-charsets + (or gnus-article-ignored-charsets ign-cs))) + (mml-to-mime) + (mml-destroy-buffers) + (remove-hook 'kill-buffer-hook + #'mml-destroy-buffers t) + (kill-local-variable 'mml-buffer-list)) + (gnus-summary-edit-article-done gch ro buf no-highlight)) + t)) ;; Force buttonizing this part. (let ((gnus-mime-buttonized-part-id current-id)) (gnus-article-edit-done)) @@ -5083,50 +5071,53 @@ and `gnus-mime-delete-part', and not provided at run-time normally." file)) (gnus-mime-save-part-and-strip file)) -(defun gnus-mime-save-part-and-strip (&optional file) +(defun gnus-mime-save-part-and-strip (&optional file event) "Save the MIME part under point then replace it with an external body. If FILE is given, use it for the external part." - (interactive) - (gnus-article-check-buffer) - (when (gnus-group-read-only-p) - (error "The current group does not support deleting of parts")) - (when (mm-complicated-handles gnus-article-mime-handles) - (error "\ + (interactive (list nil last-nonmenu-event)) + (save-excursion + (mouse-set-point event) + (gnus-article-check-buffer) + (when (gnus-group-read-only-p) + (error "The current group does not support deleting of parts")) + (when (mm-complicated-handles gnus-article-mime-handles) + (error "\ The current article has a complicated MIME structure, giving up...")) - (let* ((data (get-text-property (point) 'gnus-data)) - (id (get-text-property (point) 'gnus-part)) - (handles gnus-article-mime-handles)) - (unless file - (setq file - (and data (mm-save-part data "Delete MIME part and save to: ")))) - (when file - (with-current-buffer (mm-handle-buffer data) - (erase-buffer) - (insert "Content-Type: " (mm-handle-media-type data)) - (mml-insert-parameter-string (cdr (mm-handle-type data)) - '(charset)) - ;; Add a filename for the sake of saving the part again. - (mml-insert-parameter - (mail-header-encode-parameter "name" (file-name-nondirectory file))) - (insert "\n") - (insert "Content-ID: " (message-make-message-id) "\n") - (insert "Content-Transfer-Encoding: binary\n") - (insert "\n")) - (setcdr data - (cdr (mm-make-handle nil - `("message/external-body" - (access-type . "LOCAL-FILE") - (name . ,file))))) - ;; (set-buffer gnus-summary-buffer) - (gnus-article-edit-part handles id)))) + (let* ((data (get-text-property (point) 'gnus-data)) + (id (get-text-property (point) 'gnus-part)) + (handles gnus-article-mime-handles)) + (unless file + (setq file + (and data (mm-save-part data "Delete MIME part and save to: ")))) + (when file + (with-current-buffer (mm-handle-buffer data) + (erase-buffer) + (insert "Content-Type: " (mm-handle-media-type data)) + (mml-insert-parameter-string (cdr (mm-handle-type data)) + '(charset)) + ;; Add a filename for the sake of saving the part again. + (mml-insert-parameter + (mail-header-encode-parameter "name" (file-name-nondirectory file))) + (insert "\n") + (insert "Content-ID: " (message-make-message-id) "\n") + (insert "Content-Transfer-Encoding: binary\n") + (insert "\n")) + (setcdr data + (cdr (mm-make-handle nil + `("message/external-body" + (access-type . "LOCAL-FILE") + (name . ,file))))) + ;; (set-buffer gnus-summary-buffer) + (gnus-article-edit-part handles id))))) ;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all ;; parts...>') but with stripping would be nice. -(defun gnus-mime-delete-part () +(defun gnus-mime-delete-part (&optional event) "Delete the MIME part under point. Replace it with some information about the removed part." - (interactive) + (interactive (list last-nonmenu-event)) + (mouse-set-point event) (gnus-article-check-buffer) (when (gnus-group-read-only-p) (error "The current group does not support deleting of parts")) @@ -5172,33 +5163,37 @@ Deleting parts may malfunction or destroy the article; continue? ")) ;; (set-buffer gnus-summary-buffer) (gnus-article-edit-part handles id)))) -(defun gnus-mime-save-part () +(defun gnus-mime-save-part (&optional event) "Save the MIME part under point." - (interactive) + (interactive (list last-nonmenu-event)) + (mouse-set-point event) (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) (when data (mm-save-part data)))) -(defun gnus-mime-pipe-part (&optional cmd) +(defun gnus-mime-pipe-part (&optional cmd event) "Pipe the MIME part under point to a process. Use CMD as the process." - (interactive) + (interactive (list nil last-nonmenu-event)) + (mouse-set-point event) (gnus-article-check-buffer) (let ((data (get-text-property (point) 'gnus-data))) (when data (mm-pipe-part data cmd)))) -(defun gnus-mime-view-part () +(defun gnus-mime-view-part (&optional event) "Interactively choose a viewing method for the MIME part under point." - (interactive) - (gnus-article-check-buffer) - (let ((data (get-text-property (point) 'gnus-data))) - (when data - (setq gnus-article-mime-handles - (mm-merge-handles - gnus-article-mime-handles (setq data (copy-sequence data)))) - (mm-interactively-view-part data)))) + (interactive (list last-nonmenu-event)) + (save-excursion + (mouse-set-point event) + (gnus-article-check-buffer) + (let ((data (get-text-property (point) 'gnus-data))) + (when data + (setq gnus-article-mime-handles + (mm-merge-handles + gnus-article-mime-handles (setq data (copy-sequence data)))) + (mm-interactively-view-part data))))) (defun gnus-mime-view-part-as-type-internal () (gnus-article-check-buffer) @@ -5208,55 +5203,58 @@ Use CMD as the process." (mail-content-type-get (mm-handle-type handle) 'name) ;; Content-Disposition: attachment; filename=... (cdr (assq 'filename (cdr (mm-handle-disposition handle)))))) - (def-type (and name (mm-default-file-encoding name)))) + (def-type (and name (mm-default-file-type name)))) (or (and def-type (cons def-type 0)) (and handle (equal (mm-handle-media-supertype handle) "text") '("text/plain" . 0)) '("application/octet-stream" . 0)))) -(defun gnus-mime-view-part-as-type (&optional mime-type pred) +(defun gnus-mime-view-part-as-type (&optional mime-type pred event) "Choose a MIME media type, and view the part as such. If non-nil, PRED is a predicate to use during completion to limit the available media-types." - (interactive) - (unless mime-type - (setq mime-type - (let ((default (gnus-mime-view-part-as-type-internal))) - (gnus-completing-read - "View as MIME type" - (if pred - (seq-filter pred (mailcap-mime-types)) - (mailcap-mime-types)) - nil nil nil - (car default))))) - (gnus-article-check-buffer) - (let ((handle (get-text-property (point) 'gnus-data))) - (when handle - (when (equal (mm-handle-media-type handle) "message/external-body") - (unless (mm-handle-cache handle) - (mm-extern-cache-contents handle)) - (setq handle (mm-handle-cache handle))) - (setq handle - (mm-make-handle (mm-handle-buffer handle) - (cons mime-type (cdr (mm-handle-type handle))) - (mm-handle-encoding handle) - (mm-handle-undisplayer handle) - (mm-handle-disposition handle) - (mm-handle-description handle) - nil - (mm-handle-id handle))) - (setq gnus-article-mime-handles - (mm-merge-handles gnus-article-mime-handles handle)) - (when (mm-handle-displayed-p handle) - (mm-remove-part handle)) - (gnus-mm-display-part handle)))) - -(defun gnus-mime-copy-part (&optional handle arg) + (interactive (list nil nil last-nonmenu-event)) + (save-excursion + (if event (mouse-set-point event)) + (unless mime-type + (setq mime-type + (let ((default (gnus-mime-view-part-as-type-internal))) + (gnus-completing-read + "View as MIME type" + (if pred + (seq-filter pred (mailcap-mime-types)) + (mailcap-mime-types)) + nil nil nil + (car default))))) + (gnus-article-check-buffer) + (let ((handle (get-text-property (point) 'gnus-data))) + (when handle + (when (equal (mm-handle-media-type handle) "message/external-body") + (unless (mm-handle-cache handle) + (mm-extern-cache-contents handle)) + (setq handle (mm-handle-cache handle))) + (setq handle + (mm-make-handle (mm-handle-buffer handle) + (cons mime-type (cdr (mm-handle-type handle))) + (mm-handle-encoding handle) + (mm-handle-undisplayer handle) + (mm-handle-disposition handle) + (mm-handle-description handle) + nil + (mm-handle-id handle))) + (setq gnus-article-mime-handles + (mm-merge-handles gnus-article-mime-handles handle)) + (when (mm-handle-displayed-p handle) + (mm-remove-part handle)) + (gnus-mm-display-part handle))))) + +(defun gnus-mime-copy-part (&optional handle arg event) "Put the MIME part under point into a new buffer. If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 are decompressed." - (interactive (list nil current-prefix-arg)) + (interactive (list nil current-prefix-arg last-nonmenu-event)) + (mouse-set-point event) (gnus-article-check-buffer) (unless handle (setq handle (get-text-property (point) 'gnus-data))) @@ -5308,15 +5306,18 @@ are decompressed." (setq buffer-file-name nil)) (goto-char (point-min))))) -(defun gnus-mime-print-part (&optional handle filename) +(defun gnus-mime-print-part (&optional handle filename event) "Print the MIME part under point." - (interactive (list nil (ps-print-preprint current-prefix-arg))) - (gnus-article-check-buffer) - (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - (contents (and handle (mm-get-part handle))) - (file (make-temp-file (expand-file-name "mm." mm-tmp-directory))) - (printer (mailcap-mime-info (mm-handle-media-type handle) "print"))) - (when contents + (interactive + (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event)) + (save-excursion + (mouse-set-point event) + (gnus-article-check-buffer) + (let* ((handle (or handle (get-text-property (point) 'gnus-data))) + (contents (and handle (mm-get-part handle))) + (file (make-temp-file (expand-file-name "mm." mm-tmp-directory))) + (printer (mailcap-mime-info (mm-handle-media-type handle) "print"))) + (when contents (if printer (unwind-protect (progn @@ -5331,12 +5332,13 @@ are decompressed." (with-temp-buffer (insert contents) (gnus-print-buffer)) - (ps-despool filename))))) + (ps-despool filename)))))) -(defun gnus-mime-inline-part (&optional handle arg) +(defun gnus-mime-inline-part (&optional handle arg event) "Insert the MIME part under point into the current buffer. Compressed files like .gz and .bz2 are decompressed." - (interactive (list nil current-prefix-arg)) + (interactive (list nil current-prefix-arg last-nonmenu-event)) + (if event (mouse-set-point event)) (gnus-article-check-buffer) (let* ((inhibit-read-only t) (b (point)) @@ -5430,82 +5432,88 @@ CHARSET may either be a string or a symbol." (setcdr param charset) (setcdr type (cons (cons 'charset charset) (cdr type))))))) -(defun gnus-mime-view-part-as-charset (&optional handle arg) +(defun gnus-mime-view-part-as-charset (&optional handle arg event) "Insert the MIME part under point into the current buffer using the specified charset." - (interactive (list nil current-prefix-arg)) - (gnus-article-check-buffer) - (let ((handle (or handle (get-text-property (point) 'gnus-data))) - (fun (get-text-property (point) 'gnus-callback)) - (gnus-newsgroup-ignored-charsets 'gnus-all) - charset form preferred parts) - (when handle - (when (prog1 - (and fun - (setq charset - (or (cdr (assq - arg - gnus-summary-show-article-charset-alist)) - (read-coding-system "Charset: ")))) - (if (mm-handle-undisplayer handle) - (mm-remove-part handle))) - (gnus-mime-set-charset-parameters handle charset) - (when (and (consp (setq form (cdr-safe fun))) - (setq form (ignore-errors - (assq 'gnus-mime-display-alternative form))) - (setq preferred (caddr form)) - (progn - (when (eq (car preferred) 'quote) - (setq preferred (cadr preferred))) - (not (equal preferred - (get-text-property (point) 'gnus-data)))) - (setq parts (get-text-property (point) 'gnus-part)) - (setq parts (cdr (assq parts - gnus-article-mime-handle-alist))) - (equal (mm-handle-media-type parts) "multipart/alternative") - (setq parts (reverse (cdr parts)))) - (setcar (cddr form) - (list 'quote (or (cadr (member preferred parts)) - (car parts))))) - (funcall fun handle))))) - -(defun gnus-mime-view-part-externally (&optional handle) - "View the MIME part under point with an external viewer." - (interactive) - (gnus-article-check-buffer) - (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - (mm-inlined-types nil) - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-ignored-charsets)) - (type (mm-handle-media-type handle)) - (method (mailcap-mime-info type)) - (mm-enable-external t)) - (if (not (stringp method)) - (gnus-mime-view-part-as-type - nil (lambda (type) (stringp (mailcap-mime-info type)))) + (interactive (list nil current-prefix-arg last-nonmenu-event)) + (save-excursion + (mouse-set-point event) + (gnus-article-check-buffer) + (let ((handle (or handle (get-text-property (point) 'gnus-data))) + (fun (get-text-property (point) 'gnus-callback)) + (gnus-newsgroup-ignored-charsets 'gnus-all) + charset form preferred parts) (when handle - (mm-display-part handle nil t))))) - -(defun gnus-mime-view-part-internally (&optional handle) + (when (prog1 + (and fun + (setq charset + (or (cdr (assq + arg + gnus-summary-show-article-charset-alist)) + (read-coding-system "Charset: ")))) + (if (mm-handle-undisplayer handle) + (mm-remove-part handle))) + (gnus-mime-set-charset-parameters handle charset) + (when (and (consp (setq form (cdr-safe fun))) + (setq form (ignore-errors + (assq 'gnus-mime-display-alternative form))) + (setq preferred (caddr form)) + (progn + (when (eq (car preferred) 'quote) + (setq preferred (cadr preferred))) + (not (equal preferred + (get-text-property (point) 'gnus-data)))) + (setq parts (get-text-property (point) 'gnus-part)) + (setq parts (cdr (assq parts + gnus-article-mime-handle-alist))) + (equal (mm-handle-media-type parts) "multipart/alternative") + (setq parts (reverse (cdr parts)))) + (setcar (cddr form) + (list 'quote (or (cadr (member preferred parts)) + (car parts))))) + (funcall fun handle)))))) + +(defun gnus-mime-view-part-externally (&optional handle event) + "View the MIME part under point with an external viewer." + (interactive (list nil last-nonmenu-event)) + (save-excursion + (mouse-set-point event) + (gnus-article-check-buffer) + (let* ((handle (or handle (get-text-property (point) 'gnus-data))) + (mm-inlined-types nil) + (mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets)) + (type (mm-handle-media-type handle)) + (method (mailcap-mime-info type)) + (mm-enable-external t)) + (if (not (stringp method)) + (gnus-mime-view-part-as-type + nil (lambda (type) (stringp (mailcap-mime-info type)))) + (when handle + (mm-display-part handle nil t)))))) + +(defun gnus-mime-view-part-internally (&optional handle event) "View the MIME part under point with an internal viewer. If no internal viewer is available, use an external viewer." - (interactive) - (gnus-article-check-buffer) - (let* ((handle (or handle (get-text-property (point) 'gnus-data))) - (mm-inlined-types '(".*")) - (mm-inline-large-images t) - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-ignored-charsets)) - (inhibit-read-only t)) - (if (not (mm-inlinable-p handle)) - (gnus-mime-view-part-as-type - nil (lambda (type) (mm-inlinable-p handle type))) - (when handle - (gnus-bind-mm-vars (mm-display-part handle nil t)))))) + (interactive (list nil last-nonmenu-event)) + (save-excursion + (mouse-set-point event) + (gnus-article-check-buffer) + (let* ((handle (or handle (get-text-property (point) 'gnus-data))) + (mm-inlined-types '(".*")) + (mm-inline-large-images t) + (mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets)) + (inhibit-read-only t)) + (if (not (mm-inlinable-p handle)) + (gnus-mime-view-part-as-type + nil (lambda (type) (mm-inlinable-p handle type))) + (when handle + (gnus-bind-mm-vars (mm-display-part handle nil t))))))) (defun gnus-mime-action-on-part (&optional action) "Do something with the MIME attachment at (point)." @@ -5755,10 +5763,11 @@ all parts." (mm-handle-media-type handle)) (mm-handle-set-undisplayer handle - `(lambda () - (let ((inhibit-read-only t)) - (delete-region ,(copy-marker (point-min) t) - ,(point-max-marker))))))) + (let ((beg (copy-marker (point-min) t)) + (end (point-max-marker))) + (lambda () + (let ((inhibit-read-only t)) + (delete-region beg end))))))) (part (mm-display-inline handle)))))) (when (markerp point) @@ -6138,7 +6147,7 @@ If nil, don't show those extra buttons." (let* ((preferred (or preferred (mm-preferred-alternative handles))) (ihandles handles) (point (point)) - handle (inhibit-read-only t) from begend not-pref) + handle (inhibit-read-only t) begend not-pref) ;; from (save-window-excursion (save-restriction (when ibegend @@ -6159,7 +6168,8 @@ If nil, don't show those extra buttons." (not (gnus-unbuttonized-mime-type-p "multipart/alternative"))) (add-text-properties - (setq from (point)) + ;; (setq from + (point);; ) (progn (insert (format "%d. " id)) (point)) @@ -6180,7 +6190,8 @@ If nil, don't show those extra buttons." ;; Do the handles (while (setq handle (pop handles)) (add-text-properties - (setq from (point)) + ;; (setq from + (point) ;; ) (progn (insert (format "(%c) %-18s" (if (equal handle preferred) ?* ? ) @@ -7140,13 +7151,11 @@ If given a prefix, show the hidden text instead." (when (and do-update-line (or (numberp article) (stringp article))) - (let ((buf (current-buffer))) - (set-buffer gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer (gnus-summary-update-article do-update-line sparse-header) (gnus-summary-goto-subject do-update-line nil t) (set-window-point (gnus-get-buffer-window (current-buffer) t) - (point)) - (set-buffer buf)))))) + (point))))))) (defun gnus-block-private-groups (group) "Allows images in newsgroups to be shown, blocks images in all @@ -7267,12 +7276,13 @@ groups." (gnus-with-article-buffer (article-date-original)) (gnus-article-edit-article - 'ignore - `(lambda (no-highlight) - 'ignore - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))) + #'ignore + (let ((gch (or (mail-header-references gnus-current-headers) "")) + (ro (gnus-group-read-only-p)) + (buf gnus-summary-buffer)) + (lambda (no-highlight) + 'ignore + (gnus-summary-edit-article-done gch ro buf no-highlight))))) (defun gnus-article-edit-article (start-func exit-func &optional quiet) "Start editing the contents of the current article buffer." @@ -7340,8 +7350,7 @@ groups." (gnus-article-mode) (set-window-configuration winconf) ;; Tippy-toe some to make sure that point remains where it was. - (save-current-buffer - (set-buffer curbuf) + (with-current-buffer curbuf (set-window-start (get-buffer-window (current-buffer)) window-start) (goto-char p)))) (gnus-summary-show-article))) @@ -7609,7 +7618,7 @@ Calls `describe-variable' or `describe-function'." "Call `describe-key' when pushing the corresponding URL button." (let* ((key-string (replace-regexp-in-string gnus-button-handle-describe-prefix "" url)) - (keys (ignore-errors (eval `(kbd ,key-string))))) + (keys (ignore-errors (kbd key-string)))) (if keys (describe-key keys) (gnus-message 3 "Invalid key sequence in button: %s" key-string)))) @@ -7875,15 +7884,17 @@ call it with the value of the `gnus-data' text property." (when fun (funcall fun data)))) -(defun gnus-article-press-button () +(defun gnus-article-press-button (&optional event) "Check text at point for a callback function. If the text at point has a `gnus-callback' property, call it with the value of the `gnus-data' text property." - (interactive) - (let ((data (get-text-property (point) 'gnus-data)) - (fun (get-text-property (point) 'gnus-callback))) - (when fun - (funcall fun data)))) + (interactive (list last-nonmenu-event)) + (save-excursion + (when event + (mouse-set-point event)) + (let ((fun (get-text-property (point) 'gnus-callback))) + (when fun + (funcall fun (get-text-property (point) 'gnus-data)))))) (defun gnus-article-highlight (&optional force) "Highlight current article. @@ -7977,13 +7988,13 @@ specified by `gnus-button-alist'." (article-goto-body) (setq beg (point)) (while (setq entry (pop alist)) - (setq regexp (eval (car entry))) + (setq regexp (eval (car entry) t)) (goto-char beg) (while (re-search-forward regexp nil t) (let ((start (match-beginning (nth 1 entry))) (end (match-end (nth 1 entry))) (from (match-beginning 0))) - (when (and (eval (nth 2 entry)) + (when (and (eval (nth 2 entry) t) (not (gnus-button-in-region-p start end 'gnus-callback))) ;; That optional form returned non-nil, so we add the @@ -8074,14 +8085,14 @@ url is put as the `gnus-button-url' overlay property on the button." (match-beginning 0)) (point-max))) (goto-char beg) - (while (re-search-forward (eval (nth 1 entry)) end t) + (while (re-search-forward (eval (nth 1 entry) t) end t) ;; Each match within a header. (let* ((entry (cdr entry)) (start (match-beginning (nth 1 entry))) (end (match-end (nth 1 entry))) (form (nth 2 entry))) (goto-char (match-end 0)) - (when (eval form) + (when (eval form t) (gnus-article-add-button start end (nth 3 entry) (buffer-substring (match-beginning (nth 4 entry)) @@ -8090,7 +8101,7 @@ url is put as the `gnus-button-url' overlay property on the button." ;;; External functions: -(defun gnus-article-add-button (from to fun &optional data text) +(defun gnus-article-add-button (from to fun &optional data _text) "Create a button between FROM and TO with callback FUN and data DATA." (add-text-properties from to @@ -8303,7 +8314,7 @@ url is put as the `gnus-button-url' overlay property on the button." (setq indx (match-string 1 indx)) (Info-index indx) (when comma - (dotimes (i (with-temp-buffer + (dotimes (_ (with-temp-buffer (insert comma) ;; Note: the XEmacs version of `how-many' takes ;; no optional argument. @@ -8507,8 +8518,8 @@ For example: (defvar gnus-inhibit-article-treatments nil) ;; Dynamic variables. -(defvar part-number) ;FIXME: Lacks a "gnus-" prefix. -(defvar total-parts) ;FIXME: Lacks a "gnus-" prefix. +(defvar gnus-treat-part-number) +(defvar gnus-treat-total-parts) (defvar gnus-treat-type) (defvar gnus-treat-condition) (defvar gnus-treat-length) @@ -8516,8 +8527,8 @@ For example: (defun gnus-treat-article (condition &optional part-num total type) (let ((gnus-treat-condition condition) - (part-number part-num) - (total-parts total) + (gnus-treat-part-number part-num) + (gnus-treat-total-parts total) (gnus-treat-type type) (gnus-treat-length (- (point-max) (point-min))) (alist gnus-treatment-function-alist) @@ -8577,9 +8588,9 @@ For example: ((eq val 'head) nil) ((eq val 'first) - (eq part-number 1)) + (eq gnus-treat-part-number 1)) ((eq val 'last) - (eq part-number total-parts)) + (eq gnus-treat-part-number gnus-treat-total-parts)) ((numberp val) (< gnus-treat-length val)) (t diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el index d6f53e4b380..6c7ad0c4744 100644 --- a/lisp/gnus/gnus-bcklg.el +++ b/lisp/gnus/gnus-bcklg.el @@ -1,4 +1,4 @@ -;;; gnus-bcklg.el --- backlog functions for Gnus +;;; gnus-bcklg.el --- backlog functions for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 57859d806c9..bc41d5b149d 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -1,4 +1,4 @@ -;;; gnus-bookmark.el --- Bookmarks in Gnus +;;; gnus-bookmark.el --- Bookmarks in Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 2006-2021 Free Software Foundation, Inc. @@ -78,22 +78,19 @@ ((file-exists-p "~/.gnus.bmk") "~/.gnus.bmk") (t (nnheader-concat gnus-directory "bookmarks.el"))) "The default Gnus bookmarks file." - :type 'string - :group 'gnus-bookmark) + :type 'string) (defcustom gnus-bookmark-file-coding-system (if (mm-coding-system-p 'iso-2022-7bit) 'iso-2022-7bit) "Coding system used for writing Gnus bookmark files." - :type '(symbol :tag "Coding system") - :group 'gnus-bookmark) + :type '(symbol :tag "Coding system")) (defcustom gnus-bookmark-sort-flag t "Non-nil means Gnus bookmarks are sorted by bookmark names. Otherwise they will be displayed in LIFO order (that is, most recently set ones come first, oldest ones come last)." - :type 'boolean - :group 'gnus-bookmark) + :type 'boolean) (defcustom gnus-bookmark-bmenu-toggle-infos t "Non-nil means show details when listing Gnus bookmarks. @@ -102,19 +99,16 @@ This may result in truncated bookmark names. To disable this, put the following in your `.emacs' file: \(setq gnus-bookmark-bmenu-toggle-infos nil)" - :type 'boolean - :group 'gnus-bookmark) + :type 'boolean) (defcustom gnus-bookmark-bmenu-file-column 30 "Column at which to display details in a buffer listing Gnus bookmarks. You can toggle whether details are shown with \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-toggle-infos]." - :type 'integer - :group 'gnus-bookmark) + :type 'integer) (defcustom gnus-bookmark-use-annotations nil "If non-nil, ask for an annotation when setting a bookmark." - :type 'boolean - :group 'gnus-bookmark) + :type 'boolean) (defcustom gnus-bookmark-bookmark-inline-details '(author) "Details to be shown with `gnus-bookmark-bmenu-toggle-infos'. @@ -125,8 +119,7 @@ The default value is \(subject)." (const :tag "Subject" subject) (const :tag "Date" date) (const :tag "Group" group) - (const :tag "Message-id" message-id))) - :group 'gnus-bookmark) + (const :tag "Message-id" message-id)))) (defcustom gnus-bookmark-bookmark-details '(author subject date group annotation) @@ -139,14 +132,12 @@ The default value is \(author subject date group annotation)." (const :tag "Date" date) (const :tag "Group" group) (const :tag "Message-id" message-id) - (const :tag "Annotation" annotation))) - :group 'gnus-bookmark) + (const :tag "Annotation" annotation)))) (defface gnus-bookmark-menu-heading '((t (:inherit font-lock-type-face))) "Face used to highlight the heading in Gnus bookmark menu buffers." - :version "23.1" ;; No Gnus - :group 'gnus-bookmark) + :version "23.1") ;; No Gnus (defconst gnus-bookmark-end-of-version-stamp-marker "-*- End Of Bookmark File Format Version Stamp -*-\n" @@ -279,7 +270,7 @@ So the cdr of each bookmark is an alist too.") (gnus-bookmark-maybe-load-default-file) (let* ((bookmark (or bmk-name (gnus-completing-read "Jump to bookmarked article" - (mapcar 'car gnus-bookmark-alist)))) + (mapcar #'car gnus-bookmark-alist)))) (bmk-record (cadr (assoc bookmark gnus-bookmark-alist))) (group (cdr (assoc 'group bmk-record))) (message-id (cdr (assoc 'message-id bmk-record)))) @@ -359,7 +350,7 @@ deletion, or > if it is flagged for displaying." (switch-to-buffer (gnus-get-buffer-create "*Gnus Bookmark List*")) (set-buffer (gnus-get-buffer-create "*Gnus Bookmark List*"))) (let ((inhibit-read-only t) - alist name start end) + alist name) ;; start end (erase-buffer) (insert "% Gnus Bookmark\n- --------\n") (add-text-properties (point-min) (point) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 36657e46219..5ed731947bc 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -1,4 +1,4 @@ -;;; gnus-cache.el --- cache interface for Gnus +;;; gnus-cache.el --- cache interface for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -29,9 +29,7 @@ (require 'gnus) (require 'gnus-sum) -(eval-when-compile - (unless (fboundp 'gnus-agent-load-alist) - (defun gnus-agent-load-alist (group)))) +(declare-function gnus-agent-load-alist "gnus-agent" (group)) (defcustom gnus-cache-active-file (expand-file-name "active" gnus-cache-directory) @@ -55,7 +53,7 @@ If you only want to cache your nntp groups, you could set this variable to \"^nntp\". -If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups +If a group matches both `gnus-cacheable-groups' and `gnus-uncacheable-groups' it's not cached." :group 'gnus-cache :type '(choice (const :tag "off" nil) @@ -150,6 +148,8 @@ it's not cached." (gnus-kill-buffer buffer) (setq gnus-cache-buffer nil)))) +(defvar gnus-article-decode-hook) + (defun gnus-cache-possibly-enter-article (group article ticked dormant unread &optional force) (when (and (or force (not (eq gnus-use-cache 'passive))) @@ -518,7 +518,7 @@ Returns the list of articles removed." (setq articles (sort (mapcar (lambda (name) (string-to-number name)) (directory-files dir nil "\\`[0-9]+\\'" t)) - '<)) + #'<)) ;; Update the cache active file, just to synch more. (if articles (progn @@ -714,7 +714,7 @@ If LOW, update the lower bound instead." (push (string-to-number (file-name-nondirectory (pop files))) nums) (push (pop files) alphs))) ;; If we have nums, then this is probably a valid group. - (when (setq nums (sort nums '<)) + (when (setq nums (sort nums #'<)) (puthash group (cons (car nums) (car (last nums))) gnus-cache-active-hashtb)) @@ -730,6 +730,8 @@ If LOW, update the lower bound instead." (gnus-cache-write-active t) (gnus-message 5 "Generating the cache active file...done")))) +(defvar nnml-generate-active-function) + ;;;###autoload (defun gnus-cache-generate-nov-databases (dir) "Generate NOV files recursively starting in DIR." @@ -884,7 +886,7 @@ supported." (setq gnus-cache-total-fetched-hashtb (gnus-make-hashtable 1000))) (let* ((entry (gethash group gnus-cache-total-fetched-hashtb))) (if entry - (apply '+ entry) + (apply #'+ entry) (let ((gnus-cache-inhibit-update-total-fetched-for (not no-inhibit))) (+ (gnus-cache-update-overview-total-fetched-for group nil) diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index d02e898e230..96f1a7de5ec 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -1,4 +1,4 @@ -;;; gnus-cite.el --- parse citations in articles for Gnus +;;; gnus-cite.el --- parse citations in articles for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -38,19 +38,16 @@ (defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n" "Format of opened cited text buttons." - :group 'gnus-cite :type 'string) (defcustom gnus-cited-closed-text-button-line-format "%(%{[+]%}%)\n" "Format of closed cited text buttons." - :group 'gnus-cite :type 'string) (defcustom gnus-cited-lines-visible nil "The number of lines of hidden cited text to remain visible. Or a pair (cons) of numbers which are the number of lines at the top and bottom of the text, respectively, to remain visible." - :group 'gnus-cite :type '(choice (const :tag "none" nil) integer (cons :tag "Top and Bottom" integer integer))) @@ -58,13 +55,11 @@ and bottom of the text, respectively, to remain visible." (defcustom gnus-cite-parse-max-size 25000 "Maximum article size (in bytes) where parsing citations is allowed. Set it to nil to parse all articles." - :group 'gnus-cite :type '(choice (const :tag "all" nil) integer)) (defcustom gnus-cite-max-prefix 20 "Maximum possible length for a citation prefix." - :group 'gnus-cite :type 'integer) (defcustom gnus-supercite-regexp @@ -72,18 +67,15 @@ Set it to nil to parse all articles." ">>>>> +\"\\([^\"\n]+\\)\" +==") "Regexp matching normal Supercite attribution lines. The first grouping must match prefixes added by other packages." - :group 'gnus-cite :type 'regexp) (defcustom gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +==" "Regexp matching mangled Supercite attribution lines. The first regexp group should match the Supercite attribution." - :group 'gnus-cite :type 'regexp) (defcustom gnus-cite-minimum-match-count 2 "Minimum number of identical prefixes before we believe it's a citation." - :group 'gnus-cite :type 'integer) ;; Some Microsoft products put in a citation that extends to the @@ -106,21 +98,18 @@ The first regexp group should match the Supercite attribution." (defcustom gnus-cite-attribution-prefix "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|----- ?Original Message ?-----" "Regexp matching the beginning of an attribution line." - :group 'gnus-cite :type 'regexp) (defcustom gnus-cite-attribution-suffix "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|----- ?Original Message ?-----\\)[ \t]*$" "Regexp matching the end of an attribution line. The text matching the first grouping will be used as a button." - :group 'gnus-cite :type 'regexp) (defcustom gnus-cite-unsightly-citation-regexp "^-----Original Message-----\nFrom: \\(.+\n\\)+\n" "Regexp matching Microsoft-type rest-of-message citations." :version "22.1" - :group 'gnus-cite :type 'regexp) (defcustom gnus-cite-ignore-quoted-from t @@ -128,18 +117,15 @@ The text matching the first grouping will be used as a button." Those lines may have been quoted by MTAs in order not to mix up with the envelope From line." :version "22.1" - :group 'gnus-cite :type 'boolean) (defface gnus-cite-attribution '((t (:italic t))) - "Face used for attribution lines." - :group 'gnus-cite) + "Face used for attribution lines.") (defcustom gnus-cite-attribution-face 'gnus-cite-attribution "Face used for attribution lines. It is merged with the face for the cited text belonging to the attribution." :version "22.1" - :group 'gnus-cite :type 'face) (defface gnus-cite-1 '((((class color) @@ -150,8 +136,7 @@ It is merged with the face for the cited text belonging to the attribution." (:foreground "MidnightBlue")) (t (:italic t))) - "Citation face." - :group 'gnus-cite) + "Citation face.") (defface gnus-cite-2 '((((class color) (background dark)) @@ -161,8 +146,7 @@ It is merged with the face for the cited text belonging to the attribution." (:foreground "firebrick")) (t (:italic t))) - "Citation face." - :group 'gnus-cite) + "Citation face.") (defface gnus-cite-3 '((((class color) (background dark)) @@ -172,8 +156,7 @@ It is merged with the face for the cited text belonging to the attribution." (:foreground "dark green")) (t (:italic t))) - "Citation face." - :group 'gnus-cite) + "Citation face.") (defface gnus-cite-4 '((((class color) (background dark)) @@ -183,8 +166,7 @@ It is merged with the face for the cited text belonging to the attribution." (:foreground "OrangeRed")) (t (:italic t))) - "Citation face." - :group 'gnus-cite) + "Citation face.") (defface gnus-cite-5 '((((class color) (background dark)) @@ -194,8 +176,7 @@ It is merged with the face for the cited text belonging to the attribution." (:foreground "dark khaki")) (t (:italic t))) - "Citation face." - :group 'gnus-cite) + "Citation face.") (defface gnus-cite-6 '((((class color) (background dark)) @@ -205,8 +186,7 @@ It is merged with the face for the cited text belonging to the attribution." (:foreground "dark violet")) (t (:italic t))) - "Citation face." - :group 'gnus-cite) + "Citation face.") (defface gnus-cite-7 '((((class color) (background dark)) @@ -216,8 +196,7 @@ It is merged with the face for the cited text belonging to the attribution." (:foreground "SteelBlue4")) (t (:italic t))) - "Citation face." - :group 'gnus-cite) + "Citation face.") (defface gnus-cite-8 '((((class color) (background dark)) @@ -227,8 +206,7 @@ It is merged with the face for the cited text belonging to the attribution." (:foreground "magenta")) (t (:italic t))) - "Citation face." - :group 'gnus-cite) + "Citation face.") (defface gnus-cite-9 '((((class color) (background dark)) @@ -238,8 +216,7 @@ It is merged with the face for the cited text belonging to the attribution." (:foreground "violet")) (t (:italic t))) - "Citation face." - :group 'gnus-cite) + "Citation face.") (defface gnus-cite-10 '((((class color) (background dark)) @@ -249,8 +226,7 @@ It is merged with the face for the cited text belonging to the attribution." (:foreground "medium purple")) (t (:italic t))) - "Citation face." - :group 'gnus-cite) + "Citation face.") (defface gnus-cite-11 '((((class color) (background dark)) @@ -260,8 +236,7 @@ It is merged with the face for the cited text belonging to the attribution." (:foreground "turquoise")) (t (:italic t))) - "Citation face." - :group 'gnus-cite) + "Citation face.") (defcustom gnus-cite-face-list '(gnus-cite-1 gnus-cite-2 gnus-cite-3 gnus-cite-4 gnus-cite-5 gnus-cite-6 @@ -271,7 +246,6 @@ It is merged with the face for the cited text belonging to the attribution." When there are citations from multiple articles in the same message, Gnus will try to give each citation from each article its own face. This should make it easier to see who wrote what." - :group 'gnus-cite :type '(repeat face) :set (lambda (symbol value) (prog1 @@ -290,17 +264,14 @@ This should make it easier to see who wrote what." (defcustom gnus-cite-hide-percentage 50 "Only hide excess citation if above this percentage of the body." - :group 'gnus-cite :type 'number) (defcustom gnus-cite-hide-absolute 10 "Only hide excess citation if above this number of lines in the body." - :group 'gnus-cite :type 'integer) (defcustom gnus-cite-blank-line-after-header t "If non-nil, put a blank line between the citation header and the button." - :group 'gnus-cite :type 'boolean) ;; This has to go here because its default value depends on @@ -445,7 +416,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps (gnus-article-search-signature) (push (cons (point-marker) "") marks) ;; Sort the marks. - (setq marks (sort marks 'car-less-than-car)) + (setq marks (sort marks #'car-less-than-car)) (let ((omarks marks)) (setq marks nil) (while (cdr omarks) @@ -553,7 +524,7 @@ text (i.e., computer code and the like) will not be folded." ;; like code? Check for ragged edges on the left. (< (length columns) 3)))) -(defun gnus-article-hide-citation (&optional arg force) +(defun gnus-article-hide-citation (&optional arg _force) "Toggle hiding of all cited text except attribution lines. See the documentation for `gnus-article-highlight-citation'. If given a negative prefix, always show; if given a positive prefix, @@ -623,7 +594,7 @@ always hide." (progn (gnus-article-add-button (point) - (progn (eval gnus-cited-closed-text-button-line-format-spec) + (progn (eval gnus-cited-closed-text-button-line-format-spec t) (point)) 'gnus-article-toggle-cited-text (list (cons beg end) start)) @@ -673,7 +644,8 @@ means show, nil means toggle." (progn (eval (if hidden gnus-cited-opened-text-button-line-format-spec - gnus-cited-closed-text-button-line-format-spec)) + gnus-cited-closed-text-button-line-format-spec) + t) (point)) 'gnus-article-toggle-cited-text args) @@ -726,7 +698,7 @@ See also the documentation for `gnus-article-highlight-citation'." ;;; Internal functions: -(defun gnus-cite-parse-maybe (&optional force no-overlay) +(defun gnus-cite-parse-maybe (&optional _force no-overlay) "Always parse the buffer." (gnus-cite-localize) ;;Reset parser information. @@ -919,25 +891,25 @@ See also the documentation for `gnus-article-highlight-citation'." (regexp-quote tag) ">")))) ;; Find loose supercite citations after attributions. (gnus-cite-match-attributions 'small t - (lambda (prefix tag) + (lambda (_prefix tag) (when tag (concat "\\<" (regexp-quote tag) "\\>")))) ;; Find loose supercite citations anywhere. (gnus-cite-match-attributions 'small nil - (lambda (prefix tag) + (lambda (_prefix tag) (when tag (concat "\\<" (regexp-quote tag) "\\>")))) ;; Find nested citations after attributions. (gnus-cite-match-attributions 'small-if-unique t - (lambda (prefix tag) + (lambda (prefix _tag) (concat "\\`" (regexp-quote prefix) ".+"))) ;; Find nested citations anywhere. (gnus-cite-match-attributions 'small nil - (lambda (prefix tag) + (lambda (prefix _tag) (concat "\\`" (regexp-quote prefix) ".+"))) ;; Remove loose prefixes with too few lines. (let ((alist gnus-cite-loose-prefix-alist) @@ -999,7 +971,7 @@ See also the documentation for `gnus-article-highlight-citation'." cites (cdr cites) candidate (car cite) numbers (cdr cite) - first (apply 'min numbers) + first (apply #'min numbers) compare (if size (length candidate) first)) (and (> first limit) regexp @@ -1125,7 +1097,7 @@ See also the documentation for `gnus-article-highlight-citation'." "Search for a cited line and set match data accordingly. Returns nil if there is no such line before LIMIT, t otherwise." (when (re-search-forward gnus-message-cite-prefix-regexp limit t) - (let ((cdepth (min (length (apply 'concat + (let ((cdepth (min (length (apply #'concat (split-string (match-string-no-properties 0) "[\t [:alnum:]]+"))) @@ -1166,7 +1138,7 @@ When enabled, it automatically turns on `font-lock-mode'." (when (derived-mode-p 'message-mode) ;; FIXME: Use font-lock-add-keywords! (let ((defaults (car font-lock-defaults)) - default keywords) + default) ;; keywords (while defaults (setq default (if (consp defaults) (pop defaults) diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el index f7c71f43ce8..3bc94f11e79 100644 --- a/lisp/gnus/gnus-cloud.el +++ b/lisp/gnus/gnus-cloud.el @@ -1,4 +1,4 @@ -;;; gnus-cloud.el --- storing and retrieving data via IMAP +;;; gnus-cloud.el --- storing and retrieving data via IMAP -*- lexical-binding: t; -*- ;; Copyright (C) 2014-2021 Free Software Foundation, Inc. @@ -52,14 +52,12 @@ Each element may be either a string or a property list. The latter should have a :directory element whose value is a string, and a :match element whose value is a regular expression to match against the basename of files in said directory." - :group 'gnus-cloud :type '(repeat (choice (string :tag "File") (plist :tag "Property list")))) (defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip) "Storage method for cloud data, defaults to EPG if that's available." :version "26.1" - :group 'gnus-cloud :type '(radio (const :tag "No encoding" nil) (const :tag "Base64" base64) (const :tag "Base64+gzip" base64-gzip) @@ -68,7 +66,6 @@ against the basename of files in said directory." (defcustom gnus-cloud-interactive t "Whether Gnus Cloud changes should be confirmed." :version "26.1" - :group 'gnus-cloud :type 'boolean) (defvar gnus-cloud-group-name "Emacs-Cloud") @@ -81,7 +78,6 @@ against the basename of files in said directory." "The IMAP select method used to store the cloud data. See also `gnus-server-set-cloud-method-server' for an easy interactive way to set this from the Server buffer." - :group 'gnus-cloud :type '(radio (const :tag "Not set" nil) (string :tag "A Gnus server name as a string"))) @@ -132,7 +128,7 @@ easy interactive way to set this from the Server buffer." ((eq gnus-cloud-storage-method 'epg) (let ((context (epg-make-context 'OpenPGP)) - cipher) + ) ;; cipher (setf (epg-context-armor context) t) (setf (epg-context-textmode context) t) (let ((data (epg-encrypt-string context @@ -348,15 +344,15 @@ easy interactive way to set this from the Server buffer." (group &optional previous method)) (defun gnus-cloud-ensure-cloud-group () - (let ((method (if (stringp gnus-cloud-method) - (gnus-server-to-method gnus-cloud-method) - gnus-cloud-method))) + ;; (let ((method (if (stringp gnus-cloud-method) + ;; (gnus-server-to-method gnus-cloud-method) + ;; gnus-cloud-method))) (unless (or (gnus-active gnus-cloud-group-name) (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method)) (and (gnus-request-create-group gnus-cloud-group-name gnus-cloud-method) (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method) - (gnus-subscribe-group gnus-cloud-group-name))))) + (gnus-subscribe-group gnus-cloud-group-name)))) ;; ) (defun gnus-cloud-upload-all-data () "Upload all data (newsrc and files) to the Gnus Cloud." diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el index dc14943a060..d8f48b19f87 100644 --- a/lisp/gnus/gnus-cus.el +++ b/lisp/gnus/gnus-cus.el @@ -1,4 +1,4 @@ -;;; gnus-cus.el --- customization commands for Gnus +;;; gnus-cus.el --- customization commands for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1996, 1999-2021 Free Software Foundation, Inc. @@ -417,7 +417,7 @@ category.")) (setq tmp (cdr tmp)))) (setq gnus-custom-params - (apply 'widget-create 'group + (apply #'widget-create 'group :value values (delq nil (list `(set :inline t @@ -483,7 +483,7 @@ form, but who cares?" (buffer-enable-undo) (goto-char (point-min)))) -(defun gnus-group-customize-done (&rest ignore) +(defun gnus-group-customize-done (&rest _ignore) "Apply changes and bury the buffer." (interactive) (let ((params (widget-value gnus-custom-params))) @@ -927,7 +927,7 @@ articles in the thread. (use-local-map widget-keymap) (widget-setup))) -(defun gnus-score-customize-done (&rest ignore) +(defun gnus-score-customize-done (&rest _ignore) "Reset the score alist with the present value." (let ((alist gnus-custom-score-alist) (value (widget-value gnus-custom-scores))) @@ -1027,14 +1027,15 @@ articles in the thread. (widget-create 'push-button :notify - (lambda (&rest ignore) + (lambda (&rest _ignore) (let* ((info (assq gnus-agent-cat-name gnus-category-alist)) (widgets category-fields)) (while widgets (let* ((widget (pop widgets)) (value (condition-case nil (widget-value widget) (error)))) (eval `(setf (,(widget-get widget :accessor) ',info) - ',value))))) + ',value) + t)))) (gnus-category-write) (gnus-kill-buffer (current-buffer)) (when (get-buffer gnus-category-buffer) diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index 477ad88a9ca..0cee01b9428 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -1,4 +1,4 @@ -;;; gnus-delay.el --- Delayed posting of articles +;;; gnus-delay.el --- Delayed posting of articles -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. @@ -44,24 +44,20 @@ (defcustom gnus-delay-group "delayed" "Group name for storing delayed articles." - :type 'string - :group 'gnus-delay) + :type 'string) (defcustom gnus-delay-header "X-Gnus-Delayed" "Header name for storing info about delayed articles." - :type 'string - :group 'gnus-delay) + :type 'string) (defcustom gnus-delay-default-delay "3d" "Default length of delay." - :type 'string - :group 'gnus-delay) + :type 'string) (defcustom gnus-delay-default-hour 8 "If deadline is given as date, then assume this time of day." :version "22.1" - :type 'integer - :group 'gnus-delay) + :type 'integer) ;;;###autoload (defun gnus-delay-article (delay) @@ -86,7 +82,7 @@ generated when the article is sent." gnus-delay-default-delay))) ;; Allow spell checking etc. (run-hooks 'message-send-hook) - (let (num unit days year month day hour minute deadline) + (let (num unit year month day hour minute deadline) ;; days (cond ((string-match "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)" delay) @@ -171,7 +167,7 @@ generated when the article is sent." (message "Delay header missing for article %d" article))))))) ;;;###autoload -(defun gnus-delay-initialize (&optional no-keymap no-check) +(defun gnus-delay-initialize (&optional _no-keymap no-check) "Initialize the gnus-delay package. This sets up a key binding in `message-mode' to delay a message. This tells Gnus to look for delayed messages after getting new news. @@ -179,7 +175,7 @@ This tells Gnus to look for delayed messages after getting new news. The optional arg NO-KEYMAP is ignored. Checking delayed messages is skipped if optional arg NO-CHECK is non-nil." (unless no-check - (add-hook 'gnus-get-new-news-hook 'gnus-delay-send-queue))) + (add-hook 'gnus-get-new-news-hook #'gnus-delay-send-queue))) (provide 'gnus-delay) diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index 219f15e2227..e99247c0ca9 100644 --- a/lisp/gnus/gnus-demon.el +++ b/lisp/gnus/gnus-demon.el @@ -1,4 +1,4 @@ -;;; gnus-demon.el --- daemonic Gnus behavior +;;; gnus-demon.el --- daemonic Gnus behavior -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -52,7 +52,6 @@ this number of `gnus-demon-timestep's. If IDLE is nil, don't care about idleness. If IDLE is a number and TIME is nil, then call once each time Emacs has been idle for IDLE `gnus-demon-timestep's." - :group 'gnus-demon :type '(repeat (list function (choice :tag "Time" (const :tag "never" nil) @@ -65,7 +64,6 @@ Emacs has been idle for IDLE `gnus-demon-timestep's." (defcustom gnus-demon-timestep 60 "Number of seconds in each demon timestep." - :group 'gnus-demon :type 'integer) ;;; Internal variables. diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index 78f1e53ff7a..52705640bf0 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -1,4 +1,4 @@ -;;; gnus-diary.el --- Wrapper around the NNDiary Gnus back end +;;; gnus-diary.el --- Wrapper around the NNDiary Gnus back end -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -57,8 +57,7 @@ (defcustom gnus-diary-time-format "%a, %b %e %y, %H:%M" "Time format to display appointments in nndiary summary buffers. Please refer to `format-time-string' for information on possible values." - :type 'string - :group 'gnus-diary) + :type 'string) (defcustom gnus-diary-delay-format-function 'gnus-diary-delay-format-english "Function called to format a diary delay string. @@ -73,8 +72,7 @@ There are currently two built-in format functions: `gnus-diary-delay-format-french'" :type '(choice (const :tag "english" gnus-diary-delay-format-english) (const :tag "french" gnus-diary-delay-format-french) - (symbol :tag "other")) - :group 'gnus-diary) + (symbol :tag "other"))) (defconst gnus-diary-version nndiary-version "Current Diary back end version.") @@ -276,13 +274,13 @@ Optional prefix (or REVERSE argument) means sort in reverse order." (gnus-diary-update-group-parameters group))) (add-hook 'nndiary-request-create-group-functions - 'gnus-diary-update-group-parameters) + #'gnus-diary-update-group-parameters) ;; Now that we have `gnus-subscribe-newsgroup-functions', this is not needed ;; anymore. Maybe I should remove this completely. (add-hook 'nndiary-request-update-info-functions - 'gnus-diary-update-group-parameters) + #'gnus-diary-update-group-parameters) (add-hook 'gnus-subscribe-newsgroup-functions - 'gnus-diary-maybe-update-group-parameters) + #'gnus-diary-maybe-update-group-parameters) ;; Diary Message Checking =================================================== @@ -360,7 +358,7 @@ If ARG (or prefix) is non-nil, force prompting for all fields." header ": "))) (setq value (if (listp (nth 1 head)) - (gnus-completing-read prompt (cons "*" (mapcar 'car (nth 1 head))) + (gnus-completing-read prompt (cons "*" (mapcar #'car (nth 1 head))) t value 'gnus-diary-header-value-history) (read-string prompt value diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index 6f231c4fbb8..ca2d57de7dc 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -1,4 +1,4 @@ -;;; gnus-dired.el --- utility functions where gnus and dired meet +;;; gnus-dired.el --- utility functions where gnus and dired meet -*- lexical-binding: t; -*- ;; Copyright (C) 1996-1999, 2001-2021 Free Software Foundation, Inc. @@ -29,7 +29,7 @@ ;; following in your ~/.gnus: ;; (require 'gnus-dired) ;, isn't needed due to autoload cookies -;; (add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode) +;; (add-hook 'dired-mode-hook #'turn-on-gnus-dired-mode) ;; Note that if you visit dired buffers before your ~/.gnus file has ;; been read, those dired buffers won't have the keybindings in @@ -40,7 +40,6 @@ (require 'dired) (autoload 'mml-attach-file "mml") -(autoload 'mm-default-file-encoding "mm-decode");; Shift this to `mailcap.el'? (autoload 'mailcap-extension-to-mime "mailcap") (autoload 'mailcap-mime-info "mailcap") @@ -166,8 +165,9 @@ filenames." (goto-char (point-max)) ;attach at end of buffer (while files-to-attach (mml-attach-file (car files-to-attach) - (or (mm-default-file-encoding (car files-to-attach)) - "application/octet-stream") nil) + (or (mm-default-file-type (car files-to-attach)) + "application/octet-stream") + nil) (setq files-to-attach (cdr files-to-attach))) (message "Attached file(s) %s" files-str)))) diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index 5f7ed386297..f68e9d6b749 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -1,4 +1,4 @@ -;;; gnus-draft.el --- draft message support for Gnus +;;; gnus-draft.el --- draft message support for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. @@ -65,7 +65,7 @@ ;; Set up the menu. (when (gnus-visual-p 'draft-menu 'menu) (gnus-draft-make-menu-bar)) - (add-hook 'gnus-summary-prepare-exit-hook 'gnus-draft-clear-marks t t)))) + (add-hook 'gnus-summary-prepare-exit-hook #'gnus-draft-clear-marks t t)))) ;;; Commands @@ -99,11 +99,11 @@ (let ((gnus-verbose-backends nil)) (gnus-request-expire-articles (list article) group t)) (push - `((lambda () - (when (gnus-buffer-live-p ,gnus-summary-buffer) - (save-excursion - (set-buffer ,gnus-summary-buffer) - (gnus-cache-possibly-remove-article ,article nil nil nil t))))) + (let ((buf gnus-summary-buffer)) + (lambda () + (when (gnus-buffer-live-p buf) + (with-current-buffer buf + (gnus-cache-possibly-remove-article article nil nil nil t))))) message-send-actions))) (defun gnus-draft-send-message (&optional n) @@ -275,8 +275,7 @@ If DONT-POP is nil, display the buffer after setting it up." (gnus-configure-posting-styles) (setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga))) (setq message-post-method - `(lambda (arg) - (gnus-post-method arg ,(car ga)))) + (lambda (arg) (gnus-post-method arg (car ga)))) (unless (equal (cadr ga) "") (dolist (article (cdr ga)) (message-add-action diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el index f7d61bb35fc..e4f3da94573 100644 --- a/lisp/gnus/gnus-dup.el +++ b/lisp/gnus/gnus-dup.el @@ -40,17 +40,14 @@ "If non-nil, save the duplicate list when shutting down Gnus. If nil, duplicate suppression will only work on duplicates seen in the same session." - :group 'gnus-duplicate :type 'boolean) (defcustom gnus-duplicate-list-length 10000 "The maximum number of duplicate Message-IDs to keep track of." - :group 'gnus-duplicate :type 'integer) (defcustom gnus-duplicate-file (nnheader-concat gnus-directory "suppression") "The name of the file to store the duplicate suppression list." - :group 'gnus-duplicate :type 'file) ;;; Internal variables diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el index feee7326cd2..265edf4d612 100644 --- a/lisp/gnus/gnus-eform.el +++ b/lisp/gnus/gnus-eform.el @@ -1,4 +1,4 @@ -;;; gnus-eform.el --- a mode for editing forms for Gnus +;;; gnus-eform.el --- a mode for editing forms for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. @@ -37,12 +37,10 @@ (defcustom gnus-edit-form-mode-hook nil "Hook run in `gnus-edit-form-mode' buffers." - :group 'gnus-edit-form :type 'hook) (defcustom gnus-edit-form-menu-hook nil "Hook run when creating menus in `gnus-edit-form-mode' buffers." - :group 'gnus-edit-form :type 'hook) ;;; Internal variables diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index 615f4a55bc5..f69c2ed12c2 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -1,4 +1,4 @@ -;;; gnus-fun.el --- various frivolous extension functions to Gnus +;;; gnus-fun.el --- various frivolous extension functions to Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. @@ -268,9 +268,9 @@ colors of the displayed X-Faces." 'xface (gnus-put-image (if (gnus-image-type-available-p 'xface) - (apply 'gnus-create-image (concat "X-Face: " data) 'xface t + (apply #'gnus-create-image (concat "X-Face: " data) 'xface t (cdr (assq 'xface gnus-face-properties-alist))) - (apply 'gnus-create-image pbm 'pbm t + (apply #'gnus-create-image pbm 'pbm t (cdr (assq 'pbm gnus-face-properties-alist)))) nil 'xface)) (gnus-add-wash-type 'xface)))))) @@ -325,7 +325,7 @@ colors of the displayed X-Faces." (dotimes (i 255) (push (format format i i i i i i) values)) - (mapconcat 'identity values " "))) + (mapconcat #'identity values " "))) (defun gnus-funcall-no-warning (function &rest args) (when (fboundp function) diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el index a7ca733e755..9ea9e100316 100644 --- a/lisp/gnus/gnus-gravatar.el +++ b/lisp/gnus/gnus-gravatar.el @@ -38,21 +38,18 @@ If nil, default to `gravatar-size'." :type '(choice (const :tag "Default" nil) (integer :tag "Pixels")) - :version "24.1" - :group 'gnus-gravatar) + :version "24.1") (defcustom gnus-gravatar-properties '(:ascent center :relief 1) "List of image properties applied to Gravatar images." :type 'plist - :version "24.1" - :group 'gnus-gravatar) + :version "24.1") (defcustom gnus-gravatar-too-ugly gnus-article-x-face-too-ugly "Regexp matching posters whose avatar shouldn't be shown automatically. If nil, show all avatars." :type '(choice regexp (const :tag "Allow all" nil)) - :version "24.1" - :group 'gnus-gravatar) + :version "24.1") (defun gnus-gravatar-transform-address (header category &optional force) (gnus-with-article-headers diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index ff792c57065..e8b62a4133e 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1,4 +1,4 @@ -;;; gnus-group.el --- group mode commands for Gnus +;;; gnus-group.el --- group mode commands for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. @@ -39,10 +39,11 @@ (eval-when-compile (require 'mm-url) (require 'subr-x) - (let ((features (cons 'gnus-group features))) - (require 'gnus-sum)) - (unless (boundp 'gnus-cache-active-hashtb) - (defvar gnus-cache-active-hashtb nil))) + (with-suppressed-warnings ((lexical features)) + (dlet ((features (cons 'gnus-group features))) + (require 'gnus-sum)))) + +(defvar gnus-cache-active-hashtb) (defvar tool-bar-mode) @@ -366,13 +367,16 @@ requires an understanding of Lisp expressions. Hopefully this will change in a future release. For now, you can use the following variables in the Lisp expression: -group: The name of the group. -unread: The number of unread articles in the group. -method: The select method used. -mailp: Whether it's a mail group or not. -level: The level of the group. -score: The score of the group. -ticked: The number of ticked articles." +`group': The name of the group. +`unread': The number of unread articles in the group. +`method': The select method used. +`total': The total number of articles in the group. +`mailp': Whether it's a mail group or not. +`level': The level of the group. +`score': The score of the group. +`ticked': The number of ticked articles. +`group-age': Time in seconds since the group was last read + (see info node `(gnus)Group Timestamp')." :group 'gnus-group-visual :type '(repeat (cons (sexp :tag "Form") face))) (put 'gnus-group-highlight 'risky-local-variable t) @@ -400,16 +404,8 @@ file. It is also possible to change and add form fields, but currently that requires an understanding of Lisp expressions. Hopefully this will -change in a future release. For now, you can use the following -variables in the Lisp expression: - -group: The name of the group. -unread: The number of unread articles in the group. -method: The select method used. -mailp: Whether it's a mail group or not. -level: The level of the group. -score: The score of the group. -ticked: The number of ticked articles." +change in a future release. For now, you can use the same +variables in the Lisp expression as in `gnus-group-highlight'." :group 'gnus-group-icons :type '(repeat (cons (sexp :tag "Form") file))) (put 'gnus-group-icon-list 'risky-local-variable t) @@ -476,20 +472,31 @@ simple manner." (defvar gnus-group-edit-buffer nil) -(defvar gnus-tmp-news-method) +(defvar gnus-tmp-active) (defvar gnus-tmp-colon) -(defvar gnus-tmp-news-server) -(defvar gnus-tmp-header) -(defvar gnus-tmp-process-marked) -(defvar gnus-tmp-summary-live) -(defvar gnus-tmp-news-method-string) +(defvar gnus-tmp-comment) +(defvar gnus-tmp-group) (defvar gnus-tmp-group-icon) +(defvar gnus-tmp-header) +(defvar gnus-tmp-level) +(defvar gnus-tmp-marked) +(defvar gnus-tmp-marked-mark) +(defvar gnus-tmp-method) +(defvar gnus-tmp-moderated) (defvar gnus-tmp-moderated-string) (defvar gnus-tmp-newsgroup-description) -(defvar gnus-tmp-comment) +(defvar gnus-tmp-news-method) +(defvar gnus-tmp-news-method-string) +(defvar gnus-tmp-news-server) +(defvar gnus-tmp-number-of-read) +(defvar gnus-tmp-number-of-unread) +(defvar gnus-tmp-number-total) +(defvar gnus-tmp-process-marked) (defvar gnus-tmp-qualified-group) (defvar gnus-tmp-subscribed) -(defvar gnus-tmp-number-of-read) +(defvar gnus-tmp-summary-live) +(defvar gnus-tmp-user-defined) + (defvar gnus-inhibit-demon) (defvar gnus-pick-mode) (defvar gnus-tmp-marked-mark) @@ -505,7 +512,8 @@ simple manner." (+ number (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) - (t number)) ?s) + (t number)) + ?s) (?R gnus-tmp-number-of-read ?s) (?U (if (gnus-active gnus-tmp-group) (gnus-number-of-unseen-articles-in-group gnus-tmp-group) @@ -516,7 +524,8 @@ simple manner." (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) - (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) + (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) + ?d) (?g gnus-tmp-group ?s) (?G gnus-tmp-qualified-group ?s) (?c (gnus-short-group-name gnus-tmp-group) @@ -1361,7 +1370,7 @@ if it is a string, only list groups matching REGEXP." (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie))) (gnus-group-prepare-flat-list-dead - (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) + (setq gnus-zombie-list (sort gnus-zombie-list #'string<)) gnus-level-zombie ?Z regexp)) (when not-in-list @@ -1372,7 +1381,7 @@ if it is a string, only list groups matching REGEXP." (gnus-group-prepare-flat-list-dead (cl-union not-in-list - (setq gnus-killed-list (sort gnus-killed-list 'string<)) + (setq gnus-killed-list (sort gnus-killed-list #'string<)) :test 'equal) gnus-level-killed ?K regexp)) @@ -1497,12 +1506,16 @@ if it is a string, only list groups matching REGEXP." (gnus-group-get-new-news 0)))) :type 'boolean) -(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level - gnus-tmp-marked number - gnus-tmp-method) +(defun gnus-group-insert-group-line (group level marked number method) "Insert a group line in the group buffer." - (let* ((gnus-tmp-method - (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) + (with-suppressed-warnings ((lexical number)) + (defvar number)) ;FIXME: Used in `gnus-group-line-format-alist'. + (let* ((number number) + (gnus-tmp-level level) + (gnus-tmp-marked marked) + (gnus-tmp-group group) + (gnus-tmp-method + (gnus-server-get-method gnus-tmp-group method)) (gnus-tmp-active (gnus-active gnus-tmp-group)) (gnus-tmp-number-total (if gnus-tmp-active @@ -1541,7 +1554,8 @@ if it is a string, only list groups matching REGEXP." (gnus-tmp-news-method-string (if gnus-tmp-method (format "(%s:%s)" (car gnus-tmp-method) - (cadr gnus-tmp-method)) "")) + (cadr gnus-tmp-method)) + "")) (gnus-tmp-marked-mark (if (and (numberp number) (zerop number) @@ -1564,7 +1578,7 @@ if it is a string, only list groups matching REGEXP." (point) (prog1 (1+ (point)) ;; Insert the text. - (eval gnus-group-line-format-spec)) + (eval gnus-group-line-format-spec t)) `(gnus-group ,gnus-tmp-group gnus-unread ,(if (numberp number) (string-to-number gnus-tmp-number-of-unread) @@ -1605,10 +1619,12 @@ Some value are bound so the form can use them." (marked (gnus-info-marks info)) (env (list + (cons 'group group) (cons 'unread (if (numberp (car entry)) (car entry) 0)) + (cons 'method method) (cons 'total (if active (1+ (- (cdr active) (car active))) 0)) (cons 'mailp (apply - 'append + #'append (mapcar (lambda (x) (memq x (assoc @@ -1735,7 +1751,7 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated." (buffer-modified-p gnus-dribble-buffer) (with-current-buffer gnus-dribble-buffer (not (zerop (buffer-size)))))) - (mode-string (eval gformat))) + (mode-string (eval gformat t))) ;; Say whether the dribble buffer has been modified. (setq mode-line-modified (if modified "**" "--")) @@ -1883,7 +1899,7 @@ If FIRST-TOO, the current line is also eligible as a target." "Unmark all groups." (interactive) (save-excursion - (mapc 'gnus-group-remove-mark gnus-group-marked)) + (mapc #'gnus-group-remove-mark gnus-group-marked)) (gnus-group-position-point)) (defun gnus-group-mark-region (unmark beg end) @@ -1931,7 +1947,7 @@ Return nil if the group isn't displayed." (gnus-group-mark-group 1 nil t)) (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) -(defun gnus-group-universal-argument (arg &optional groups func) +(defun gnus-group-universal-argument (arg &optional _groups func) "Perform any command on all groups according to the process/prefix convention." (interactive "P") (if (eq (setq func (or func @@ -1942,7 +1958,7 @@ Return nil if the group isn't displayed." 'undefined) (gnus-error 1 "Undefined key") (gnus-group-iterate arg - (lambda (group) + (lambda (_group) (command-execute func)))) (gnus-group-position-point)) @@ -1985,31 +2001,18 @@ Take into consideration N (the prefix) and the list of marked groups." (let ((group (gnus-group-group-name))) (and group (list group)))))) -;;; !!!Surely gnus-group-iterate should be a macro instead? I can't -;;; imagine why I went through these contortions... -(eval-and-compile - (let ((function (make-symbol "gnus-group-iterate-function")) - (window (make-symbol "gnus-group-iterate-window")) - (groups (make-symbol "gnus-group-iterate-groups")) - (group (make-symbol "gnus-group-iterate-group"))) - (eval - `(defun gnus-group-iterate (arg ,function) - "Iterate FUNCTION over all process/prefixed groups. +(defun gnus-group-iterate (arg function) + "Iterate FUNCTION over all process/prefixed groups. FUNCTION will be called with the group name as the parameter and with point over the group in question." - (let ((,groups (gnus-group-process-prefix arg)) - (,window (selected-window)) - ,group) - (while ,groups - (setq ,group (car ,groups) - ,groups (cdr ,groups)) - (select-window ,window) - (gnus-group-remove-mark ,group) - (save-selected-window - (save-excursion - (funcall ,function ,group))))))))) - -(put 'gnus-group-iterate 'lisp-indent-function 1) + (declare (indent 1)) + (let ((window (selected-window))) + (dolist (group (gnus-group-process-prefix arg)) + (select-window window) + (gnus-group-remove-mark group) + (save-selected-window + (save-excursion + (funcall function group)))))) ;; Selecting groups. @@ -2064,6 +2067,12 @@ articles in the group." (forward-line -1)) (gnus-group-read-group all t)) +(defvar gnus-visual) +(defvar gnus-score-find-score-files-function) +(defvar gnus-home-score-file) +(defvar gnus-apply-kill-hook) +(defvar gnus-summary-expunge-below) + (defun gnus-group-quick-select-group (&optional all group) "Select the GROUP \"quickly\". This means that no highlighting or scoring will be performed. If @@ -2521,7 +2530,7 @@ The arguments have the same meaning as those of (if (stringp id) (setq id (string-to-number id))) (setq-local debbugs-gnu-bug-number id))))) -(defun gnus-group-jump-to-group (group &optional prompt) +(defun gnus-group-jump-to-group (group &optional _prompt) "Jump to newsgroup GROUP. If PROMPT (the prefix) is a number, use the prompt specified in @@ -2807,7 +2816,7 @@ not-expirable articles, too." (format "Do you really want to delete these %d articles forever? " (length articles))) (gnus-request-expire-articles articles group - (if current-prefix-arg + (if oldp nil 'force))))) @@ -2926,8 +2935,8 @@ and NEW-NAME will be prompted for." ((eq part 'params) "group parameters") (t "group info")) group) - `(lambda (form) - (gnus-group-edit-group-done ',part ,group form))) + (lambda (form) + (gnus-group-edit-group-done part group form))) (local-set-key "\C-c\C-i" (gnus-create-info-command @@ -2985,7 +2994,7 @@ and NEW-NAME will be prompted for." "Create one of the groups described in `gnus-useful-groups'." (interactive (let ((entry (assoc (gnus-completing-read "Create group" - (mapcar 'car gnus-useful-groups) + (mapcar #'car gnus-useful-groups) t) gnus-useful-groups))) (list (cadr entry) @@ -2995,7 +3004,7 @@ and NEW-NAME will be prompted for." (setq method (copy-tree method)) (let (entry) (while (setq entry (memq (assq 'eval method) method)) - (setcar entry (eval (cadar entry))))) + (setcar entry (eval (cadar entry) t)))) (gnus-group-make-group group method)) (defun gnus-group-make-help-group (&optional noerror) @@ -3118,7 +3127,7 @@ If there is, use Gnus to create an nnrss group" (read-from-minibuffer "Title: " (gnus-newsgroup-savable-name (mapconcat - 'identity + #'identity (split-string (or (cdr (assoc 'title feedinfo)) @@ -3126,7 +3135,7 @@ If there is, use Gnus to create an nnrss group" " "))))) (desc (read-from-minibuffer "Description: " (mapconcat - 'identity + #'identity (split-string (or (cdr (assoc 'description feedinfo)) @@ -3374,9 +3383,9 @@ Editing the access control list for `%s'. implementation-defined hierarchy, RENAME or DELETE mailbox) d - delete messages (STORE \\DELETED flag, perform EXPUNGE) a - administer (perform SETACL)" group) - `(lambda (form) - (nnimap-acl-edit - ,mailbox ',method ',acl form))))) + (lambda (form) + (nnimap-acl-edit + mailbox method acl form))))) ;; Group sorting commands ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>. @@ -4268,7 +4277,7 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (pop-to-buffer "*Gnus Help*") (buffer-disable-undo) (erase-buffer) - (setq groups (sort groups 'string<)) + (setq groups (sort groups #'string<)) (while groups ;; Groups may be entered twice into the list of groups. (when (not (string= (car groups) prev)) @@ -4327,9 +4336,9 @@ If FORCE, force saving whether it is necessary or not." (interactive "P") (gnus-save-newsrc-file force)) -(defun gnus-group-restart (&optional arg) +(defun gnus-group-restart (&optional _arg) "Force Gnus to read the .newsrc file." - (interactive "P") + (interactive) (when (gnus-yes-or-no-p (format "Are you sure you want to restart Gnus? ")) (gnus-save-newsrc-file) @@ -4494,7 +4503,7 @@ and the second element is the address." (interactive (list (let ((how (gnus-completing-read "Which back end" - (mapcar 'car (append gnus-valid-select-methods + (mapcar #'car (append gnus-valid-select-methods gnus-server-alist)) t (cons "nntp" 0) 'gnus-method-history))) ;; We either got a back end name or a virtual server name. @@ -4616,7 +4625,9 @@ and the second element is the address." (setcdr m (gnus-compress-sequence articles t))) (setcdr m (gnus-compress-sequence (sort (nconc (gnus-uncompress-range (cdr m)) - (copy-sequence articles)) '<) t)))))) + (copy-sequence articles)) + #'<) + t)))))) (declare-function gnus-summary-add-mark "gnus-sum" (article type)) @@ -4684,7 +4695,7 @@ This command may read the active file." ;; Cache active file might use "." ;; instead of ":". (gethash - (mapconcat 'identity + (mapconcat #'identity (split-string group ":") ".") gnus-cache-active-hashtb)))) @@ -4746,9 +4757,9 @@ This command may read the active file." (forward-char 1)) groups)) -(defun gnus-group-list-plus (&optional args) +(defun gnus-group-list-plus (&optional _args) "List groups plus the current selection." - (interactive "P") + (interactive) (let ((gnus-group-listed-groups (gnus-group-listed-groups)) (gnus-group-list-mode gnus-group-list-mode) ;; Save it. func) @@ -4808,7 +4819,7 @@ you the groups that have both dormant articles and cached articles." (push n gnus-newsgroup-unselected)) (setq n (1+ n))) (setq gnus-newsgroup-unselected - (sort gnus-newsgroup-unselected '<))))) + (sort gnus-newsgroup-unselected #'<))))) (gnus-activate-group group) (gnus-group-make-articles-read group (list article)) (when (and (gnus-group-auto-expirable-p group) diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index bb1ee5a806a..be62bfd81f5 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -1,4 +1,4 @@ -;;; gnus-html.el --- Render HTML in a buffer. +;;; gnus-html.el --- Render HTML in a buffer. -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2021 Free Software Foundation, Inc. @@ -151,8 +151,8 @@ fit these criteria." (defun gnus-html-wash-images () "Run through current buffer and replace img tags by images." - (let (tag parameters string start end images url alt-text - inhibit-images blocked-images) + (let ( parameters start end ;; tag string images + inhibit-images blocked-images) (if (buffer-live-p gnus-summary-buffer) (with-current-buffer gnus-summary-buffer (setq inhibit-images gnus-inhibit-images @@ -169,67 +169,67 @@ fit these criteria." (delete-region (match-beginning 0) (match-end 0))) (setq end (point)) (when (string-match "src=\"\\([^\"]+\\)" parameters) - (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url) - (setq url (gnus-html-encode-url (match-string 1 parameters)) - alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)" - parameters) - (xml-substitute-special (match-string 2 parameters)))) - (add-text-properties - start end - (list 'image-url url - 'image-displayer `(lambda (url start end) - (gnus-html-display-image url start end - ,alt-text)) - 'help-echo alt-text - 'button t - 'keymap gnus-html-image-map - 'gnus-image (list url start end alt-text))) - (if (string-match "\\`cid:" url) - ;; URLs with cid: have their content stashed in other - ;; parts of the MIME structure, so just insert them - ;; immediately. - (let* ((handle (mm-get-content-id (substring url (match-end 0)))) - (image (when (and handle - (not inhibit-images)) - (gnus-create-image - (mm-with-part handle (buffer-string)) - nil t)))) - (if image - (gnus-add-image - 'cid - (gnus-put-image - (gnus-rescale-image - image (gnus-html-maximum-image-size)) - (gnus-string-or (prog1 - (buffer-substring start end) - (delete-region start end)) - "*") - 'cid)) + (let ((url (gnus-html-encode-url (match-string 1 parameters))) + (alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)" + parameters) + (xml-substitute-special (match-string 2 parameters))))) + (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url) + (add-text-properties + start end + (list 'image-url url + 'image-displayer (lambda (url start end) + (gnus-html-display-image url start end + alt-text)) + 'help-echo alt-text + 'button t + 'keymap gnus-html-image-map + 'gnus-image (list url start end alt-text))) + (if (string-match "\\`cid:" url) + ;; URLs with cid: have their content stashed in other + ;; parts of the MIME structure, so just insert them + ;; immediately. + (let* ((handle (mm-get-content-id (substring url (match-end 0)))) + (image (when (and handle + (not inhibit-images)) + (gnus-create-image + (mm-with-part handle (buffer-string)) + nil t)))) + (if image + (gnus-add-image + 'cid + (gnus-put-image + (gnus-rescale-image + image (gnus-html-maximum-image-size)) + (gnus-string-or (prog1 + (buffer-substring start end) + (delete-region start end)) + "*") + 'cid)) + (make-text-button start end + 'help-echo url + 'keymap gnus-html-image-map))) + ;; Normal, external URL. + (if (or inhibit-images + (gnus-html-image-url-blocked-p url blocked-images)) (make-text-button start end 'help-echo url - 'keymap gnus-html-image-map))) - ;; Normal, external URL. - (if (or inhibit-images - (gnus-html-image-url-blocked-p url blocked-images)) - (make-text-button start end - 'help-echo url - 'keymap gnus-html-image-map) - ;; Non-blocked url - (let ((width - (when (string-match "width=\"?\\([0-9]+\\)" parameters) - (string-to-number (match-string 1 parameters)))) - (height - (when (string-match "height=\"?\\([0-9]+\\)" parameters) - (string-to-number (match-string 1 parameters))))) - ;; Don't fetch images that are really small. They're - ;; probably tracking pictures. - (when (and (or (null height) - (> height 4)) - (or (null width) - (> width 4))) - (gnus-html-display-image url start end alt-text))))))))) - -(defun gnus-html-display-image (url start end &optional alt-text) + 'keymap gnus-html-image-map) + ;; Non-blocked url + (let ((width + (when (string-match "width=\"?\\([0-9]+\\)" parameters) + (string-to-number (match-string 1 parameters)))) + (height + (when (string-match "height=\"?\\([0-9]+\\)" parameters) + (string-to-number (match-string 1 parameters))))) + ;; Don't fetch images that are really small. They're + ;; probably tracking pictures. + (when (and (or (null height) + (> height 4)) + (or (null width) + (> width 4))) + (gnus-html-display-image url start end alt-text)))))))))) + +(defun gnus-html-display-image (url _start _end &optional alt-text) "Display image at URL on text from START to END. Use ALT-TEXT for the image string." (or alt-text (setq alt-text "*")) @@ -248,7 +248,7 @@ Use ALT-TEXT for the image string." (gnus-html-put-image (gnus-html-get-image-data url) url alt-text)))) (defun gnus-html-wash-tags () - (let (tag parameters string start end images url) + (let (tag parameters start end url) ;; string images (gnus-html-pre-wash) (gnus-html-wash-images) @@ -329,10 +329,10 @@ Use ALT-TEXT for the image string." (replace-match "" t t)) (mm-url-decode-entities))) -(defun gnus-html-insert-image (&rest args) +(defun gnus-html-insert-image (&rest _args) "Fetch and insert the image under point." (interactive) - (apply 'gnus-html-display-image (get-text-property (point) 'gnus-image))) + (apply #'gnus-html-display-image (get-text-property (point) 'gnus-image))) (defun gnus-html-show-alt-text () "Show the ALT text of the image under point." diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 9c68773e19a..64928623e6a 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -1,4 +1,4 @@ -;;; gnus-int.el --- backend interface functions for Gnus +;;; gnus-int.el --- backend interface functions for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. @@ -76,23 +76,25 @@ server denied." "The current method, for the registry.") -(defun gnus-server-opened (gnus-command-method) - "Check whether a connection to GNUS-COMMAND-METHOD has been opened." - (unless (eq (gnus-server-status gnus-command-method) +(defun gnus-server-opened (command-method) + "Check whether a connection to COMMAND-METHOD has been opened." + (unless (eq (gnus-server-status command-method) 'denied) - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (inline (gnus-get-function gnus-command-method 'server-opened)) - (nth 1 gnus-command-method)))) - -(defun gnus-status-message (gnus-command-method) - "Return the status message from GNUS-COMMAND-METHOD. -If GNUS-COMMAND-METHOD is a string, it is interpreted as a group -name. The method this group uses will be queried." + (let ((gnus-command-method + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method))) + (funcall (inline (gnus-get-function gnus-command-method 'server-opened)) + (nth 1 gnus-command-method))))) + +(defun gnus-status-message (command-method) + "Return the status message from COMMAND-METHOD. +If COMMAND-METHOD is a string, it is interpreted as a group name. +The method this group uses will be queried." (let ((gnus-command-method - (if (stringp gnus-command-method) - (gnus-find-method-for-group gnus-command-method) - gnus-command-method))) + (if (stringp command-method) + (gnus-find-method-for-group command-method) + command-method))) (funcall (gnus-get-function gnus-command-method 'status-message) (nth 1 gnus-command-method)))) @@ -265,13 +267,14 @@ If it is down, start it up (again)." type form)) (setq gnus-backend-trace-elapsed (float-time))))) -(defun gnus-open-server (gnus-command-method) - "Open a connection to GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) +(defun gnus-open-server (command-method) + "Open a connection to COMMAND-METHOD." (gnus-backend-trace :opening gnus-command-method) - (let ((elem (assoc gnus-command-method gnus-opened-servers)) - (server (gnus-method-to-server-name gnus-command-method))) + (let* ((gnus-command-method (if (stringp command-method) + (gnus-server-to-method command-method) + command-method)) + (elem (assoc gnus-command-method gnus-opened-servers)) + (server (gnus-method-to-server-name gnus-command-method))) ;; If this method was previously denied, we just return nil. (if (eq (nth 1 elem) 'denied) (progn @@ -347,23 +350,27 @@ If it is down, start it up (again)." (gnus-backend-trace :opened gnus-command-method) result))))) -(defun gnus-close-server (gnus-command-method) - "Close the connection to GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (prog1 - (funcall (gnus-get-function gnus-command-method 'close-server) - (nth 1 gnus-command-method) - (nthcdr 2 gnus-command-method)) - (when-let ((elem (assoc gnus-command-method gnus-opened-servers))) - (setf (nth 1 elem) 'closed)))) - -(defun gnus-request-list (gnus-command-method) - "Request the active file from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-list) - (nth 1 gnus-command-method))) +(defun gnus-close-server (command-method) + "Close the connection to COMMAND-METHOD." + (let ((gnus-command-method + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method))) + (prog1 + (funcall (gnus-get-function gnus-command-method 'close-server) + (nth 1 gnus-command-method) + (nthcdr 2 gnus-command-method)) + (when-let ((elem (assoc gnus-command-method gnus-opened-servers))) + (setf (nth 1 elem) 'closed))))) + +(defun gnus-request-list (command-method) + "Request the active file from COMMAND-METHOD." + (let ((gnus-command-method + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method))) + (funcall (gnus-get-function gnus-command-method 'request-list) + (nth 1 gnus-command-method)))) (defun gnus-server-get-active (server &optional ignored) "Return the active list for SERVER. @@ -407,47 +414,57 @@ Groups matching the IGNORED regexp are excluded." (forward-line))))) groups)) -(defun gnus-finish-retrieve-group-infos (gnus-command-method infos data) - "Read and update infos from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) +(defun gnus-finish-retrieve-group-infos (command-method infos data) + "Read and update infos from COMMAND-METHOD." + (let ((gnus-command-method + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method))) (gnus-backend-trace :finishing gnus-command-method) (prog1 (funcall (gnus-get-function gnus-command-method 'finish-retrieve-group-infos) (nth 1 gnus-command-method) infos data) - (gnus-backend-trace :finished gnus-command-method))) - -(defun gnus-retrieve-group-data-early (gnus-command-method infos) - "Start early async retrieval of data from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'retrieve-group-data-early) - (nth 1 gnus-command-method) - infos)) - -(defun gnus-request-list-newsgroups (gnus-command-method) - "Request the newsgroups file from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-list-newsgroups) - (nth 1 gnus-command-method))) - -(defun gnus-request-newgroups (date gnus-command-method) - "Request all new groups since DATE from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (let ((func (gnus-get-function gnus-command-method 'request-newgroups t))) - (when func - (funcall func date (nth 1 gnus-command-method))))) - -(defun gnus-request-regenerate (gnus-command-method) - "Request a data generation from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-regenerate) - (nth 1 gnus-command-method))) + (gnus-backend-trace :finished gnus-command-method)))) + +(defun gnus-retrieve-group-data-early (command-method infos) + "Start early async retrieval of data from COMMAND-METHOD." + (let ((gnus-command-method + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method))) + (funcall (gnus-get-function gnus-command-method 'retrieve-group-data-early) + (nth 1 gnus-command-method) + infos))) + +(defun gnus-request-list-newsgroups (command-method) + "Request the newsgroups file from COMMAND-METHOD." + (let ((gnus-command-method + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method))) + (funcall (gnus-get-function gnus-command-method 'request-list-newsgroups) + (nth 1 gnus-command-method)))) + +(defun gnus-request-newgroups (date command-method) + "Request all new groups since DATE from COMMAND-METHOD." + (let ((gnus-command-method + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method))) + (let ((func (gnus-get-function gnus-command-method 'request-newgroups t))) + (when func + (funcall func date (nth 1 gnus-command-method)))))) + +(defun gnus-request-regenerate (command-method) + "Request a data generation from COMMAND-METHOD." + (let ((gnus-command-method + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method))) + (funcall (gnus-get-function gnus-command-method 'request-regenerate) + (nth 1 gnus-command-method)))) (defun gnus-request-compact-group (group) (let* ((method (gnus-find-method-for-group group)) @@ -459,17 +476,19 @@ Groups matching the IGNORED regexp are excluded." (nth 1 gnus-command-method) t))) result)) -(defun gnus-request-compact (gnus-command-method) - "Request groups compaction from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-compact) - (nth 1 gnus-command-method))) +(defun gnus-request-compact (command-method) + "Request groups compaction from COMMAND-METHOD." + (let ((gnus-command-method + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method))) + (funcall (gnus-get-function gnus-command-method 'request-compact) + (nth 1 gnus-command-method)))) -(defun gnus-request-group (group &optional dont-check gnus-command-method info) +(defun gnus-request-group (group &optional dont-check command-method info) "Request GROUP. If DONT-CHECK, no information is required." (let ((gnus-command-method - (or gnus-command-method (inline (gnus-find-method-for-group group))))) + (or command-method (inline (gnus-find-method-for-group group))))) (when (stringp gnus-command-method) (setq gnus-command-method (inline (gnus-server-to-method gnus-command-method)))) @@ -522,12 +541,14 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." articles (gnus-group-real-name group) (nth 1 gnus-command-method)))) -(defun gnus-retrieve-groups (groups gnus-command-method) - "Request active information on GROUPS from GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'retrieve-groups) - groups (nth 1 gnus-command-method))) +(defun gnus-retrieve-groups (groups command-method) + "Request active information on GROUPS from COMMAND-METHOD." + (let ((gnus-command-method + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method))) + (funcall (gnus-get-function gnus-command-method 'retrieve-groups) + groups (nth 1 gnus-command-method)))) (defun gnus-request-type (group &optional article) "Return the type (`post' or `mail') of GROUP (and ARTICLE)." @@ -628,7 +649,7 @@ the group's summary. article-number) ;; Clean up the new summary and propagate the error (error (when group-is-new (gnus-summary-exit)) - (apply 'signal err))))) + (apply #'signal err))))) (defun gnus-simplify-group-name (group) "Return the simplest representation of the name of GROUP. @@ -715,26 +736,33 @@ from other groups -- for instance, search results and the like." (delete-region (point-min) (1- (point)))))) res)) -(defun gnus-request-post (gnus-command-method) - "Post the current buffer using GNUS-COMMAND-METHOD." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-post) - (nth 1 gnus-command-method))) +(defun gnus-request-post (command-method) + "Post the current buffer using COMMAND-METHOD." + (let ((gnus-command-method + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method))) + (funcall (gnus-get-function gnus-command-method 'request-post) + (nth 1 gnus-command-method)))) -(defun gnus-request-expunge-group (group gnus-command-method) +(defun gnus-request-expunge-group (group command-method) "Expunge GROUP, which is removing articles that have been marked as deleted." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-expunge-group) - (gnus-group-real-name group) - (nth 1 gnus-command-method))) - -(defun gnus-request-scan (group gnus-command-method) - "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD. -If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (let ((gnus-command-method - (if group (gnus-find-method-for-group group) gnus-command-method)) + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method))) + (funcall (gnus-get-function gnus-command-method 'request-expunge-group) + (gnus-group-real-name group) + (nth 1 gnus-command-method)))) + +(defvar mail-source-plugged) +(defvar gnus-inhibit-demon) + +(defun gnus-request-scan (group command-method) + "Request a SCAN being performed in GROUP from COMMAND-METHOD. +If GROUP is nil, all groups on COMMAND-METHOD are scanned." + (let ((gnus-command-method + (if group (gnus-find-method-for-group group) command-method)) (gnus-inhibit-demon t) (mail-source-plugged gnus-plugged)) (when (or gnus-plugged @@ -744,36 +772,40 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (and group (gnus-group-real-name group)) (nth 1 gnus-command-method))))) -(defun gnus-request-update-info (info gnus-command-method) +(defun gnus-request-update-info (info command-method) (when (gnus-check-backend-function - 'request-update-info (car gnus-command-method)) - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'request-update-info) - (gnus-group-real-name (gnus-info-group info)) info - (nth 1 gnus-command-method)))) - -(defsubst gnus-request-marks (info gnus-command-method) - "Request that GNUS-COMMAND-METHOD update INFO." - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (when (gnus-check-backend-function - 'request-marks (car gnus-command-method)) - (let ((group (gnus-info-group info))) - (and (funcall (gnus-get-function gnus-command-method 'request-marks) - (gnus-group-real-name group) - info (nth 1 gnus-command-method)) - ;; If the minimum article number is greater than 1, then all - ;; smaller article numbers are known not to exist; we'll - ;; artificially add those to the 'read range. - (let* ((active (gnus-active group)) - (min (car active))) - (when (> min 1) - (let* ((range (if (= min 2) 1 (cons 1 (1- min)))) - (read (gnus-info-read info)) - (new-read (gnus-range-add read (list range)))) - (setf (gnus-info-read info) new-read))) - info))))) + 'request-update-info (car command-method)) + (let ((gnus-command-method + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method))) + (funcall (gnus-get-function gnus-command-method 'request-update-info) + (gnus-group-real-name (gnus-info-group info)) info + (nth 1 gnus-command-method))))) + +(defsubst gnus-request-marks (info command-method) + "Request that COMMAND-METHOD update INFO." + (let ((gnus-command-method + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method))) + (when (gnus-check-backend-function + 'request-marks (car gnus-command-method)) + (let ((group (gnus-info-group info))) + (and (funcall (gnus-get-function gnus-command-method 'request-marks) + (gnus-group-real-name group) + info (nth 1 gnus-command-method)) + ;; If the minimum article number is greater than 1, then all + ;; smaller article numbers are known not to exist; we'll + ;; artificially add those to the 'read range. + (let* ((active (gnus-active group)) + (min (car active))) + (when (> min 1) + (let* ((range (if (= min 2) 1 (cons 1 (1- min)))) + (read (gnus-info-read info)) + (new-read (gnus-range-add read (list range)))) + (setf (gnus-info-read info) new-read))) + info)))))) (defun gnus-request-expire-articles (articles group &optional force) (let* ((gnus-command-method (gnus-find-method-for-group group)) @@ -794,7 +826,7 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (gnus-agent-expire expired-articles group 'force)))) not-deleted)) -(defun gnus-request-move-article (article group server accept-function +(defun gnus-request-move-article (article group _server accept-function &optional last move-is-internal) (let* ((gnus-command-method (gnus-find-method-for-group group)) (result (funcall (gnus-get-function gnus-command-method @@ -807,38 +839,40 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (gnus-agent-unfetch-articles group (list article))) result)) -(defun gnus-request-accept-article (group &optional gnus-command-method last +(defun gnus-request-accept-article (group &optional command-method last no-encode) - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (when (and (not gnus-command-method) - (stringp group)) - (setq gnus-command-method (or (gnus-find-method-for-group group) - (gnus-group-name-to-method group)))) - (goto-char (point-max)) - ;; Make sure there's a newline at the end of the article. - (unless (bolp) - (insert "\n")) - (unless no-encode - (let ((message-options message-options)) - (message-options-set-recipient) - (save-restriction - (message-narrow-to-head) - (mail-encode-encoded-word-buffer)) - (message-encode-message-body))) - (let ((gnus-command-method (or gnus-command-method - (gnus-find-method-for-group group))) - (result - (funcall - (gnus-get-function gnus-command-method 'request-accept-article) - (if (stringp group) (gnus-group-real-name group) group) - (cadr gnus-command-method) - last))) - (when (and gnus-agent - (gnus-agent-method-p gnus-command-method) - (cdr result)) - (gnus-agent-regenerate-group group (list (cdr result)))) - result)) + (let ((gnus-command-method + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method))) + (when (and (not gnus-command-method) + (stringp group)) + (setq gnus-command-method (or (gnus-find-method-for-group group) + (gnus-group-name-to-method group)))) + (goto-char (point-max)) + ;; Make sure there's a newline at the end of the article. + (unless (bolp) + (insert "\n")) + (unless no-encode + (let ((message-options message-options)) + (message-options-set-recipient) + (save-restriction + (message-narrow-to-head) + (mail-encode-encoded-word-buffer)) + (message-encode-message-body))) + (let ((gnus-command-method (or gnus-command-method + (gnus-find-method-for-group group))) + (result + (funcall + (gnus-get-function gnus-command-method 'request-accept-article) + (if (stringp group) (gnus-group-real-name group) group) + (cadr gnus-command-method) + last))) + (when (and gnus-agent + (gnus-agent-method-p gnus-command-method) + (cdr result)) + (gnus-agent-regenerate-group group (list (cdr result)))) + result))) (defun gnus-request-replace-article (article group buffer &optional no-encode) (unless no-encode @@ -862,13 +896,14 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." article (gnus-group-real-name group) (nth 1 gnus-command-method)))) -(defun gnus-request-create-group (group &optional gnus-command-method args) - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (let ((gnus-command-method - (or gnus-command-method (gnus-find-method-for-group group)))) +(defun gnus-request-create-group (group &optional command-method args) + (let* ((gnus-command-method + (or (if (stringp command-method) + (gnus-server-to-method command-method) + command-method) + (gnus-find-method-for-group group)))) (funcall (gnus-get-function gnus-command-method 'request-create-group) - (gnus-group-real-name group) (nth 1 gnus-command-method) args))) + (gnus-group-real-name group) (nth 1 gnus-command-method) args))) (defun gnus-request-delete-group (group &optional force) (let* ((gnus-command-method (gnus-find-method-for-group group)) @@ -902,15 +937,18 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." "-request-close")))) (funcall func))))) -(defun gnus-asynchronous-p (gnus-command-method) - (let ((func (gnus-get-function gnus-command-method 'asynchronous-p t))) +(defun gnus-asynchronous-p (command-method) + (let ((func (gnus-get-function command-method 'asynchronous-p t))) (when (fboundp func) - (funcall func)))) - -(defun gnus-remove-denial (gnus-command-method) - (when (stringp gnus-command-method) - (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (let* ((elem (assoc gnus-command-method gnus-opened-servers)) + (let ((gnus-command-method command-method)) + (funcall func))))) + +(defun gnus-remove-denial (command-method) + (let* ((gnus-command-method + (if (stringp command-method) + (gnus-server-to-method command-method) + command-method)) + (elem (assoc gnus-command-method gnus-opened-servers)) (status (cadr elem))) ;; If this hasn't been opened before, we add it to the list. (when (eq status 'denied) diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index 7e592026cd0..b0e6cb59d52 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el @@ -1,4 +1,4 @@ -;;; gnus-kill.el --- kill commands for Gnus +;;; gnus-kill.el --- kill commands for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -275,7 +275,7 @@ If NEWSGROUP is nil, the global kill file is selected." (save-excursion (save-window-excursion (pop-to-buffer gnus-summary-buffer) - (eval (car (read-from-string string))))))) + (eval (car (read-from-string string)) t))))) (defun gnus-kill-file-apply-last-sexp () "Apply sexp before point in current buffer to current newsgroup." @@ -289,7 +289,7 @@ If NEWSGROUP is nil, the global kill file is selected." (save-excursion (save-window-excursion (pop-to-buffer gnus-summary-buffer) - (eval (car (read-from-string string)))))) + (eval (car (read-from-string string)) t)))) (ding) (gnus-message 2 "No newsgroup is selected."))) (defun gnus-kill-file-exit () @@ -403,9 +403,9 @@ Returns the number of articles marked as read." (eq (car form) 'gnus-lower)) (progn (delete-region beg (point)) - (insert (or (eval form) ""))) + (insert (or (eval form t) ""))) (with-current-buffer gnus-summary-buffer - (ignore-errors (eval form))))) + (ignore-errors (eval form t))))) (and (buffer-modified-p) gnus-kill-save-kill-file (save-buffer)) @@ -560,7 +560,7 @@ COMMAND must be a Lisp expression or a string representing a key sequence." ((functionp form) (funcall form)) (t - (eval form))))) + (eval form t))))) ;; Search article body. (let ((gnus-current-article nil) ;Save article pointer. (gnus-last-article nil) @@ -578,7 +578,7 @@ COMMAND must be a Lisp expression or a string representing a key sequence." ((functionp form) (funcall form)) (t - (eval form))))))) + (eval form t))))))) did-kill))) (defun gnus-execute (field regexp form &optional backward unread) @@ -606,12 +606,10 @@ marked as read or ticked are ignored." (downcase (symbol-name header))) gnus-extra-headers))) (setq function - `(lambda (h) - (gnus-extra-header - (quote ,(nth (- (length gnus-extra-headers) - (length extras)) - gnus-extra-headers)) - h))))))) + (let ((type (nth (- (length gnus-extra-headers) + (length extras)) + gnus-extra-headers))) + (lambda (h) (gnus-extra-header type h)))))))) ;; Signal error. (t (error "Unknown header field: \"%s\"" field))) @@ -641,7 +639,7 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score" (let* ((gnus-newsrc-options-n (gnus-newsrc-parse-options (concat "options -n " - (mapconcat 'identity command-line-args-left " ")))) + (mapconcat #'identity command-line-args-left " ")))) (gnus-expert-user t) (mail-sources nil) (gnus-use-dribble-file nil) diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el index 105222d6797..cdfdc9b7319 100644 --- a/lisp/gnus/gnus-logic.el +++ b/lisp/gnus/gnus-logic.el @@ -1,4 +1,4 @@ -;;; gnus-logic.el --- advanced scoring code for Gnus +;;; gnus-logic.el --- advanced scoring code for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el index b26b736d055..fc8d9be8d6d 100644 --- a/lisp/gnus/gnus-mh.el +++ b/lisp/gnus/gnus-mh.el @@ -1,4 +1,4 @@ -;;; gnus-mh.el --- mh-e interface for Gnus +;;; gnus-mh.el --- mh-e interface for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1994-2021 Free Software Foundation, Inc. @@ -95,7 +95,7 @@ Optional argument FOLDER specifies folder name." (kill-buffer errbuf)))) (setq gnus-newsgroup-last-folder folder))) -(defun gnus-Folder-save-name (newsgroup headers &optional last-folder) +(defun gnus-Folder-save-name (newsgroup _headers &optional last-folder) "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. If variable `gnus-use-long-file-name' is nil, it is +News.group. Otherwise, it is like +news/group." @@ -105,7 +105,7 @@ Otherwise, it is like +news/group." (gnus-capitalize-newsgroup newsgroup) (gnus-newsgroup-directory-form newsgroup))))) -(defun gnus-folder-save-name (newsgroup headers &optional last-folder) +(defun gnus-folder-save-name (newsgroup _headers &optional last-folder) "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. If variable `gnus-use-long-file-name' is nil, it is +news.group. Otherwise, it is like +news/group." diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el index a47c15525a3..3b2b5a07c1d 100644 --- a/lisp/gnus/gnus-ml.el +++ b/lisp/gnus/gnus-ml.el @@ -1,4 +1,4 @@ -;;; gnus-ml.el --- Mailing list minor mode for Gnus +;;; gnus-ml.el --- Mailing list minor mode for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el index ed8d15a2feb..d42f0971259 100644 --- a/lisp/gnus/gnus-mlspl.el +++ b/lisp/gnus/gnus-mlspl.el @@ -1,4 +1,4 @@ -;;; gnus-mlspl.el --- a group params-based mail splitting mechanism +;;; gnus-mlspl.el --- a group params-based mail splitting mechanism -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2021 Free Software Foundation, Inc. @@ -196,13 +196,13 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: (concat "\\(" (mapconcat - 'identity + #'identity (append (and to-address (list (regexp-quote to-address))) (and to-list (list (regexp-quote to-list))) (and extra-aliases (if (listp extra-aliases) - (mapcar 'regexp-quote extra-aliases) + (mapcar #'regexp-quote extra-aliases) (list extra-aliases))) (and split-regexp (list split-regexp))) "\\|") diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 419b5ead563..45e665be8c3 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1,4 +1,4 @@ -;;; gnus-msg.el --- mail and post interface for Gnus +;;; gnus-msg.el --- mail and post interface for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -389,9 +389,10 @@ only affect the Gcc copy, but not the original message." ;;; Internal functions. (defun gnus-inews-make-draft (articles) - `(lambda () - (gnus-inews-make-draft-meta-information - ,gnus-newsgroup-name ',articles))) + (let ((gn gnus-newsgroup-name)) + (lambda () + (gnus-inews-make-draft-meta-information + gn articles)))) (autoload 'nnselect-article-number "nnselect" nil nil 'macro) (autoload 'nnselect-article-group "nnselect" nil nil 'macro) @@ -399,6 +400,7 @@ only affect the Gcc copy, but not the original message." (defvar gnus-article-reply nil) (defmacro gnus-setup-message (config &rest forms) + (declare (indent 1) (debug t)) (let ((winconf (make-symbol "gnus-setup-message-winconf")) (winconf-name (make-symbol "gnus-setup-message-winconf-name")) (buffer (make-symbol "gnus-setup-message-buffer")) @@ -473,8 +475,8 @@ only affect the Gcc copy, but not the original message." (let ((mbl1 mml-buffer-list)) (setq mml-buffer-list mbl) ;; Global value (setq-local mml-buffer-list mbl1) ;; Local value - (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t) - (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)) + (add-hook 'change-major-mode-hook #'mml-destroy-buffers nil t) + (add-hook 'kill-buffer-hook #'mml-destroy-buffers t t)) (mml-destroy-buffers) (setq mml-buffer-list mbl))) (message-hide-headers) @@ -516,14 +518,13 @@ instead." switch-action yank-action send-actions return-action)) (let ((buf (current-buffer)) ;; Don't use posting styles corresponding to any existing group. - (group-name gnus-newsgroup-name) + ;; (group-name gnus-newsgroup-name) mail-buf) - (unwind-protect - (progn - (let ((gnus-newsgroup-name "")) - (gnus-setup-message 'message - (message-mail to subject other-headers continue - nil yank-action send-actions return-action))))) + (let ((gnus-newsgroup-name "")) + (gnus-setup-message + 'message + (message-mail to subject other-headers continue + nil yank-action send-actions return-action))) (when switch-action (setq mail-buf (current-buffer)) (switch-to-buffer buf) @@ -565,16 +566,21 @@ instead." (symbol-value (car elem)))) (throw 'found (cons (cadr elem) (caddr elem))))))))) +(declare-function gnus-agent-possibly-do-gcc "gnus-agent" ()) +(declare-function gnus-cache-possibly-remove-article "gnus-cache" + (article ticked dormant unread &optional force)) + (defun gnus-inews-add-send-actions (winconf buffer article &optional config yanked winconf-name) - (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc - 'gnus-inews-do-gcc) nil t) + (add-hook 'message-sent-hook (if gnus-agent #'gnus-agent-possibly-do-gcc + #'gnus-inews-do-gcc) + nil t) (when gnus-agent - (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t)) + (add-hook 'message-header-hook #'gnus-agent-possibly-save-gcc nil t)) (setq message-post-method - `(lambda (&optional arg) - (gnus-post-method arg ,gnus-newsgroup-name))) + (let ((gn gnus-newsgroup-name)) + (lambda (&optional arg) (gnus-post-method arg gn)))) (message-add-action `(progn (setq gnus-current-window-configuration ',winconf-name) @@ -596,9 +602,6 @@ instead." `(gnus-summary-mark-article-as-replied ',to-be-marked))))) 'send))) -(put 'gnus-setup-message 'lisp-indent-function 1) -(put 'gnus-setup-message 'edebug-form-spec '(form body)) - ;;; Post news commands of Gnus group mode and summary mode (defun gnus-group-mail (&optional arg) @@ -608,21 +611,19 @@ If ARG is 1, prompt for a group name to find the posting style." (interactive "P") ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. - (let ((group gnus-newsgroup-name) - ;; make sure last viewed article doesn't affect posting styles: - (gnus-article-copy) - (buffer (current-buffer))) - (unwind-protect - (progn - (let ((gnus-newsgroup-name - (if arg - (if (= 1 (prefix-numeric-value arg)) - (gnus-group-completing-read - "Use posting style of group" - nil (gnus-read-active-file-p)) - (gnus-group-group-name)) - ""))) - (gnus-setup-message 'message (message-mail))))))) + (let* (;;(group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) + ;; (buffer (current-buffer)) + (gnus-newsgroup-name + (if arg + (if (= 1 (prefix-numeric-value arg)) + (gnus-group-completing-read + "Use posting style of group" + nil (gnus-read-active-file-p)) + (gnus-group-group-name)) + ""))) + (gnus-setup-message 'message (message-mail)))) (defun gnus-group-news (&optional arg) "Start composing a news. @@ -635,22 +636,21 @@ network. The corresponding back end must have a `request-post' method." (interactive "P") ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. - (let ((group gnus-newsgroup-name) - ;; make sure last viewed article doesn't affect posting styles: - (gnus-article-copy) - (buffer (current-buffer))) - (unwind-protect - (progn - (let ((gnus-newsgroup-name - (if arg - (if (= 1 (prefix-numeric-value arg)) - (gnus-group-completing-read "Use group" - nil - (gnus-read-active-file-p)) - (gnus-group-group-name)) - ""))) - (gnus-setup-message 'message - (message-news (gnus-group-real-name gnus-newsgroup-name)))))))) + (let* (;;(group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) + ;; (buffer (current-buffer)) + (gnus-newsgroup-name + (if arg + (if (= 1 (prefix-numeric-value arg)) + (gnus-group-completing-read "Use group" + nil + (gnus-read-active-file-p)) + (gnus-group-group-name)) + ""))) + (gnus-setup-message + 'message + (message-news (gnus-group-real-name gnus-newsgroup-name))))) (defun gnus-group-post-news (&optional arg) "Start composing a message (a news by default). @@ -679,21 +679,19 @@ posting style." (interactive "P") ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. - (let ((group gnus-newsgroup-name) - ;; make sure last viewed article doesn't affect posting styles: - (gnus-article-copy) - (buffer (current-buffer))) - (unwind-protect - (progn - (let ((gnus-newsgroup-name - (if arg - (if (= 1 (prefix-numeric-value arg)) - (gnus-group-completing-read "Use group" - nil - (gnus-read-active-file-p)) - "") - gnus-newsgroup-name))) - (gnus-setup-message 'message (message-mail))))))) + (let* (;;(group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) + ;; (buffer (current-buffer)) + (gnus-newsgroup-name + (if arg + (if (= 1 (prefix-numeric-value arg)) + (gnus-group-completing-read "Use group" + nil + (gnus-read-active-file-p)) + "") + gnus-newsgroup-name))) + (gnus-setup-message 'message (message-mail)))) (defun gnus-summary-news-other-window (&optional arg) "Start composing a news in another window. @@ -706,27 +704,26 @@ network. The corresponding back end must have a `request-post' method." (interactive "P") ;; We can't `let' gnus-newsgroup-name here, since that leads ;; to local variables leaking. - (let ((group gnus-newsgroup-name) - ;; make sure last viewed article doesn't affect posting styles: - (gnus-article-copy) - (buffer (current-buffer))) - (unwind-protect - (progn - (let ((gnus-newsgroup-name - (if arg - (if (= 1 (prefix-numeric-value arg)) - (gnus-group-completing-read "Use group" - nil - (gnus-read-active-file-p)) - "") - gnus-newsgroup-name))) - (gnus-setup-message 'message - (progn - (message-news (gnus-group-real-name gnus-newsgroup-name)) - (setq-local gnus-discouraged-post-methods - (remove - (car (gnus-find-method-for-group gnus-newsgroup-name)) - gnus-discouraged-post-methods))))))))) + (let* (;;(group gnus-newsgroup-name) + ;; make sure last viewed article doesn't affect posting styles: + (gnus-article-copy) + ;; (buffer (current-buffer)) + (gnus-newsgroup-name + (if arg + (if (= 1 (prefix-numeric-value arg)) + (gnus-group-completing-read "Use group" + nil + (gnus-read-active-file-p)) + "") + gnus-newsgroup-name))) + (gnus-setup-message + 'message + (progn + (message-news (gnus-group-real-name gnus-newsgroup-name)) + (setq-local gnus-discouraged-post-methods + (remove + (car (gnus-find-method-for-group gnus-newsgroup-name)) + gnus-discouraged-post-methods)))))) (defun gnus-summary-post-news (&optional arg) "Start composing a message. Post to the current group by default. @@ -824,8 +821,8 @@ prefix `a', cancel using the standard posting method; if not post using the current select method." (interactive (gnus-interactive "P\ny")) (let ((message-post-method - `(lambda (arg) - (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name))) + (let ((gn gnus-newsgroup-name)) + (lambda (_arg) (gnus-post-method (eq symp 'a) gn)))) (custom-address user-mail-address)) (dolist (article (gnus-summary-work-articles n)) (when (gnus-summary-select-article t nil nil article) @@ -860,11 +857,12 @@ header line with the old Message-ID." (set-buffer gnus-original-article-buffer) (message-supersede) (push - `((lambda () - (when (gnus-buffer-live-p ,gnus-summary-buffer) - (with-current-buffer ,gnus-summary-buffer - (gnus-cache-possibly-remove-article ,article nil nil nil t) - (gnus-summary-mark-as-read ,article gnus-canceled-mark))))) + (let ((buf gnus-summary-buffer)) + (lambda () + (when (gnus-buffer-live-p buf) + (with-current-buffer buf + (gnus-cache-possibly-remove-article article nil nil nil t) + (gnus-summary-mark-as-read article gnus-canceled-mark))))) message-send-actions) ;; Add Gcc header. (gnus-inews-insert-gcc)))) @@ -934,7 +932,7 @@ header line with the old Message-ID." (run-hooks 'gnus-article-decode-hook))))) gnus-article-copy))) -(defun gnus-post-news (post &optional group header article-buffer yank subject +(defun gnus-post-news (post &optional group header article-buffer yank _subject force-news) (when article-buffer (gnus-copy-article-buffer)) @@ -1040,8 +1038,8 @@ If SILENT, don't prompt the user." gnus-post-method (list gnus-post-method))) gnus-secondary-select-methods - (mapcar 'cdr gnus-server-alist) - (mapcar 'car gnus-opened-servers) + (mapcar #'cdr gnus-server-alist) + (mapcar #'car gnus-opened-servers) (list gnus-select-method) (list group-method))) method-alist post-methods method) @@ -1069,7 +1067,7 @@ If SILENT, don't prompt the user." ;; Just use the last value. gnus-last-posting-server (gnus-completing-read - "Posting method" (mapcar 'car method-alist) t + "Posting method" (mapcar #'car method-alist) t (cons (or gnus-last-posting-server "") 0)))) method-alist)))) ;; Override normal method. @@ -1343,13 +1341,13 @@ For the \"inline\" alternatives, also see the variable self)) "\n")) ((null self) - (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n")) + (insert "Gcc: " (mapconcat #'identity gcc ", ") "\n")) ((eq self 'no-gcc-self) (when (setq gcc (delete gnus-newsgroup-name (delete (concat "\"" gnus-newsgroup-name "\"") gcc))) - (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n"))))))) + (insert "Gcc: " (mapconcat #'identity gcc ", ") "\n"))))))) (defun gnus-summary-resend-message (address n &optional no-select) "Resend the current article to ADDRESS. @@ -1389,13 +1387,14 @@ the message before resending." (setq user-mail-address tem)))) ;; `gnus-summary-resend-message-insert-gcc' must run last. (add-hook 'message-header-setup-hook - 'gnus-summary-resend-message-insert-gcc t) + #'gnus-summary-resend-message-insert-gcc t) (add-hook 'message-sent-hook - `(lambda () - (let ((rfc2047-encode-encoded-words nil)) - ,(if gnus-agent - '(gnus-agent-possibly-do-gcc) - '(gnus-inews-do-gcc))))) + (let ((agent gnus-agent)) + (lambda () + (let ((rfc2047-encode-encoded-words nil)) + (if agent + (gnus-agent-possibly-do-gcc) + (gnus-inews-do-gcc)))))) (dolist (article (gnus-summary-work-articles n)) (if no-select (with-current-buffer " *nntpd*" @@ -1736,7 +1735,7 @@ this is a reply." ;; Function. (funcall (car var) group)) (t - (eval (car var))))))) + (eval (car var) t)))))) (setq var (cdr var))) result))) name) @@ -1793,7 +1792,7 @@ this is a reply." (with-current-buffer gnus-summary-buffer gnus-posting-styles) gnus-posting-styles)) - style match attribute value v results matched-string + match value v results matched-string ;; style attribute filep name address element) ;; If the group has a posting-style parameter, add it at the end with a ;; regexp matching everything, to be sure it takes precedence over all @@ -1848,7 +1847,7 @@ this is a reply." (setq matched-string header))))))) (t ;; This is a form to be evalled. - (eval match))))) + (eval match t))))) ;; We have a match, so we set the variables. (dolist (attribute style) (setq element (pop attribute) @@ -1879,7 +1878,7 @@ this is a reply." ((boundp value) (symbol-value value)))) ((listp value) - (eval value)))) + (eval value t)))) ;; Translate obsolescent value. (cond ((eq element 'signature-file) @@ -1918,49 +1917,51 @@ this is a reply." (add-hook 'message-setup-hook (cond ((eq 'eval (car result)) - 'ignore) + #'ignore) ((eq 'body (car result)) - `(lambda () - (save-excursion - (message-goto-body) - (insert ,(cdr result))))) + (let ((txt (cdr result))) + (lambda () + (save-excursion + (message-goto-body) + (insert txt))))) ((eq 'signature (car result)) (setq-local message-signature nil) (setq-local message-signature-file nil) - (if (not (cdr result)) - 'ignore - `(lambda () - (save-excursion - (let ((message-signature ,(cdr result))) - (when message-signature - (message-insert-signature))))))) + (let ((txt (cdr result))) + (if (not txt) + #'ignore + (lambda () + (save-excursion + (let ((message-signature txt)) + (when message-signature + (message-insert-signature)))))))) (t (let ((header (if (symbolp (car result)) (capitalize (symbol-name (car result))) - (car result)))) - `(lambda () - (save-excursion - (message-remove-header ,header) - (let ((value ,(cdr result))) - (when value - (message-goto-eoh) - (insert ,header ": " value) - (unless (bolp) - (insert "\n"))))))))) + (car result))) + (value (cdr result))) + (lambda () + (save-excursion + (message-remove-header header) + (when value + (message-goto-eoh) + (insert header ": " value) + (unless (bolp) + (insert "\n")))))))) nil 'local)) (when (or name address) (add-hook 'message-setup-hook - `(lambda () - (setq-local user-mail-address - ,(or (cdr address) user-mail-address)) - (let ((user-full-name ,(or (cdr name) (user-full-name))) - (user-mail-address - ,(or (cdr address) user-mail-address))) - (save-excursion - (message-remove-header "From") - (message-goto-eoh) - (insert "From: " (message-make-from) "\n")))) + (let ((name (or (cdr name) (user-full-name))) + (email (or (cdr address) user-mail-address))) + (lambda () + (setq-local user-mail-address email) + (let ((user-full-name name) + (user-mail-address email)) + (save-excursion + (message-remove-header "From") + (message-goto-eoh) + (insert "From: " (message-make-from) "\n"))))) nil 'local))))) (defun gnus-summary-attach-article (n) diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index e772dd8e625..a4d198b46e4 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -1,4 +1,4 @@ -;; gnus-notifications.el -- Send notification on new message in Gnus +;; gnus-notifications.el -- Send notification on new message in Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2021 Free Software Foundation, Inc. @@ -24,7 +24,7 @@ ;; This implements notifications using `notifications-notify' on new ;; messages received. -;; Use (add-hook 'gnus-after-getting-new-news-hook 'gnus-notifications) +;; Use (add-hook 'gnus-after-getting-new-news-hook #'gnus-notifications) ;; to get notifications just after getting the new news. ;;; Code: @@ -47,26 +47,22 @@ (defcustom gnus-notifications-use-google-contacts t "Use Google Contacts to retrieve photo." - :type 'boolean - :group 'gnus-notifications) + :type 'boolean) (defcustom gnus-notifications-use-gravatar t "Use Gravatar to retrieve photo." - :type 'boolean - :group 'gnus-notifications) + :type 'boolean) (defcustom gnus-notifications-minimum-level 1 "Minimum group level the message should have to be notified. Any message in a group that has a greater value than this will not get notifications." - :type 'integer - :group 'gnus-notifications) + :type 'integer) (defcustom gnus-notifications-timeout nil "Timeout used for notifications sent via `notifications-notify'." :type '(choice (const :tag "Server default" nil) - (integer :tag "Milliseconds")) - :group 'gnus-notifications) + (integer :tag "Milliseconds"))) (defvar gnus-notifications-sent nil "Notifications already sent.") diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index 92def9a72d0..7927b88c3de 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -1,4 +1,4 @@ -;;; gnus-picon.el --- displaying pretty icons in Gnus +;;; gnus-picon.el --- displaying pretty icons in Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. @@ -112,7 +112,7 @@ List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.") (let* ((address (gnus-picon-split-address address)) (user (pop address)) (faddress address) - database directory result instance base) + result base) ;; database directory instance (catch 'found (dolist (database gnus-picon-databases) (dolist (directory directories) @@ -120,7 +120,7 @@ List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.") base (expand-file-name directory database)) (while address (when (setq result (gnus-picon-find-image - (concat base "/" (mapconcat 'downcase + (concat base "/" (mapconcat #'downcase (reverse address) "/") "/" (downcase user) "/"))) @@ -158,7 +158,7 @@ replacement is added." (defun gnus-picon-create-glyph (file) (or (cdr (assoc file gnus-picon-glyph-alist)) - (cdar (push (cons file (apply 'gnus-create-image + (cdar (push (cons file (apply #'gnus-create-image file nil nil gnus-picon-properties)) gnus-picon-glyph-alist)))) @@ -190,7 +190,7 @@ replacement is added." (gnus-picon-find-face (concat "unknown@" (mapconcat - 'identity (cdr spec) ".")) + #'identity (cdr spec) ".")) gnus-picon-user-directories))) (setcar spec (cons (gnus-picon-create-glyph file) (car spec)))) @@ -201,7 +201,7 @@ replacement is added." (when (setq file (gnus-picon-find-face (concat "unknown@" (mapconcat - 'identity (nthcdr (1+ i) spec) ".")) + #'identity (nthcdr (1+ i) spec) ".")) gnus-picon-domain-directories t)) (setcar (nthcdr (1+ i) spec) (cons (gnus-picon-create-glyph file) @@ -214,10 +214,11 @@ replacement is added." (cl-case gnus-picon-style (right (when (= (length addresses) 1) - (setq len (apply '+ (mapcar (lambda (x) - (condition-case nil - (car (image-size (car x))) - (error 0))) spec))) + (setq len (apply #'+ (mapcar (lambda (x) + (condition-case nil + (car (image-size (car x))) + (error 0))) + spec))) (when (> len 0) (goto-char (point-at-eol)) (insert (propertize @@ -248,7 +249,7 @@ replacement is added." (gnus-article-goto-header header) (mail-header-narrow-to-field) (let ((groups (message-tokenize-header (mail-fetch-field header))) - spec file point) + spec file) ;; point (dolist (group groups) (unless (setq spec (cdr (assoc group gnus-picon-cache))) (setq spec (nreverse (split-string group "[.]"))) @@ -256,7 +257,7 @@ replacement is added." (when (setq file (gnus-picon-find-face (concat "unknown@" (mapconcat - 'identity (nthcdr i spec) ".")) + #'identity (nthcdr i spec) ".")) gnus-picon-news-directories t)) (setcar (nthcdr i spec) (cons (gnus-picon-create-glyph file) diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el index 1e5d2a066f6..6cc60cb49b3 100644 --- a/lisp/gnus/gnus-range.el +++ b/lisp/gnus/gnus-range.el @@ -1,4 +1,4 @@ -;;; gnus-range.el --- range and sequence functions for Gnus +;;; gnus-range.el --- range and sequence functions for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. @@ -87,7 +87,7 @@ Both ranges must be in ascending order." (setq range2 (gnus-range-normalize range2)) (let* ((new-range (cons nil (copy-sequence range1))) (r new-range) - (safe t)) + ) ;; (safe t) (while (cdr r) (let* ((r1 (cadr r)) (r2 (car range2)) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 068066e38c9..147550d8cf3 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -131,7 +131,6 @@ display.") (defcustom gnus-registry-default-mark 'To-Do "The default mark. Should be a valid key for `gnus-registry-marks'." - :group 'gnus-registry :type 'symbol) (defcustom gnus-registry-unfollowed-addresses @@ -141,7 +140,6 @@ The addresses are matched, they don't have to be fully qualified. In the messages, these addresses can be the sender or the recipients." :version "24.1" - :group 'gnus-registry :type '(repeat regexp)) (defcustom gnus-registry-unfollowed-groups @@ -153,12 +151,10 @@ message into a group that matches one of these, regardless of references.' nnmairix groups are specifically excluded because they are ephemeral." - :group 'gnus-registry :type '(repeat regexp)) (defcustom gnus-registry-install 'ask "Whether the registry should be installed." - :group 'gnus-registry :type '(choice (const :tag "Never Install" nil) (const :tag "Always Install" t) (const :tag "Ask Me" ask))) @@ -181,7 +177,6 @@ nnmairix groups are specifically excluded because they are ephemeral." "Whether the registry should track extra data about a message. The subject, recipients (To: and Cc:), and Sender (From:) headers are tracked this way by default." - :group 'gnus-registry :type '(set :tag "Tracking choices" (const :tag "Track by subject (Subject: header)" subject) @@ -205,7 +200,6 @@ This is the slowest strategy but also the most accurate one. When `first', the first element of G wins. This is fast and should be OK if your senders and subjects don't \"bleed\" across groups." - :group 'gnus-registry :type '(choice :tag "Splitting strategy" (const :tag "Only use single choices, discard multiple matches" nil) @@ -214,7 +208,6 @@ groups." (defcustom gnus-registry-minimum-subject-length 5 "The minimum length of a subject before it's considered trackable." - :group 'gnus-registry :type 'integer) (defcustom gnus-registry-extra-entries-precious '(mark) @@ -225,20 +218,18 @@ considered precious. Before you save the Gnus registry, it's pruned. Any entries with keys in this list will not be pruned. All other entries go to the Bit Bucket." - :group 'gnus-registry :type '(repeat symbol)) (defcustom gnus-registry-cache-file + ;; FIXME: Use `locate-user-emacs-file'! (nnheader-concat (or gnus-dribble-directory gnus-home-directory "~/") ".gnus.registry.eieio") "File where the Gnus registry will be stored." - :group 'gnus-registry :type 'file) (defcustom gnus-registry-max-entries nil "Maximum number of entries in the registry, nil for unlimited." - :group 'gnus-registry :type '(radio (const :format "Unlimited " nil) (integer :format "Maximum number: %v"))) @@ -253,7 +244,6 @@ cut the registry back to \(- 50000 \(* 50000 0.1)) -> 45000 entries. The pruning process is constrained by the presence of \"precious\" entries." :version "25.1" - :group 'gnus-registry :type 'float) (defcustom gnus-registry-default-sort-function @@ -262,7 +252,6 @@ entries. The pruning process is constrained by the presence of Entries that sort to the front of the list are pruned first. This can slow pruning down. Set to nil to perform no sorting." :version "25.1" - :group 'gnus-registry :type '(choice (const :tag "No sorting" nil) function)) (defun gnus-registry-sort-by-creation-time (l r) @@ -891,7 +880,7 @@ Addresses without a name will say \"noname\"." (defun gnus-registry-sort-addresses (&rest addresses) "Return a normalized and sorted list of ADDRESSES." - (sort (mapcan #'gnus-registry-extract-addresses addresses) 'string-lessp)) + (sort (mapcan #'gnus-registry-extract-addresses addresses) #'string-lessp)) (defun gnus-registry-simplify-subject (subject) (if (stringp subject) diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el index 107e96350bb..5697c870888 100644 --- a/lisp/gnus/gnus-rfc1843.el +++ b/lisp/gnus/gnus-rfc1843.el @@ -1,4 +1,4 @@ -;;; gnus-rfc1843.el --- HZ (rfc1843) decoding interface functions for Gnus +;;; gnus-rfc1843.el --- HZ (rfc1843) decoding interface functions for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2021 Free Software Foundation, Inc. @@ -56,11 +56,11 @@ (defun rfc1843-gnus-setup () "Setup HZ decoding for Gnus." - (add-hook 'gnus-article-decode-hook 'rfc1843-decode-article-body t) + (add-hook 'gnus-article-decode-hook #'rfc1843-decode-article-body t) (setq gnus-decode-encoded-word-function - 'gnus-multi-decode-encoded-word-string + #'gnus-multi-decode-encoded-word-string gnus-decode-header-function - 'gnus-multi-decode-header + #'gnus-multi-decode-header gnus-decode-encoded-word-methods (nconc gnus-decode-encoded-word-methods (list diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index abaa844f58a..e222d24b694 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -1,4 +1,4 @@ -;;; gnus-salt.el --- alternate summary mode interfaces for Gnus +;;; gnus-salt.el --- alternate summary mode interfaces for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1996-1999, 2001-2021 Free Software Foundation, Inc. @@ -103,7 +103,7 @@ It accepts the same format specs that `gnus-summary-line-format' does." ((not (derived-mode-p 'gnus-summary-mode)) (setq gnus-pick-mode nil)) ((not gnus-pick-mode) ;; FIXME: a buffer-local minor mode removing globally from a hook?? - (remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)) + (remove-hook 'gnus-message-setup-hook #'gnus-pick-setup-message)) (t ;; Make sure that we don't select any articles upon group entry. (setq-local gnus-auto-select-first nil) @@ -113,7 +113,7 @@ It accepts the same format specs that `gnus-summary-line-format' does." (gnus-update-format-specifications nil 'summary) (gnus-update-summary-mark-positions) ;; FIXME: a buffer-local minor mode adding globally to a hook?? - (add-hook 'gnus-message-setup-hook 'gnus-pick-setup-message) + (add-hook 'gnus-message-setup-hook #'gnus-pick-setup-message) (setq-local gnus-summary-goto-unread 'never) ;; Set up the menu. (when (gnus-visual-p 'pick-menu 'menu) @@ -609,7 +609,7 @@ Two predefined functions are available: beg end) (add-text-properties (setq beg (point)) - (setq end (progn (eval gnus-tree-line-format-spec) (point))) + (setq end (progn (eval gnus-tree-line-format-spec t) (point))) (list 'gnus-number gnus-tmp-number)) (when (or t (gnus-visual-p 'tree-highlight 'highlight)) (gnus-tree-highlight-node gnus-tmp-number beg end)))) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index e74c4980879..ade0897a16a 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -1,4 +1,4 @@ -;;; gnus-score.el --- scoring code for Gnus +;;; gnus-score.el --- scoring code for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -683,7 +683,7 @@ current score file." (and gnus-extra-headers (equal (nth 1 entry) "extra") (intern ; need symbol - (let ((collection (mapcar 'symbol-name gnus-extra-headers))) + (let ((collection (mapcar #'symbol-name gnus-extra-headers))) (gnus-completing-read "Score extra header" ; prompt collection ; completion list @@ -932,7 +932,7 @@ SCORE is the score to add. EXTRA is the possible non-standard header." (interactive (list (gnus-completing-read "Header" (mapcar - 'car + #'car (seq-filter (lambda (x) (fboundp (nth 2 x))) gnus-header-index)) @@ -1235,7 +1235,7 @@ If FORMAT, also format the current score file." (let ((mark (car (gnus-score-get 'mark alist))) (expunge (car (gnus-score-get 'expunge alist))) (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist))) - (score-fn (car (gnus-score-get 'score-fn alist))) + ;; (score-fn (car (gnus-score-get 'score-fn alist))) (files (gnus-score-get 'files alist)) (exclude-files (gnus-score-get 'exclude-files alist)) (orphan (car (gnus-score-get 'orphan alist))) @@ -1258,17 +1258,17 @@ If FORMAT, also format the current score file." ;; We do not respect eval and files atoms from global score ;; files. (when (and files (not global)) - (setq lists (apply 'append lists - (mapcar 'gnus-score-load-file + (setq lists (apply #'append lists + (mapcar #'gnus-score-load-file (if adapt-file (cons adapt-file files) files))))) (when (and eval (not global)) - (eval eval)) + (eval eval t)) ;; We then expand any exclude-file directives. (setq gnus-scores-exclude-files (nconc (apply - 'nconc + #'nconc (mapcar (lambda (sfile) (list @@ -1554,10 +1554,10 @@ If FORMAT, also format the current score file." (setq entry (pop entries) header (nth 0 entry) gnus-score-index (nth 1 (assoc header gnus-header-index))) - (when (< 0 (apply 'max (mapcar - (lambda (score) - (length (gnus-score-get header score))) - scores))) + (when (< 0 (apply #'max (mapcar + (lambda (score) + (length (gnus-score-get header score))) + scores))) (when (if (and gnus-inhibit-slow-scoring (or (eq gnus-inhibit-slow-scoring t) (and (stringp gnus-inhibit-slow-scoring) @@ -1574,9 +1574,9 @@ If FORMAT, also format the current score file." ;; Run score-fn (if (eq header 'score-fn) (setq new (gnus-score-func scores trace)) - ;; Call the scoring function for this type of "header". - (setq new (funcall (nth 2 entry) scores header - now expire trace)))) + ;; Call the scoring function for this type of "header". + (setq new (funcall (nth 2 entry) scores header + now expire trace)))) (push new news)))) (when (gnus-buffer-live-p gnus-summary-buffer) @@ -1818,45 +1818,44 @@ score in `gnus-newsgroup-scored' by SCORE." handles)))) (defun gnus-score-body (scores header now expire &optional trace) - (if gnus-agent-fetching - nil - (save-excursion - (setq gnus-scores-articles - (sort gnus-scores-articles - (lambda (a1 a2) - (< (mail-header-number (car a1)) - (mail-header-number (car a2)))))) - (set-buffer nntp-server-buffer) - (save-restriction - (let* ((buffer-read-only nil) - (articles gnus-scores-articles) - (all-scores scores) - (request-func (cond ((string= "head" header) - 'gnus-request-head) - ((string= "body" header) - 'gnus-request-body) - (t 'gnus-request-article))) - entries alist ofunc article last) - (when articles - (setq last (mail-header-number (caar (last articles)))) - ;; Not all backends support partial fetching. In that case, - ;; we just fetch the entire article. - ;; When scoring by body, we need to peek at the headers to detect - ;; the content encoding - (unless (or (gnus-check-backend-function - (and (string-match "^gnus-" (symbol-name request-func)) - (intern (substring (symbol-name request-func) - (match-end 0)))) - gnus-newsgroup-name) - (string= "body" header)) - (setq ofunc request-func) - (setq request-func 'gnus-request-article)) - (while articles - (setq article (mail-header-number (caar articles))) - (gnus-message 7 "Scoring article %s of %s..." article last) - (widen) - (let (handles) - (when (funcall request-func article gnus-newsgroup-name) + (if gnus-agent-fetching + nil + (setq gnus-scores-articles + (sort gnus-scores-articles + (lambda (a1 a2) + (< (mail-header-number (car a1)) + (mail-header-number (car a2)))))) + (with-current-buffer nntp-server-buffer + (save-restriction + (let* ((buffer-read-only nil) + (articles gnus-scores-articles) + (all-scores scores) + (request-func (cond ((string= "head" header) + 'gnus-request-head) + ((string= "body" header) + 'gnus-request-body) + (t 'gnus-request-article))) + entries alist ofunc article last) + (when articles + (setq last (mail-header-number (caar (last articles)))) + ;; Not all backends support partial fetching. In that case, + ;; we just fetch the entire article. + ;; When scoring by body, we need to peek at the headers to detect + ;; the content encoding + (unless (or (gnus-check-backend-function + (and (string-match "^gnus-" (symbol-name request-func)) + (intern (substring (symbol-name request-func) + (match-end 0)))) + gnus-newsgroup-name) + (string= "body" header)) + (setq ofunc request-func) + (setq request-func 'gnus-request-article)) + (while articles + (setq article (mail-header-number (caar articles))) + (gnus-message 7 "Scoring article %s of %s..." article last) + (widen) + (let (handles) + (when (funcall request-func article gnus-newsgroup-name) (when (string= "body" header) (setq handles (gnus-score-decode-text-parts))) (goto-char (point-min)) @@ -1921,8 +1920,8 @@ score in `gnus-newsgroup-scored' by SCORE." (setq rest entries)))) (setq entries rest)))) (when handles (mm-destroy-parts handles)))) - (setq articles (cdr articles))))))) - nil)) + (setq articles (cdr articles))))))) + nil)) (defun gnus-score-thread (scores header now expire &optional trace) (gnus-score-followup scores header now expire trace t)) @@ -1948,7 +1947,7 @@ score in `gnus-newsgroup-scored' by SCORE." gnus-newsgroup-name gnus-adaptive-file-suffix)))) (setq gnus-scores-articles (sort gnus-scores-articles - 'gnus-score-string<) + #'gnus-score-string<) articles gnus-scores-articles) (erase-buffer) @@ -2077,7 +2076,7 @@ score in `gnus-newsgroup-scored' by SCORE." ;; We cannot string-sort the extra headers list. *sigh* (if (= gnus-score-index 9) gnus-scores-articles - (sort gnus-scores-articles 'gnus-score-string<)) + (sort gnus-scores-articles #'gnus-score-string<)) articles gnus-scores-articles) (erase-buffer) @@ -2550,11 +2549,11 @@ score in `gnus-newsgroup-scored' by SCORE." (abbreviate-file-name file)))) (insert (format "\nTotal score: %d" - (apply '+ (mapcar - (lambda (s) - (or (caddr s) - gnus-score-interactive-default-score)) - trace)))) + (apply #'+ (mapcar + (lambda (s) + (or (caddr s) + gnus-score-interactive-default-score)) + trace)))) (insert "\n\nQuick help: @@ -2699,7 +2698,7 @@ the score file and its full name, including the directory.") ;;; Finding score files. -(defun gnus-score-score-files (group) +(defun gnus-score-score-files (_group) "Return a list of all possible score files." ;; Search and set any global score files. (when gnus-global-score-files @@ -2872,7 +2871,7 @@ This includes the score file for the group and all its parents." (mapcar (lambda (group) (gnus-score-file-name group gnus-adaptive-file-suffix)) (setq all (nreverse all))) - (mapcar 'gnus-score-file-name all))) + (mapcar #'gnus-score-file-name all))) (if (equal prefix "") all (mapcar @@ -2912,7 +2911,7 @@ Destroys the current buffer." (lambda (file) (cons (inline (gnus-score-file-rank file)) file)) files))) - (mapcar 'cdr (sort alist 'car-less-than-car))))) + (mapcar #'cdr (sort alist #'car-less-than-car))))) (defun gnus-score-find-alist (group) "Return list of score files for GROUP. diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 44780609af7..d7b1c06114b 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -4,18 +4,20 @@ ;; Author: Eric Abrahamsen <eric@ericabrahamsen.net> -;; This program is free software; you can redistribute it and/or modify +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -123,8 +125,7 @@ If this option is set to nil, search queries will be passed directly to the search engines without being parsed or transformed." :version "28.1" - :type 'boolean - :group 'gnus-search) + :type 'boolean) (define-obsolete-variable-alias 'nnir-ignored-newsgroups 'gnus-search-ignored-newsgroups "28.1") @@ -133,8 +134,7 @@ transformed." "A regexp to match newsgroups in the active file that should be skipped when searching." :version "24.1" - :type 'regexp - :group 'gnus-search) + :type 'regexp) (make-obsolete-variable 'nnir-imap-default-search-key @@ -146,14 +146,12 @@ transformed." (expand-file-name "~/Mail/swish++.conf") "Location of Swish++ configuration file. This variable can also be set per-server." - :type 'file - :group 'gnus-search) + :type 'file) (defcustom gnus-search-swish++-program "search" "Name of swish++ search executable. This variable can also be set per-server." - :type 'string - :group 'gnus-search) + :type 'string) (defcustom gnus-search-swish++-switches '() "A list of strings, to be given as additional arguments to swish++. @@ -163,8 +161,7 @@ Instead, use this: (setq gnus-search-swish++-switches \\='(\"-i\" \"-w\")) This variable can also be set per-server." - :type '(repeat string) - :group 'gnus-search) + :type '(repeat string)) (defcustom gnus-search-swish++-remove-prefix (concat (getenv "HOME") "/Mail/") "The prefix to remove from each file name returned by swish++ @@ -172,30 +169,26 @@ in order to get a group name (albeit with / instead of .). This is a regular expression. This variable can also be set per-server." - :type 'regexp - :group 'gnus-search) + :type 'regexp) (defcustom gnus-search-swish++-raw-queries-p nil "If t, all Swish++ engines will only accept raw search query strings." :type 'boolean - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-swish-e-config-file (expand-file-name "~/Mail/swish-e.conf") "Configuration file for swish-e. This variable can also be set per-server." :type 'file - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-swish-e-program "search" "Name of swish-e search executable. This variable can also be set per-server." :type 'string - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-swish-e-switches '() "A list of strings, to be given as additional arguments to swish-e. @@ -206,8 +199,7 @@ Instead, use this: This variable can also be set per-server." :type '(repeat string) - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/") "The prefix to remove from each file name returned by swish-e @@ -216,22 +208,19 @@ regular expression. This variable can also be set per-server." :type 'regexp - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-swish-e-index-files '() "A list of index files to use with this Swish-e instance. This variable can also be set per-server." :type '(repeat file) - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-swish-e-raw-queries-p nil "If t, all Swish-e engines will only accept raw search query strings." :type 'boolean - :version "28.1" - :group 'gnus-search) + :version "28.1") ;; Namazu engine, see <URL:http://www.namazu.org/> @@ -239,15 +228,13 @@ This variable can also be set per-server." "Name of Namazu search executable. This variable can also be set per-server." :type 'string - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-namazu-index-directory (expand-file-name "~/Mail/namazu/") "Index directory for Namazu. This variable can also be set per-server." :type 'directory - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-namazu-switches '() "A list of strings, to be given as additional arguments to namazu. @@ -261,8 +248,7 @@ Instead, use this: This variable can also be set per-server." :type '(repeat string) - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-namazu-remove-prefix (concat (getenv "HOME") "/Mail/") "The prefix to remove from each file name returned by Namazu @@ -277,30 +263,26 @@ arrive at the correct group name, \"mail.misc\". This variable can also be set per-server." :type 'directory - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-namazu-raw-queries-p nil "If t, all Namazu engines will only accept raw search query strings." :type 'boolean - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-notmuch-program "notmuch" "Name of notmuch search executable. This variable can also be set per-server." :type '(string) - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-notmuch-config-file (expand-file-name "~/.notmuch-config") "Configuration file for notmuch. This variable can also be set per-server." :type 'file - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-notmuch-switches '() "A list of strings, to be given as additional arguments to notmuch. @@ -311,8 +293,7 @@ Instead, use this: This variable can also be set per-server." :type '(repeat string) - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-notmuch-remove-prefix (concat (getenv "HOME") "/Mail/") "The prefix to remove from each file name returned by notmuch @@ -321,37 +302,32 @@ regular expression. This variable can also be set per-server." :type 'regexp - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-notmuch-raw-queries-p nil "If t, all Notmuch engines will only accept raw search query strings." :type 'boolean - :version "28.1" - :group 'gnus-search) + :version "28.1") (defcustom gnus-search-imap-raw-queries-p nil "If t, all IMAP engines will only accept raw search query strings." :version "28.1" - :type 'boolean - :group 'gnus-search) + :type 'boolean) (defcustom gnus-search-mairix-program "mairix" "Name of mairix search executable. This variable can also be set per-server." :version "28.1" - :type 'string - :group 'gnus-search) + :type 'string) (defcustom gnus-search-mairix-config-file (expand-file-name "~/.mairixrc") "Configuration file for mairix. This variable can also be set per-server." :version "28.1" - :type 'file - :group 'gnus-search) + :type 'file) (defcustom gnus-search-mairix-switches '() "A list of strings, to be given as additional arguments to mairix. @@ -362,8 +338,7 @@ Instead, use this: This variable can also be set per-server." :version "28.1" - :type '(repeat string) - :group 'gnus-search) + :type '(repeat string)) (defcustom gnus-search-mairix-remove-prefix (concat (getenv "HOME") "/Mail/") "The prefix to remove from each file name returned by mairix @@ -372,15 +347,13 @@ regular expression. This variable can also be set per-server." :version "28.1" - :type 'regexp - :group 'gnus-search) + :type 'regexp) (defcustom gnus-search-mairix-raw-queries-p nil "If t, all Mairix engines will only accept raw search query strings." :version "28.1" - :type 'boolean - :group 'gnus-search) + :type 'boolean) ;; Options for search language parsing. @@ -396,7 +369,6 @@ typing in search queries, ie \"subject\" could be entered as \"subject\" and \"since\". Ambiguous abbreviations will raise an error." - :group 'gnus-search :version "28.1" :type '(repeat string)) @@ -405,7 +377,6 @@ Ambiguous abbreviations will raise an error." "A list of keywords whose value should be parsed as a date. See the docstring of `gnus-search-parse-query' for information on date parsing." - :group 'gnus-search :version "26.1" :type '(repeat string)) @@ -414,7 +385,6 @@ date parsing." Each list element should be a table or collection suitable to be returned by `completion-at-point-functions'. That usually means a list of strings, a hash table, or an alist." - :group 'gnus-search :version "28.1" :type '(repeat sexp)) @@ -939,7 +909,6 @@ quirks.") (defcustom gnus-search-default-engines '((nnimap . gnus-search-imap)) "Alist of default search engines keyed by server method." :version "26.1" - :group 'gnus-search :type `(repeat (cons (choice (const nnimap) (const nntp) (const nnspool) (const nneething) (const nndir) (const nnmbox) (const nnml) (const nnmh) (const nndraft) @@ -1073,7 +1042,7 @@ Responsible for handling and, or, and parenthetical expressions.") ;; A bit of backward-compatibility slash convenience: if the ;; query string doesn't start with any known IMAP search ;; keyword, assume it is a "TEXT" search. - (unless (or (looking-at "(") + (unless (or (eql ?\( (aref q-string 0)) (and (string-match "\\`[^[:blank:]]+" q-string) (memql (intern-soft (downcase (match-string 0 q-string))) @@ -1379,12 +1348,14 @@ Returns a list of [group article score] vectors." (let ((prefix (slot-value engine 'remove-prefix)) (group-regexp (when groups (mapconcat - (lambda (x) - (replace-regexp-in-string - ;; Accept any of [.\/] as path separators. - "[.\\/]" "[.\\\\/]" - (gnus-group-real-name x))) - groups "\\|"))) + (lambda (group-name) + (mapconcat #'regexp-quote + (split-string + (gnus-group-real-name group-name) + "[.\\/]") + "[.\\\\/]")) + groups + "\\|"))) artlist vectors article group) (goto-char (point-min)) (while (not (eobp)) @@ -1547,6 +1518,7 @@ Namazu provides a little more information, for instance a score." (when (re-search-forward "^\\([0-9,]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)" nil t) + (forward-line 1) (list (match-string 4) (match-string 3)))) @@ -1859,7 +1831,7 @@ Assume \"size\" key is equal to \"larger\"." "No directory found in definition of server %s" server)))) (apply - 'vconcat + #'vconcat (mapcar (lambda (x) (let ((group x) artlist) @@ -1894,7 +1866,7 @@ Assume \"size\" key is equal to \"larger\"." "Cannot locate directory for group"))) (save-excursion (apply - 'call-process "find" nil t + #'call-process "find" nil t "find" group "-maxdepth" "1" "-type" "f" "-name" "[0-9]*" "-exec" (slot-value engine 'grep-program) @@ -1907,7 +1879,8 @@ Assume \"size\" key is equal to \"larger\"." (let* ((path (split-string (buffer-substring (point) - (line-end-position)) "/" t)) + (line-end-position)) + "/" t)) (art (string-to-number (car (last path))))) (while (string= "." (car path)) (setq path (cdr path))) diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el index 3b79d578644..5dcd079fb48 100644 --- a/lisp/gnus/gnus-sieve.el +++ b/lisp/gnus/gnus-sieve.el @@ -1,4 +1,4 @@ -;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus +;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. @@ -40,30 +40,25 @@ (defcustom gnus-sieve-file "~/.sieve" "Path to your Sieve script." - :type 'file - :group 'gnus-sieve) + :type 'file) (defcustom gnus-sieve-region-start "\n## Begin Gnus Sieve Script\n" "Line indicating the start of the autogenerated region in your Sieve script." - :type 'string - :group 'gnus-sieve) + :type 'string) (defcustom gnus-sieve-region-end "\n## End Gnus Sieve Script\n" "Line indicating the end of the autogenerated region in your Sieve script." - :type 'string - :group 'gnus-sieve) + :type 'string) (defcustom gnus-sieve-select-method nil "Which select method we generate the Sieve script for. For example: \"nnimap:mailbox\"" ;; FIXME? gnus-select-method? - :type '(choice (const nil) string) - :group 'gnus-sieve) + :type '(choice (const nil) string)) (defcustom gnus-sieve-crosspost t "Whether the generated Sieve script should do crossposting." - :type 'boolean - :group 'gnus-sieve) + :type 'boolean) (defcustom gnus-sieve-update-shell-command "echo put %f | sieveshell %s" "Shell command to execute after updating your Sieve script. The following @@ -71,8 +66,7 @@ formatting characters are recognized: %f Script's file name (gnus-sieve-file) %s Server name (from gnus-sieve-select-method)" - :type 'string - :group 'gnus-sieve) + :type 'string) ;;;###autoload (defun gnus-sieve-update () @@ -140,7 +134,7 @@ For example: \(gnus-sieve-string-list \\='(\"to\" \"cc\")) => \"[\\\"to\\\", \\\"cc\\\"]\" " - (concat "[\"" (mapconcat 'identity list "\", \"") "\"]")) + (concat "[\"" (mapconcat #'identity list "\", \"") "\"]")) (defun gnus-sieve-test-list (list) "Convert an elisp test list to a Sieve test list. @@ -148,7 +142,7 @@ For example: For example: \(gnus-sieve-test-list \\='((address \"sender\" \"boss@company.com\") (size :over 4K))) => \"(address \\\"sender\\\" \\\"boss@company.com\\\", size :over 4K)\"" - (concat "(" (mapconcat 'gnus-sieve-test list ", ") ")")) + (concat "(" (mapconcat #'gnus-sieve-test list ", ") ")")) ;; FIXME: do proper quoting (defun gnus-sieve-test-token (token) @@ -189,7 +183,7 @@ For example: (size :over 100K)))) => \"anyof (header :contains [\\\"to\\\", \\\"cc\\\"] \\\"my@address.com\\\", size :over 100K)\"" - (mapconcat 'gnus-sieve-test-token test " ")) + (mapconcat #'gnus-sieve-test-token test " ")) (defun gnus-sieve-script (&optional method crosspost) "Generate a Sieve script based on groups with select method METHOD @@ -228,7 +222,7 @@ This is returned as a string." "\tstop;\n") "}") script))))) - (mapconcat 'identity script "\n"))) + (mapconcat #'identity script "\n"))) (provide 'gnus-sieve) diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index a5228551396..cb60108ea9c 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -1,4 +1,4 @@ -;;; gnus-spec.el --- format spec functions for Gnus +;;; gnus-spec.el --- format spec functions for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. @@ -146,14 +146,14 @@ Return a list of updated types." (while (setq type (pop types)) ;; Jump to the proper buffer to find out the value of the ;; variable, if possible. (It may be buffer-local.) - (save-excursion + (save-current-buffer (let ((buffer (intern (format "gnus-%s-buffer" type)))) (when (and (boundp buffer) (setq val (symbol-value buffer)) (gnus-buffer-live-p val)) - (set-buffer val)) - (setq new-format (symbol-value - (intern (format "gnus-%s-line-format" type))))) + (set-buffer val))) + (setq new-format (symbol-value + (intern (format "gnus-%s-line-format" type)))) (setq entry (cdr (assq type gnus-format-specs))) (if (and (car entry) (equal (car entry) new-format)) @@ -170,7 +170,7 @@ Return a list of updated types." new-format (symbol-value (intern (format "gnus-%s-line-format-alist" type))) - (not (string-match "mode$" (symbol-name type)))))) + (not (string-match "mode\\'" (symbol-name type)))))) ;; Enter the new format spec into the list. (if entry (progn @@ -526,13 +526,13 @@ or to characters when given a pad value." (if (eq spec ?%) ;; "%%" just results in a "%". (insert "%") - (cond - ;; Do tilde forms. - ((eq spec ?@) - (setq elem (list tilde-form ?s))) - ;; Treat user defined format specifiers specially. - (user-defined - (setq elem + (setq elem + (cond + ;; Do tilde forms. + ((eq spec ?@) + (list tilde-form ?s)) + ;; Treat user defined format specifiers specially. + (user-defined (list (list (intern (format (if (stringp user-defined) @@ -540,14 +540,14 @@ or to characters when given a pad value." "gnus-user-format-function-%c") user-defined)) 'gnus-tmp-header) - ?s))) - ;; Find the specification from `spec-alist'. - ((setq elem (cdr (assq (or extended-spec spec) spec-alist)))) - ;; We used to use "%l" for displaying the grouplens score. - ((eq spec ?l) - (setq elem '("" ?s))) - (t - (setq elem '("*" ?s)))) + ?s)) + ;; Find the specification from `spec-alist'. + ((cdr (assq (or extended-spec spec) spec-alist))) + ;; We used to use "%l" for displaying the grouplens score. + ((eq spec ?l) + '("" ?s)) + (t + '("*" ?s)))) (setq elem-type (cadr elem)) ;; Insert the new format elements. (when pad-width @@ -628,8 +628,8 @@ or to characters when given a pad value." If PROPS, insert the result." (let ((form (gnus-parse-format format alist props))) (if props - (add-text-properties (point) (progn (eval form) (point)) props) - (eval form)))) + (add-text-properties (point) (progn (eval form t) (point)) props) + (eval form t)))) (defun gnus-set-format (type &optional insertable) (set (intern (format "gnus-%s-line-format-spec" type)) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 34e5ceb3f67..a305e343f69 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -1,4 +1,4 @@ -;;; gnus-srvr.el --- virtual server support for Gnus +;;; gnus-srvr.el --- virtual server support for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -297,7 +297,7 @@ The following commands are available: (point) (prog1 (1+ (point)) ;; Insert the text. - (eval gnus-server-line-format-spec)) + (eval gnus-server-line-format-spec t)) (list 'gnus-server (intern gnus-tmp-name) 'gnus-named-server (intern (gnus-method-to-server method t)))))) @@ -581,7 +581,7 @@ The following commands are available: (defun gnus-server-add-server (how where) (interactive (list (intern (gnus-completing-read "Server method" - (mapcar 'car gnus-valid-select-methods) + (mapcar #'car gnus-valid-select-methods) t)) (read-string "Server name: "))) (when (assq where gnus-server-alist) @@ -592,7 +592,8 @@ The following commands are available: (defun gnus-server-goto-server (server) "Jump to a server line." (interactive - (list (gnus-completing-read "Goto server" (mapcar 'car gnus-server-alist) t))) + (list (gnus-completing-read "Goto server" + (mapcar #'car gnus-server-alist) t))) (let ((to (text-property-any (point-min) (point-max) 'gnus-server (intern server)))) (when to @@ -611,10 +612,10 @@ The following commands are available: (gnus-close-server info) (gnus-edit-form info "Editing the server." - `(lambda (form) - (gnus-server-set-info ,server form) - (gnus-server-list-servers) - (gnus-server-position-point)) + (lambda (form) + (gnus-server-set-info server form) + (gnus-server-list-servers) + (gnus-server-position-point)) 'edit-server))) (defun gnus-server-show-server (server) @@ -625,7 +626,7 @@ The following commands are available: (let ((info (gnus-server-to-method server))) (gnus-edit-form info "Showing the server." - (lambda (form) + (lambda (_form) (gnus-server-position-point)) 'edit-server))) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index cf37a1ccdfc..1554635a3f2 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -259,7 +259,7 @@ not match this regexp will be removed before saving the list." regexp)) (defcustom gnus-ignored-newsgroups - (mapconcat 'identity + (mapconcat #'identity '("^to\\." ; not "real" groups "^[0-9. \t]+\\( \\|$\\)" ; all digits in name "^[\"][\"#'()]" ; bogus characters @@ -518,7 +518,7 @@ Can be used to turn version control on or off." ;; For subscribing new newsgroup (defun gnus-subscribe-hierarchical-interactive (groups) - (let ((groups (sort groups 'string<)) + (let ((groups (sort groups #'string<)) prefixes prefix start ans group starts) (while groups (setq prefixes (list "^")) @@ -843,8 +843,7 @@ prompt the user for the name of an NNTP server to use." If REGEXP is given, lines that match it will be deleted." (when (and (not gnus-dribble-ignore) (buffer-live-p gnus-dribble-buffer)) - (let ((obuf (current-buffer))) - (set-buffer gnus-dribble-buffer) + (with-current-buffer gnus-dribble-buffer (when regexp (goto-char (point-min)) (let (end) @@ -859,8 +858,7 @@ If REGEXP is given, lines that match it will be deleted." (insert (replace-regexp-in-string "\n" "\\\\n" string) "\n") (bury-buffer gnus-dribble-buffer) (with-current-buffer gnus-group-buffer - (gnus-group-set-mode-line)) - (set-buffer obuf)))) + (gnus-group-set-mode-line))))) (defun gnus-dribble-touch () "Touch the dribble buffer." @@ -916,9 +914,8 @@ If REGEXP is given, lines that match it will be deleted." (defun gnus-dribble-eval-file () (when gnus-dribble-eval-file (setq gnus-dribble-eval-file nil) - (save-excursion - (let ((gnus-dribble-ignore t)) - (set-buffer gnus-dribble-buffer) + (let ((gnus-dribble-ignore t)) + (with-current-buffer gnus-dribble-buffer (eval-buffer (current-buffer)))))) (defun gnus-dribble-delete-file () @@ -1187,10 +1184,9 @@ for new groups, and subscribe the new groups as zombies." gnus-override-subscribe-method method) (when (and (gnus-check-server method) (gnus-request-newgroups date method)) - (save-excursion - (setq got-new t - hashtb (gnus-make-hashtable 100)) - (set-buffer nntp-server-buffer) + (setq got-new t + hashtb (gnus-make-hashtable 100)) + (with-current-buffer nntp-server-buffer ;; Enter all the new groups into a hashtable. (gnus-active-to-gnus-format method hashtb 'ignore)) ;; Now all new groups from `method' are in `hashtb'. @@ -2250,9 +2246,8 @@ If FORCE is non-nil, the .newsrc file is read." ;; can find there for changing the data already read - ;; i. e., reading the .newsrc file will not trash the data ;; already read (except for read articles). - (save-excursion - (gnus-message 5 "Reading %s..." newsrc-file) - (set-buffer (nnheader-find-file-noselect newsrc-file)) + (gnus-message 5 "Reading %s..." newsrc-file) + (with-current-buffer (nnheader-find-file-noselect newsrc-file) (buffer-disable-undo) (gnus-newsrc-to-gnus-format) (kill-buffer (current-buffer)) @@ -2342,7 +2337,7 @@ If FORCE is non-nil, the .newsrc file is read." gnus-newsrc-file-version gnus-version))))))) (defun gnus-convert-mark-converter-prompt (converter no-prompt) - "Indicate whether CONVERTER requires gnus-convert-old-newsrc to + "Indicate whether CONVERTER requires `gnus-convert-old-newsrc' to display the conversion prompt. NO-PROMPT may be nil (prompt), t (no prompt), or any form that can be called as a function. The form should return either t or nil." @@ -2994,13 +2989,12 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'." ;;; Child functions. ;;; -(defvar gnus-child-mode nil) +;; (defvar gnus-child-mode nil) (defun gnus-child-mode () "Minor mode for child Gnusae." - ;; FIXME: gnus-child-mode appears to never be set (i.e. it'll always be nil): - ;; Remove, or fix and use define-minor-mode. - (add-minor-mode 'gnus-child-mode " Child" (make-sparse-keymap)) + ;; FIXME: gnus-child-mode appears to never be set (i.e. it'll always be nil). + ;; (add-minor-mode 'gnus-child-mode " Child" (make-sparse-keymap)) (gnus-run-hooks 'gnus-child-mode-hook)) (define-obsolete-function-alias 'gnus-slave-mode #'gnus-child-mode "28.1") @@ -3102,50 +3096,49 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'." (gnus-message 1 "Couldn't read newsgroups descriptions") nil) (t - (save-excursion - ;; FIXME: Shouldn't save-restriction be done after set-buffer? - (save-restriction - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (or (search-forward "\n.\n" nil t) - (goto-char (point-max))) - (beginning-of-line) - (narrow-to-region (point-min) (point))) - ;; If these are groups from a foreign select method, we insert the - ;; group prefix in front of the group names. - (and method (not (inline - (gnus-server-equal - (gnus-server-get-method nil method) - (gnus-server-get-method - nil gnus-select-method)))) - (let ((prefix (gnus-group-prefixed-name "" method))) - (goto-char (point-min)) - (while (and (not (eobp)) - (progn (insert prefix) - (zerop (forward-line 1))))))) - (goto-char (point-min)) - (while (not (eobp)) - (setq group - (condition-case () - (read nntp-server-buffer) - (error nil))) - (skip-chars-forward " \t") - (when group - (setq group (if (numberp group) - (number-to-string group) - (symbol-name group))) - (let* ((str (buffer-substring - (point) (progn (end-of-line) (point)))) - (charset - (or (gnus-group-name-charset method group) - (gnus-parameter-charset group) - gnus-default-charset))) - ;; Fixme: Don't decode in unibyte mode. - ;; Double fixme: We're not in unibyte mode, are we? - (when (and str charset) - (setq str (decode-coding-string str charset))) - (puthash group str gnus-description-hashtb))) - (forward-line 1)))) + (with-current-buffer nntp-server-buffer + (save-excursion ;;FIXME: Not sure if it's needed! + (save-restriction + (goto-char (point-min)) + (when (or (search-forward "\n.\n" nil t) + (goto-char (point-max))) + (beginning-of-line) + (narrow-to-region (point-min) (point))) + ;; If these are groups from a foreign select method, we insert the + ;; group prefix in front of the group names. + (and method (not (inline + (gnus-server-equal + (gnus-server-get-method nil method) + (gnus-server-get-method + nil gnus-select-method)))) + (let ((prefix (gnus-group-prefixed-name "" method))) + (goto-char (point-min)) + (while (and (not (eobp)) + (progn (insert prefix) + (zerop (forward-line 1))))))) + (goto-char (point-min)) + (while (not (eobp)) + (setq group + (condition-case () + (read nntp-server-buffer) + (error nil))) + (skip-chars-forward " \t") + (when group + (setq group (if (numberp group) + (number-to-string group) + (symbol-name group))) + (let* ((str (buffer-substring + (point) (progn (end-of-line) (point)))) + (charset + (or (gnus-group-name-charset method group) + (gnus-parameter-charset group) + gnus-default-charset))) + ;; Fixme: Don't decode in unibyte mode. + ;; Double fixme: We're not in unibyte mode, are we? + (when (and str charset) + (setq str (decode-coding-string str charset))) + (puthash group str gnus-description-hashtb))) + (forward-line 1))))) (gnus-message 5 "Reading descriptions file...done") t)))) @@ -3162,7 +3155,7 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'." "Declare back end NAME with ABILITIES as a Gnus back end." (setq gnus-valid-select-methods (nconc gnus-valid-select-methods - (list (apply 'list name abilities)))) + (list (apply #'list name abilities)))) (gnus-redefine-select-method-widget)) (defun gnus-set-default-directory () diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index b0f9ed4c6f0..456e7b0f8c4 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -3186,7 +3186,7 @@ The following commands are available: ;; Copy the global value of the variable. (symbol-value (car local)) ;; Use the value from the list. - (eval (cdr local))))) + (eval (cdr local) t)))) (set (make-local-variable (car local)) global)) ;; Simple nil-valued local variable. (set (make-local-variable local) nil)))) @@ -3339,18 +3339,18 @@ article number." ,(or number (inline-quote (gnus-summary-article-number))))))) -(defmacro gnus-summary-thread-level (&optional number) +(defsubst gnus-summary-thread-level (&optional number) "Return the level of thread that starts with article NUMBER." - `(if (and (eq gnus-summary-make-false-root 'dummy) - (get-text-property (point) 'gnus-intangible)) - 0 - (gnus-data-level (gnus-data-find - ,(or number '(gnus-summary-article-number)))))) + (if (and (eq gnus-summary-make-false-root 'dummy) + (get-text-property (point) 'gnus-intangible)) + 0 + (gnus-data-level (gnus-data-find + (or number (gnus-summary-article-number)))))) -(defmacro gnus-summary-article-mark (&optional number) +(defsubst gnus-summary-article-mark (&optional number) "Return the mark of article NUMBER." - `(gnus-data-mark (gnus-data-find - ,(or number '(gnus-summary-article-number))))) + (gnus-data-mark (gnus-data-find + (or number (gnus-summary-article-number))))) (defmacro gnus-summary-article-pos (&optional number) "Return the position of the line of article NUMBER." @@ -3850,7 +3850,7 @@ buffer that was in action when the last article was fetched." (condition-case () (put-text-property (point) - (progn (eval gnus-summary-line-format-spec) (point)) + (progn (eval gnus-summary-line-format-spec t) (point)) 'gnus-number gnus-tmp-number) (error (gnus-message 5 "Error updating the summary line"))) (when (gnus-visual-p 'summary-highlight 'highlight) @@ -3971,14 +3971,14 @@ Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." (my-format "%b %d '%y")) (let* ((difference (time-subtract now messy-date)) (templist gnus-user-date-format-alist) - (top (eval (caar templist)))) + (top (eval (caar templist) t))) (while (if (numberp top) (time-less-p top difference) (not top)) (progn (setq templist (cdr templist)) - (setq top (eval (caar templist))))) + (setq top (eval (caar templist) t)))) (if (stringp (cdr (car templist))) (setq my-format (cdr (car templist))))) - (format-time-string (eval my-format) messy-date)) + (format-time-string (eval my-format t) messy-date)) (error " ? "))) (defun gnus-summary-set-local-parameters (group) @@ -3997,8 +3997,8 @@ Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." ;; buffer-local, whereas just parameters like `gcc-self', ;; `timestamp', etc. should not be bound as variables. (if (boundp (car elem)) - (set (make-local-variable (car elem)) (eval (nth 1 elem))) - (eval (nth 1 elem)))))))) + (set (make-local-variable (car elem)) (eval (nth 1 elem) t)) + (eval (nth 1 elem) t))))))) (defun gnus-summary-read-group (group &optional show-all no-article kill-buffer no-display backward @@ -5557,7 +5557,7 @@ or a straight list of headers." (setq gnus-tmp-thread thread) (put-text-property (point) - (progn (eval gnus-summary-line-format-spec) (point)) + (progn (eval gnus-summary-line-format-spec t) (point)) 'gnus-number number) (when gnus-visual-p (forward-line -1) @@ -6265,7 +6265,7 @@ If WHERE is `summary', the summary mode line format will be used." "")) bufname-length max-len gnus-tmp-header) ;; passed as argument to any user-format-funcs - (setq mode-string (eval mformat)) + (setq mode-string (eval mformat t)) (setq bufname-length (if (string-match "%b" mode-string) (- (length (buffer-name @@ -7863,7 +7863,7 @@ If BACKWARD, the previous article is selected instead of the next." (switch-to-buffer gnus-group-buffer) (when group (gnus-group-jump-to-group group)) - (eval (cadr (assq key keystrokes))) + (eval (cadr (assq key keystrokes)) t) (setq group (gnus-group-group-name)) (switch-to-buffer obuf)) (setq ended nil)) @@ -10617,6 +10617,8 @@ confirmation before the articles are deleted." (gnus-set-mode-line 'summary) not-deleted)) +(defvar message-options-set-recipient) + (defun gnus-summary-edit-article (&optional arg) "Edit the current article. This will have permanent effect only in mail groups. @@ -10674,31 +10676,32 @@ groups." (setq mml-buffer-list mbl) (setq-local mml-buffer-list mbl1)) (add-hook 'kill-buffer-hook #'mml-destroy-buffers t t)))) - `(lambda (no-highlight) - (let ((mail-parse-charset ',gnus-newsgroup-charset) - (message-options message-options) - (message-options-set-recipient) - (mail-parse-ignored-charsets - ',gnus-newsgroup-ignored-charsets) - (rfc2047-header-encoding-alist - ',(let ((charset (gnus-group-name-charset - (gnus-find-method-for-group - gnus-newsgroup-name) - gnus-newsgroup-name))) - (append (list (cons "Newsgroups" charset) - (cons "Followup-To" charset) - (cons "Xref" charset)) - rfc2047-header-encoding-alist)))) - ,(if (not raw) '(progn - (mml-to-mime) - (mml-destroy-buffers) - (remove-hook 'kill-buffer-hook - #'mml-destroy-buffers t) - (kill-local-variable 'mml-buffer-list))) - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) - ,gnus-summary-buffer no-highlight)))))))) + (let ((charset gnus-newsgroup-charset) + (ign-cs gnus-newsgroup-ignored-charsets) + (hea (let ((charset (gnus-group-name-charset + (gnus-find-method-for-group + gnus-newsgroup-name) + gnus-newsgroup-name))) + (append (list (cons "Newsgroups" charset) + (cons "Followup-To" charset) + (cons "Xref" charset)) + rfc2047-header-encoding-alist))) + (gch (or (mail-header-references gnus-current-headers) "")) + (ro (gnus-group-read-only-p)) + (buf gnus-summary-buffer)) + (lambda (no-highlight) + (let ((mail-parse-charset charset) + (message-options message-options) + (message-options-set-recipient) + (mail-parse-ignored-charsets ign-cs) + (rfc2047-header-encoding-alist hea)) + (unless raw + (mml-to-mime) + (mml-destroy-buffers) + (remove-hook 'kill-buffer-hook + #'mml-destroy-buffers t) + (kill-local-variable 'mml-buffer-list)) + (gnus-summary-edit-article-done gch ro buf no-highlight))))))))) (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit) @@ -12366,7 +12369,7 @@ save those articles instead." ;; Form. (save-restriction (widen) - (setq result (eval match))))) + (setq result (eval match t))))) (setq split-name (cdr method)) (cond ((stringp result) (push (expand-file-name @@ -12956,7 +12959,7 @@ treated as multipart/mixed." (nomove "" nil nil ,keystroke))) (let ((func (gnus-summary-make-marking-command-1 mark (car lway) lway name))) - (setq func (eval func)) + (setq func (eval func t)) (define-key map (nth 4 lway) func))))) (defun gnus-summary-make-marking-command-1 (mark way lway name) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 8a77c532d29..3253b7853dc 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -1,4 +1,4 @@ -;;; gnus-topic.el --- a folding minor mode for Gnus group buffers +;;; gnus-topic.el --- a folding minor mode for Gnus group buffers -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -43,8 +43,7 @@ (defcustom gnus-topic-mode-hook nil "Hook run in topic mode buffers." - :type 'hook - :group 'gnus-topic) + :type 'hook) (defcustom gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n" "Format of topic lines. @@ -61,18 +60,15 @@ with some simple extensions. General format specifiers can also be used. See Info node `(gnus)Formatting Variables'." :link '(custom-manual "(gnus)Formatting Variables") - :type 'string - :group 'gnus-topic) + :type 'string) (defcustom gnus-topic-indent-level 2 "How much each subtopic should be indented." - :type 'integer - :group 'gnus-topic) + :type 'integer) (defcustom gnus-topic-display-empty-topics t "If non-nil, display the topic lines even of topics that have no unread articles." - :type 'boolean - :group 'gnus-topic) + :type 'boolean) ;; Internal variables. @@ -335,7 +331,7 @@ If RECURSIVE is t, return groups in its subtopics too." (setq topology gnus-topic-topology gnus-tmp-topics nil)) (push (caar topology) gnus-tmp-topics) - (mapc 'gnus-topic-list (cdr topology)) + (mapc #'gnus-topic-list (cdr topology)) gnus-tmp-topics) ;;; Topic parameter jazz @@ -386,7 +382,7 @@ inheritance." ;; We probably have lots of nil elements here, so we remove them. ;; Probably faster than doing this "properly". (delq nil (cons group-params-list - (mapcar 'gnus-topic-parameters + (mapcar #'gnus-topic-parameters (gnus-current-topics topic))))) param out params) ;; Now we have all the parameters, so we go through them @@ -445,7 +441,7 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie))) (gnus-group-prepare-flat-list-dead - (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) + (setq gnus-zombie-list (sort gnus-zombie-list #'string<)) gnus-level-zombie ?Z regexp)) @@ -453,7 +449,7 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))) (gnus-group-prepare-flat-list-dead - (setq gnus-killed-list (sort gnus-killed-list 'string<)) + (setq gnus-killed-list (sort gnus-killed-list #'string<)) gnus-level-killed ?K regexp) (when not-in-list (unless gnus-killed-hashtb @@ -631,7 +627,14 @@ articles in the topic and its subtopics." (defun gnus-topic-insert-topic-line (name visiblep shownp level entries &optional unread) + (gnus--\,@ + (let ((vars '(indentation visible name level number-of-groups + total-number-of-articles entries))) + `((with-suppressed-warnings ((lexical ,@vars)) + ,@(mapcar (lambda (s) `(defvar ,s)) vars))))) (let* ((visible (if visiblep "" "...")) + (level level) + (name name) (indentation (make-string (* gnus-topic-indent-level level) ? )) (total-number-of-articles unread) (number-of-groups (length entries)) @@ -644,7 +647,7 @@ articles in the topic and its subtopics." (add-text-properties (point) (prog1 (1+ (point)) - (eval gnus-topic-line-format-spec)) + (eval gnus-topic-line-format-spec t)) (list 'gnus-topic name 'gnus-topic-level level 'gnus-topic-unread unread @@ -841,7 +844,7 @@ articles in the topic and its subtopics." (pop topics))) ;; Go through all living groups and make sure that ;; they belong to some topic. - (let* ((tgroups (apply 'append (mapcar 'cdr gnus-topic-alist))) + (let* ((tgroups (apply #'append (mapcar #'cdr gnus-topic-alist))) (entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist))) (groups (cdr gnus-group-list))) (dolist (group groups) @@ -1128,21 +1131,21 @@ articles in the topic and its subtopics." (when (gnus-visual-p 'topic-menu 'menu) (gnus-topic-make-menu-bar)) (gnus-set-format 'topic t) - (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) + (add-hook 'gnus-group-catchup-group-hook #'gnus-topic-update-topic) (setq-local gnus-group-prepare-function - 'gnus-group-prepare-topics) + #'gnus-group-prepare-topics) (setq-local gnus-group-get-parameter-function - 'gnus-group-topic-parameters) + #'gnus-group-topic-parameters) (setq-local gnus-group-goto-next-group-function - 'gnus-topic-goto-next-group) + #'gnus-topic-goto-next-group) (setq-local gnus-group-indentation-function - 'gnus-topic-group-indentation) + #'gnus-topic-group-indentation) (setq-local gnus-group-update-group-function - 'gnus-topic-update-topics-containing-group) - (setq-local gnus-group-sort-alist-function 'gnus-group-sort-topic) - (setq gnus-group-change-level-function 'gnus-topic-change-level) - (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group) - (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist + #'gnus-topic-update-topics-containing-group) + (setq-local gnus-group-sort-alist-function #'gnus-group-sort-topic) + (setq gnus-group-change-level-function #'gnus-topic-change-level) + (setq gnus-goto-missing-group-function #'gnus-topic-goto-missing-group) + (add-hook 'gnus-check-bogus-groups-hook #'gnus-topic-clean-alist nil 'local) (setq gnus-topology-checked-p nil) ;; We check the topology. @@ -1150,11 +1153,11 @@ articles in the topic and its subtopics." (gnus-topic-check-topology))) ;; Remove topic infestation. (unless gnus-topic-mode - (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) + (remove-hook 'gnus-summary-exit-hook #'gnus-topic-update-topic) (setq gnus-group-change-level-function nil) - (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist) - (setq gnus-group-prepare-function 'gnus-group-prepare-flat) - (setq gnus-group-sort-alist-function 'gnus-group-sort-flat)) + (remove-hook 'gnus-check-bogus-groups-hook #'gnus-topic-clean-alist) + (setq gnus-group-prepare-function #'gnus-group-prepare-flat) + (setq gnus-group-sort-alist-function #'gnus-group-sort-flat)) (when (called-interactively-p 'any) (gnus-group-list-groups)))) @@ -1213,7 +1216,7 @@ Also see `gnus-group-catchup'." (inhibit-read-only t) (gnus-group-marked groups)) (gnus-group-catchup-current) - (mapcar 'gnus-topic-update-topics-containing-group groups))))) + (mapcar #'gnus-topic-update-topics-containing-group groups))))) (defun gnus-topic-read-group (&optional all no-article group) "Read news in this newsgroup. @@ -1280,7 +1283,7 @@ When used interactively, PARENT will be the topic under point." If COPYP, copy the groups instead." (interactive (list current-prefix-arg - (gnus-completing-read "Move to topic" (mapcar 'car gnus-topic-alist) t + (gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t nil 'gnus-topic-history))) (let ((use-marked (and (not n) (not (and transient-mark-mode mark-active)) gnus-group-marked t)) @@ -1328,7 +1331,7 @@ If COPYP, copy the groups instead." (interactive (list current-prefix-arg (gnus-completing-read - "Copy to topic" (mapcar 'car gnus-topic-alist) t))) + "Copy to topic" (mapcar #'car gnus-topic-alist) t))) (gnus-topic-move-group n topic t)) (defun gnus-topic-kill-group (&optional n discard) @@ -1422,7 +1425,7 @@ If PERMANENT, make it stay shown in subsequent sessions as well." (let ((topic (gnus-topic-find-topology (gnus-completing-read "Show topic" - (mapcar 'car gnus-topic-alist) t)))) + (mapcar #'car gnus-topic-alist) t)))) (setcar (cddr (cadr topic)) nil) (setcar (cdr (cadr topic)) 'visible) (gnus-group-list-groups))))) @@ -1471,7 +1474,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics." (nreverse (list (setq topic (gnus-completing-read "Move to topic" - (mapcar 'car gnus-topic-alist) t)) + (mapcar #'car gnus-topic-alist) t)) (read-string (format "Move to %s (regexp): " topic)))))) (gnus-group-mark-regexp regexp) (gnus-topic-move-group nil topic copyp)) @@ -1605,8 +1608,8 @@ If performed on a topic, edit the topic parameters instead." (gnus-topic-parameters topic) (format-message "Editing the topic parameters for `%s'." (or group topic)) - `(lambda (form) - (gnus-topic-set-parameters ,topic form))))))) + (lambda (form) + (gnus-topic-set-parameters topic form))))))) (defun gnus-group-sort-topic (func reverse) "Sort groups in the topics according to FUNC and REVERSE." @@ -1690,9 +1693,8 @@ If REVERSE, sort in reverse order." (defun gnus-topic-sort-topics-1 (top reverse) (if (cdr top) (let ((subtop - (mapcar (gnus-byte-compile - `(lambda (top) - (gnus-topic-sort-topics-1 top ,reverse))) + (mapcar (lambda (top) + (gnus-topic-sort-topics-1 top reverse)) (sort (cdr top) (lambda (t1 t2) (string-lessp (caar t1) (caar t2))))))) @@ -1704,7 +1706,7 @@ If REVERSE, sort in reverse order." If REVERSE, reverse the sorting order." (interactive (list (gnus-completing-read "Sort topics in" - (mapcar 'car gnus-topic-alist) t + (mapcar #'car gnus-topic-alist) t (gnus-current-topic)) current-prefix-arg)) (let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic))) @@ -1719,7 +1721,7 @@ If REVERSE, reverse the sorting order." (interactive (list (gnus-group-topic-name) - (gnus-completing-read "Move to topic" (mapcar 'car gnus-topic-alist) t))) + (gnus-completing-read "Move to topic" (mapcar #'car gnus-topic-alist) t))) (unless (and current to) (error "Can't find topic")) (let ((current-top (cdr (gnus-topic-find-topology current))) diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el index b1c1fb832fe..64ed2bbad6b 100644 --- a/lisp/gnus/gnus-undo.el +++ b/lisp/gnus/gnus-undo.el @@ -1,4 +1,4 @@ -;;; gnus-undo.el --- minor mode for undoing in Gnus +;;; gnus-undo.el --- minor mode for undoing in Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. @@ -52,8 +52,7 @@ (defcustom gnus-undo-limit 2000 "The number of undoable actions recorded." - :type 'integer - :group 'gnus-undo) + :type 'integer) (defcustom gnus-undo-mode nil ;; FIXME: This is a buffer-local minor mode which requires running @@ -61,13 +60,11 @@ ;; doesn't seem very useful: setting it to non-nil via Customize ;; probably won't do the right thing. "Minor mode for undoing in Gnus buffers." - :type 'boolean - :group 'gnus-undo) + :type 'boolean) (defcustom gnus-undo-mode-hook nil "Hook called in all `gnus-undo-mode' buffers." - :type 'hook - :group 'gnus-undo) + :type 'hook) ;;; Internal variables. @@ -106,7 +103,7 @@ ;; Set up the menu. (when (gnus-visual-p 'undo-menu 'menu) (gnus-undo-make-menu-bar)) - (add-hook 'post-command-hook 'gnus-undo-boundary nil t))) + (add-hook 'post-command-hook #'gnus-undo-boundary nil t))) ;;; Interface functions. @@ -130,15 +127,10 @@ gnus-undo-boundary t)) (defun gnus-undo-register (form) - "Register FORMS as something to be performed to undo a change. -FORMS may use backtick quote syntax." + "Register FORMS as something to be performed to undo a change." (when gnus-undo-mode (gnus-undo-register-1 - `(lambda () - ,form)))) - -(put 'gnus-undo-register 'lisp-indent-function 0) -(put 'gnus-undo-register 'edebug-form-spec '(body)) + `(lambda () ,form)))) (defun gnus-undo-register-1 (function) "Register FUNCTION as something to be performed to undo a change." @@ -161,23 +153,23 @@ FORMS may use backtick quote syntax." ;; We are not at a boundary... (setq gnus-undo-boundary-inhibit t))) -(defun gnus-undo (n) +(defun gnus-undo (_n) "Undo some previous changes in Gnus buffers. -Repeat this command to undo more changes. -A numeric argument serves as a repeat count." +Repeat this command to undo more changes." + ;; FIXME: A numeric argument should serve as a repeat count. (interactive "p") (unless gnus-undo-mode (error "Undoing is not enabled in this buffer")) (message "%s" last-command) - (when (or (not (eq last-command 'gnus-undo)) - (not gnus-undo-last)) + (unless (and (eq last-command 'gnus-undo) + gnus-undo-last) (setq gnus-undo-last gnus-undo-actions)) (let ((action (pop gnus-undo-last))) (unless action (error "Nothing further to undo")) (setq gnus-undo-actions (delq action gnus-undo-actions)) (setq gnus-undo-boundary t) - (mapc 'funcall action))) + (mapc #'funcall action))) (provide 'gnus-undo) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index de3c854ca56..f80243cfedb 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1,4 +1,4 @@ -;;; gnus-util.el --- utility functions for Gnus +;;; gnus-util.el --- utility functions for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. @@ -87,6 +87,7 @@ This is a compatibility function for different Emacsen." (defmacro gnus-eval-in-buffer-window (buffer &rest forms) "Pop to BUFFER, evaluate FORMS, and then return to the original window." + (declare (indent 1) (debug t)) (let ((tempvar (make-symbol "GnusStartBufferWindow")) (w (make-symbol "w")) (buf (make-symbol "buf"))) @@ -103,9 +104,6 @@ This is a compatibility function for different Emacsen." ,@forms) (select-window ,tempvar))))) -(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) -(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) - (defsubst gnus-goto-char (point) (and point (goto-char point))) @@ -302,31 +300,28 @@ Symbols are also allowed; their print names are used instead." (defmacro gnus-local-set-keys (&rest plist) "Set the keys in PLIST in the current keymap." + (declare (indent 1)) `(gnus-define-keys-1 (current-local-map) ',plist)) (defmacro gnus-define-keys (keymap &rest plist) "Define all keys in PLIST in KEYMAP." - `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) + (declare (indent 1)) + `(gnus-define-keys-1 ,(if (symbolp keymap) keymap `',keymap) (quote ,plist))) (defmacro gnus-define-keys-safe (keymap &rest plist) "Define all keys in PLIST in KEYMAP without overwriting previous definitions." + (declare (indent 1)) `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t)) -(put 'gnus-define-keys 'lisp-indent-function 1) -(put 'gnus-define-keys-safe 'lisp-indent-function 1) -(put 'gnus-local-set-keys 'lisp-indent-function 1) - (defmacro gnus-define-keymap (keymap &rest plist) "Define all keys in PLIST in KEYMAP." + (declare (indent 1)) `(gnus-define-keys-1 ,keymap (quote ,plist))) -(put 'gnus-define-keymap 'lisp-indent-function 1) - (defun gnus-define-keys-1 (keymap plist &optional safe) (when (null keymap) (error "Can't set keys in a null keymap")) - (cond ((symbolp keymap) - (setq keymap (symbol-value keymap))) + (cond ((symbolp keymap) (error "First arg should be a keymap object")) ((keymapp keymap)) ((listp keymap) (set (car keymap) nil) @@ -450,7 +445,7 @@ displayed in the echo area." `(let (str time) (cond ((eq gnus-add-timestamp-to-message 'log) (setq str (let (message-log-max) - (apply 'message ,format-string ,args))) + (apply #'message ,format-string ,args))) (when (and message-log-max (> message-log-max 0) (/= (length str) 0)) @@ -476,7 +471,7 @@ displayed in the echo area." (message "%s" (concat ,timestamp str)) str)) (t - (apply 'message ,format-string ,args))))))) + (apply #'message ,format-string ,args))))))) (defvar gnus-action-message-log nil) @@ -496,8 +491,8 @@ inside loops." (if (<= level gnus-verbose) (let ((message (if gnus-add-timestamp-to-message - (apply 'gnus-message-with-timestamp args) - (apply 'message args)))) + (apply #'gnus-message-with-timestamp args) + (apply #'message args)))) (when (and (consp gnus-action-message-log) (<= level 3)) (push message gnus-action-message-log)) @@ -518,7 +513,7 @@ inside loops." "Beep an error if LEVEL is equal to or less than `gnus-verbose'. ARGS are passed to `message'." (when (<= (floor level) gnus-verbose) - (apply 'message args) + (apply #'message args) (ding) (let (duration) (when (and (floatp level) @@ -686,6 +681,8 @@ yield \"nnimap:yxa\"." (define-key (symbol-value (intern (format "gnus-%s-mode-map" type))) [menu-bar edit] 'undefined)) +(defvar print-string-length) + (defmacro gnus-bind-print-variables (&rest forms) "Bind print-* variables and evaluate FORMS. This macro is used with `prin1', `pp', etc. in order to ensure @@ -856,64 +853,10 @@ the user are disabled, it is recommended that only the most minimal operations are performed by FORMS. If you wish to assign many complicated values atomically, compute the results into temporary variables and then do only the assignment atomically." + (declare (indent 0) (debug t)) `(let ((inhibit-quit gnus-atomic-be-safe)) ,@forms)) -(put 'gnus-atomic-progn 'lisp-indent-function 0) - -(defmacro gnus-atomic-progn-assign (protect &rest forms) - "Evaluate FORMS, but ensure that the variables listed in PROTECT -are not changed if anything in FORMS signals an error or otherwise -non-locally exits. The variables listed in PROTECT are updated atomically. -It is safe to use gnus-atomic-progn-assign with long computations. - -Note that if any of the symbols in PROTECT were unbound, they will be -set to nil on a successful assignment. In case of an error or other -non-local exit, it will still be unbound." - (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol - (concat (symbol-name x) - "-tmp")) - x)) - protect)) - (sym-temp-map (mapcar (lambda (x) (list (cadr x) (car x))) - temp-sym-map)) - (temp-sym-let (mapcar (lambda (x) (list (car x) - `(and (boundp ',(cadr x)) - ,(cadr x)))) - temp-sym-map)) - (sym-temp-let sym-temp-map) - (temp-sym-assign (apply 'append temp-sym-map)) - (sym-temp-assign (apply 'append sym-temp-map)) - (result (make-symbol "result-tmp"))) - `(let (,@temp-sym-let - ,result) - (let ,sym-temp-let - (setq ,result (progn ,@forms)) - (setq ,@temp-sym-assign)) - (let ((inhibit-quit gnus-atomic-be-safe)) - (setq ,@sym-temp-assign)) - ,result))) - -(put 'gnus-atomic-progn-assign 'lisp-indent-function 1) -;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body)) - -(defmacro gnus-atomic-setq (&rest pairs) - "Similar to setq, except that the real symbols are only assigned when -there are no errors. And when the real symbols are assigned, they are -done so atomically. If other variables might be changed via side-effect, -see gnus-atomic-progn-assign. It is safe to use gnus-atomic-setq -with potentially long computations." - (let ((tpairs pairs) - syms) - (while tpairs - (push (car tpairs) syms) - (setq tpairs (cddr tpairs))) - `(gnus-atomic-progn-assign ,syms - (setq ,@pairs)))) - -;(put 'gnus-atomic-setq 'edebug-form-spec '(body)) - - ;;; Functions for saving to babyl/mail files. (require 'rmail) @@ -1112,19 +1055,24 @@ ARG is passed to the first function." (defun gnus-run-hooks (&rest funcs) "Does the same as `run-hooks', but saves the current buffer." (save-current-buffer - (apply 'run-hooks funcs))) + (apply #'run-hooks funcs))) (defun gnus-run-hook-with-args (hook &rest args) "Does the same as `run-hook-with-args', but saves the current buffer." (save-current-buffer - (apply 'run-hook-with-args hook args))) + (apply #'run-hook-with-args hook args))) (defun gnus-run-mode-hooks (&rest funcs) "Run `run-mode-hooks', saving the current buffer." - (save-current-buffer (apply 'run-mode-hooks funcs))) + (save-current-buffer (apply #'run-mode-hooks funcs))) ;;; Various +(defmacro gnus--\,@ (exp) + "Splice EXP's value (a list of Lisp forms) into the code." + (declare (debug t)) + `(progn ,@(eval exp t))) + (defvar gnus-group-buffer) ; Compiler directive (defun gnus-alive-p () "Say whether Gnus is running or not." @@ -1197,6 +1145,7 @@ ARG is passed to the first function." ;; Fixme: Why not use `with-output-to-temp-buffer'? (defmacro gnus-with-output-to-file (file &rest body) + (declare (indent 1) (debug t)) (let ((buffer (make-symbol "output-buffer")) (size (make-symbol "output-buffer-size")) (leng (make-symbol "output-buffer-length")) @@ -1219,9 +1168,6 @@ ARG is passed to the first function." (write-region (substring ,buffer 0 ,leng) nil ,file ,append 'no-msg)))))) -(put 'gnus-with-output-to-file 'lisp-indent-function 1) -(put 'gnus-with-output-to-file 'edebug-form-spec '(form body)) - (defun gnus-add-text-properties-when (property value start end properties &optional object) "Like `add-text-properties', only applied on where PROPERTY is VALUE." @@ -1264,9 +1210,7 @@ ARG is passed to the first function." (string-equal (downcase x) (downcase y))))) (defcustom gnus-use-byte-compile t - "If non-nil, byte-compile crucial run-time code. -Setting it to nil has no effect after the first time `gnus-byte-compile' -is run." + "If non-nil, byte-compile crucial run-time code." :type 'boolean :version "22.1" :group 'gnus-various) @@ -1274,13 +1218,8 @@ is run." (defun gnus-byte-compile (form) "Byte-compile FORM if `gnus-use-byte-compile' is non-nil." (if gnus-use-byte-compile - (progn - (require 'bytecomp) - (defalias 'gnus-byte-compile - (lambda (form) - (let ((byte-compile-warnings '(unresolved callargs redefine))) - (byte-compile form)))) - (gnus-byte-compile form)) + (let ((byte-compile-warnings '(unresolved callargs redefine))) + (byte-compile form)) form)) (defun gnus-remassoc (key alist) @@ -1300,16 +1239,19 @@ sure of changing the value of `foo'." (cons (cons key value) (gnus-remassoc key alist)) (gnus-remassoc key alist))) +(defvar gnus-info-buffer) +(declare-function gnus-configure-windows "gnus-win" (setting &optional force)) + (defun gnus-create-info-command (node) "Create a command that will go to info NODE." - `(lambda () - (interactive) - ,(concat "Enter the info system at node " node) - (Info-goto-node ,node) - (setq gnus-info-buffer (current-buffer)) - (gnus-configure-windows 'info))) - -(defun gnus-not-ignore (&rest args) + (lambda () + (:documentation (format "Enter the info system at node %s." node)) + (interactive) + (info node) + (setq gnus-info-buffer (current-buffer)) + (gnus-configure-windows 'info))) + +(defun gnus-not-ignore (&rest _args) t) (defvar gnus-directory-sep-char-regexp "/" @@ -1358,7 +1300,7 @@ REJECT-NEWLINES is nil, remove them; otherwise raise an error. If LINE-LENGTH is set and the string (or any line in the string if REJECT-NEWLINES is nil) is longer than that number, raise an error. Common line length for input characters are 76 plus CRLF -(RFC 2045 MIME), 64 plus CRLF (RFC 1421 PEM), and 1000 including +\(RFC 2045 MIME), 64 plus CRLF (RFC 1421 PEM), and 1000 including CRLF (RFC 5321 SMTP). If NOCHECK, don't check anything, but just repad." @@ -1416,7 +1358,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and', `(,spec elem)) ((listp spec) (if (memq (car spec) '(or and not)) - `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec))) + `(,(car spec) ,@(mapcar #'gnus-make-predicate-1 (cdr spec))) (error "Invalid predicate specifier: %s" spec))))) (defun gnus-completing-read (prompt collection &optional require-match @@ -1446,8 +1388,10 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (declare-function iswitchb-read-buffer "iswitchb" (prompt &optional default require-match _predicate start matches-set)) +(declare-function iswitchb-minibuffer-setup "iswitchb") (defvar iswitchb-temp-buflist) (defvar iswitchb-mode) +(defvar iswitchb-make-buflist-hook) (defun gnus-iswitchb-completing-read (prompt collection &optional require-match initial-input history def) @@ -1468,16 +1412,14 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (unwind-protect (progn (or iswitchb-mode - (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)) + (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)) (iswitchb-read-buffer prompt def require-match)) (or iswitchb-mode - (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))))) - -(put 'gnus-parse-without-error 'lisp-indent-function 0) -(put 'gnus-parse-without-error 'edebug-form-spec '(body)) + (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup))))) (defmacro gnus-parse-without-error (&rest body) "Allow continuing onto the next line even if an error occurs." + (declare (indent 0) (debug t)) `(while (not (eobp)) (condition-case () (progn @@ -1512,7 +1454,8 @@ CHOICE is a list of the choice char and help message at IDX." prompt (concat (mapconcat (lambda (s) (char-to-string (car s))) - choice ", ") ", ?")) + choice ", ") + ", ?")) (setq tchar (read-char)) (when (not (assq tchar choice)) (setq tchar nil) @@ -1568,7 +1511,7 @@ Return nil otherwise." (defvar tool-bar-mode) -(defun gnus-tool-bar-update (&rest ignore) +(defun gnus-tool-bar-update (&rest _ignore) "Update the tool bar." (when (and (boundp 'tool-bar-mode) tool-bar-mode) @@ -1594,7 +1537,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp (if seqs2_n (let* ((seqs (cons seq1 seqs2_n)) (cnt 0) - (heads (mapcar (lambda (seq) + (heads (mapcar (lambda (_seq) (make-symbol (concat "head" (int-to-string (setq cnt (1+ cnt)))))) @@ -1628,7 +1571,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp ((memq 'type lst) (symbol-name system-type)) (t nil))) - codename) + ) ;; codename (cond ((not (memq 'emacs lst)) nil) @@ -1644,9 +1587,9 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp empty directories from OLD-PATH." (when (file-exists-p old-path) (let* ((old-dir (file-name-directory old-path)) - (old-name (file-name-nondirectory old-path)) + ;; (old-name (file-name-nondirectory old-path)) (new-dir (file-name-directory new-path)) - (new-name (file-name-nondirectory new-path)) + ;; (new-name (file-name-nondirectory new-path)) temp) (gnus-make-directory new-dir) (rename-file old-path new-path t) @@ -1747,7 +1690,7 @@ lists of strings." (setq props (plist-put props :foreground (face-foreground face))) (setq props (plist-put props :background (face-background face)))) (ignore-errors - (apply 'create-image file type data-p props)))) + (apply #'create-image file type data-p props)))) (defun gnus-put-image (glyph &optional string category) (let ((point (point))) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index db0ffc6d0df..32a87851549 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -1,4 +1,4 @@ -;;; gnus-uu.el --- extract (uu)encoded files in Gnus +;;; gnus-uu.el --- extract (uu)encoded files in Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1985-1987, 1993-1998, 2000-2021 Free Software ;; Foundation, Inc. @@ -356,7 +356,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-uu-decode-uu (&optional n) "Uudecodes the current article." (interactive "P") - (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n)) + (gnus-uu-decode-with-method #'gnus-uu-uustrip-article n)) (defun gnus-uu-decode-uu-and-save (n dir) "Decodes and saves the resulting file." @@ -366,12 +366,12 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (read-directory-name "Uudecode and save in dir: " gnus-uu-default-dir gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t)) + (gnus-uu-decode-with-method #'gnus-uu-uustrip-article n dir nil nil t)) (defun gnus-uu-decode-unshar (&optional n) "Unshars the current article." (interactive "P") - (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t)) + (gnus-uu-decode-with-method #'gnus-uu-unshar-article n nil nil 'scan t)) (defun gnus-uu-decode-unshar-and-save (n dir) "Unshars and saves the current article." @@ -381,7 +381,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (read-directory-name "Unshar and save in dir: " gnus-uu-default-dir gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan t)) + (gnus-uu-decode-with-method #'gnus-uu-unshar-article n dir nil 'scan t)) (defun gnus-uu-decode-save (n file) "Saves the current article." @@ -393,7 +393,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (read-file-name "Save article in file: " gnus-uu-default-dir gnus-uu-default-dir)))) (setq gnus-uu-saved-article-name file) - (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t)) + (gnus-uu-decode-with-method #'gnus-uu-save-article n nil t)) (defun gnus-uu-decode-binhex (n dir) "Unbinhexes the current article." @@ -406,7 +406,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (gnus-uu-initialize) (setq gnus-uu-binhex-article-name (make-temp-file (expand-file-name "binhex" gnus-uu-work-dir))) - (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) + (gnus-uu-decode-with-method #'gnus-uu-binhex-article n dir)) (defun gnus-uu-decode-yenc (n dir) "Decode the yEnc-encoded current article." @@ -417,7 +417,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." gnus-uu-default-dir gnus-uu-default-dir)))) (setq gnus-uu-yenc-article-name nil) - (gnus-uu-decode-with-method 'gnus-uu-yenc-article n dir nil t)) + (gnus-uu-decode-with-method #'gnus-uu-yenc-article n dir nil t)) (defun gnus-uu-decode-uu-view (&optional n) "Uudecodes and views the current article." @@ -729,7 +729,7 @@ When called interactively, prompt for REGEXP." (defun gnus-uu-decode-postscript (&optional n) "Gets PostScript of the current article." (interactive "P") - (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n)) + (gnus-uu-decode-with-method #'gnus-uu-decode-postscript-article n)) (defun gnus-uu-decode-postscript-view (&optional n) "Gets and views the current article." @@ -745,7 +745,7 @@ When called interactively, prompt for REGEXP." (read-directory-name "Save in dir: " gnus-uu-default-dir gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article + (gnus-uu-decode-with-method #'gnus-uu-decode-postscript-article n dir nil nil t)) (defun gnus-uu-decode-postscript-and-save-view (n dir) @@ -977,7 +977,7 @@ When called interactively, prompt for REGEXP." (defvar gnus-uu-binhex-end-line ":$") -(defun gnus-uu-binhex-article (buffer in-state) +(defun gnus-uu-binhex-article (buffer _in-state) (let (state start-char) (with-current-buffer buffer (widen) @@ -1014,11 +1014,11 @@ When called interactively, prompt for REGEXP." ;; yEnc -(defun gnus-uu-yenc-article (buffer in-state) +(defun gnus-uu-yenc-article (_buffer _in-state) (with-current-buffer gnus-original-article-buffer (widen) (let ((file-name (yenc-extract-filename)) - state start-char) + state) ;; start-char (when (not file-name) (setq state (list 'wrong-type))) @@ -1046,7 +1046,7 @@ When called interactively, prompt for REGEXP." ;; PostScript -(defun gnus-uu-decode-postscript-article (process-buffer in-state) +(defun gnus-uu-decode-postscript-article (process-buffer _in-state) (let ((state (list 'ok)) start-char end-char file-name) (with-current-buffer process-buffer @@ -1196,11 +1196,11 @@ When called interactively, prompt for REGEXP." ;; Expand numbers, sort, and return the list of article ;; numbers. - (mapcar 'cdr + (mapcar #'cdr (sort (gnus-uu-expand-numbers list-of-subjects (not do-not-translate)) - 'gnus-uu-string<)))))) + #'gnus-uu-string<)))))) (defun gnus-uu-expand-numbers (string-list &optional translate) ;; Takes a list of strings and "expands" all numbers in all the @@ -1278,13 +1278,15 @@ When called interactively, prompt for REGEXP." (when dont-unmark-last-article (setq gnus-uu-has-been-grabbed (list art)))))) +(defvar gnus-asynchronous) + ;; This function takes a list of articles and a function to apply to ;; each article grabbed. ;; ;; This function returns a list of files decoded if the grabbing and ;; the process-function has been successful and nil otherwise. (defun gnus-uu-grab-articles (articles process-function - &optional sloppy limit no-errors) + &optional sloppy limit _no-errors) (require 'gnus-async) (let ((state 'first) (gnus-asynchronous nil) @@ -1452,10 +1454,10 @@ When called interactively, prompt for REGEXP." (setq subject (substring subject (match-end 0))))) (or part ""))) -(defun gnus-uu-uudecode-sentinel (process event) +(defun gnus-uu-uudecode-sentinel (process _event) (delete-process (get-process process))) -(defun gnus-uu-uustrip-article (process-buffer in-state) +(defun gnus-uu-uustrip-article (process-buffer _in-state) ;; Uudecodes a file asynchronously. (with-current-buffer process-buffer (let ((state (list 'wrong-type)) @@ -1576,7 +1578,7 @@ Gnus might fail to display all of it.") ;; This function is used by `gnus-uu-grab-articles' to treat ;; a shared article. -(defun gnus-uu-unshar-article (process-buffer in-state) +(defun gnus-uu-unshar-article (process-buffer _in-state) (let ((state (list 'ok)) start-char) (with-current-buffer process-buffer @@ -1830,8 +1832,8 @@ Gnus might fail to display all of it.") ;; Initializing -(add-hook 'gnus-summary-prepare-exit-hook 'gnus-uu-clean-up) -(add-hook 'gnus-summary-prepare-exit-hook 'gnus-uu-delete-work-dir) +(add-hook 'gnus-summary-prepare-exit-hook #'gnus-uu-clean-up) +(add-hook 'gnus-summary-prepare-exit-hook #'gnus-uu-delete-work-dir) @@ -1949,6 +1951,7 @@ The user will be asked for a file name." (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) file-name)) (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) + ;; FIXME: Shouldn't we set-buffer before saving the restriction? --Stef (save-restriction (set-buffer gnus-message-buffer) (goto-char (point-min)) diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el index 533b1e2a580..b7e6b2a8890 100644 --- a/lisp/gnus/gnus-vm.el +++ b/lisp/gnus/gnus-vm.el @@ -1,4 +1,4 @@ -;;; gnus-vm.el --- vm interface for Gnus +;;; gnus-vm.el --- vm interface for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1994-2021 Free Software Foundation, Inc. diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index 3fb8e469d04..8ac4e39fa52 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el @@ -1,4 +1,4 @@ -;;; gnus-win.el --- window configuration functions for Gnus +;;; gnus-win.el --- window configuration functions for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. @@ -36,7 +36,6 @@ (defcustom gnus-use-full-window t "If non-nil, use the entire Emacs screen." - :group 'gnus-windows :type 'boolean) (defcustom gnus-use-atomic-windows nil @@ -46,17 +45,14 @@ (defcustom gnus-window-min-width 2 "Minimum width of Gnus buffers." - :group 'gnus-windows :type 'integer) (defcustom gnus-window-min-height 1 "Minimum height of Gnus buffers." - :group 'gnus-windows :type 'integer) (defcustom gnus-always-force-window-configuration nil "If non-nil, always force the Gnus window configurations." - :group 'gnus-windows :type 'boolean) (defcustom gnus-use-frames-on-any-display nil @@ -64,7 +60,6 @@ When nil, only frames on the same display as the selected frame will be used to display Gnus windows." :version "22.1" - :group 'gnus-windows :type 'boolean) (defvar gnus-buffer-configuration @@ -202,7 +197,6 @@ See the Gnus manual for an explanation of the syntax used.") (defcustom gnus-configure-windows-hook nil "A hook called when configuring windows." :version "22.1" - :group 'gnus-windows :type 'hook) ;;; Internal variables. @@ -252,7 +246,7 @@ See the Gnus manual for an explanation of the syntax used.") ;; return a new SPLIT. (while (and (not (assq (car split) gnus-window-to-buffer)) (symbolp (car split)) (fboundp (car split))) - (setq split (eval split))) + (setq split (eval split t))) (let* ((type (car split)) (subs (cddr split)) (len (if (eq type 'horizontal) (window-width) (window-height))) @@ -329,7 +323,7 @@ See the Gnus manual for an explanation of the syntax used.") (setq sub (append (pop subs) nil)) (while (and (not (assq (car sub) gnus-window-to-buffer)) (symbolp (car sub)) (fboundp (car sub))) - (setq sub (eval sub))) + (setq sub (eval sub t))) (when sub (push sub comp-subs) (setq size (cadar comp-subs)) @@ -477,7 +471,7 @@ should have point." ;; return a new SPLIT. (while (and (not (assq (car split) gnus-window-to-buffer)) (symbolp (car split)) (fboundp (car split))) - (setq split (eval split))) + (setq split (eval split t))) (setq type (elt split 0)) (cond diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 91ab878b22f..e8e562988e9 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -3212,9 +3212,9 @@ that that variable is buffer-local to the summary buffers." (format "%s" (car method)) (format "%s:%s" (car method) (cadr method)))) (name-method (cons name method))) - (when (and (not (member name-method gnus-server-method-cache)) - (not no-enter-cache) - (not (assoc (car name-method) gnus-server-method-cache))) + (unless (or no-enter-cache + (member name-method gnus-server-method-cache) + (assoc (car name-method) gnus-server-method-cache)) (push name-method gnus-server-method-cache)) name))) @@ -3273,8 +3273,7 @@ that that variable is buffer-local to the summary buffers." (gnus-server-to-method method)) ((equal method gnus-select-method) gnus-select-method) - ((and (stringp (car method)) - group) + ((and group (stringp (car method))) (gnus-server-extend-method group method)) ((and method (not group) @@ -3501,7 +3500,7 @@ You should probably use `gnus-find-method-for-group' instead." (while (setq info (pop alist)) (when (gnus-server-equal (gnus-info-method info) server) (push (gnus-info-group info) groups))) - (sort groups 'string<))) + (sort groups #'string<))) (defun gnus-group-foreign-p (group) "Say whether a group is foreign or not." @@ -3724,7 +3723,7 @@ just the host name." depth (+ depth 1))) depth)))) ;; Separate foreign select method from group name and collapse. - ;; If method contains a server, collapse to non-domain server name, + ;; If method contains a server, collapse to non-domain server name, ;; otherwise collapse to select method. (let* ((colon (string-match ":" group)) (server (and colon (substring group 0 colon))) diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el index 20562fb9ad2..6ff2a4e2851 100644 --- a/lisp/gnus/gssapi.el +++ b/lisp/gnus/gssapi.el @@ -1,4 +1,4 @@ -;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs +;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2021 Free Software Foundation, Inc. diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el index b47e69ffa4b..091e3899c26 100644 --- a/lisp/gnus/legacy-gnus-agent.el +++ b/lisp/gnus/legacy-gnus-agent.el @@ -1,4 +1,4 @@ -;;; gnus-agent.el --- Legacy unplugged support for Gnus +;;; gnus-agent.el --- Legacy unplugged support for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2021 Free Software Foundation, Inc. @@ -210,7 +210,7 @@ converted to the compressed format." ;; Therefore, hide the default prompt. (gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t) -(defun gnus-agent-unhook-expire-days (converting-to) +(defun gnus-agent-unhook-expire-days (_converting-to) "Remove every lambda from `gnus-group-prepare-hook' that mention the symbol `gnus-agent-do-once' in their definition. This should NOT be necessary as gnus-agent.el no longer adds them. However, it is diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 52470196f62..af0a1983766 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -1,4 +1,4 @@ -;;; mail-source.el --- functions for fetching mail +;;; mail-source.el --- functions for fetching mail -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -56,7 +56,6 @@ "Where the mail backends will look for incoming mail. This variable is a list of mail source specifiers. See Info node `(gnus)Mail Source Specifiers'." - :group 'mail-source :version "24.4" :link '(custom-manual "(gnus)Mail Source Specifiers") :type `(choice @@ -230,33 +229,27 @@ Leave mails for this many days" :value 14))))) If nil, the user will be prompted when an error occurs. If non-nil, the error will be ignored." :version "22.1" - :group 'mail-source :type 'boolean) (defcustom mail-source-primary-source nil "Primary source for incoming mail. If non-nil, this maildrop will be checked periodically for new mail." - :group 'mail-source :type 'sexp) (defcustom mail-source-flash t "If non-nil, flash periodically when mail is available." - :group 'mail-source :type 'boolean) (defcustom mail-source-crash-box "~/.emacs-mail-crash-box" "File where mail will be stored while processing it." - :group 'mail-source :type 'file) (defcustom mail-source-directory message-directory "Directory where incoming mail source files (if any) will be stored." - :group 'mail-source :type 'directory) (defcustom mail-source-default-file-modes 384 "Set the mode bits of all new mail files to this integer." - :group 'mail-source :type 'integer) (defcustom mail-source-delete-incoming @@ -270,7 +263,6 @@ Removing of old files happens in `mail-source-callback', i.e. no old incoming files will be deleted unless you receive new mail. You may also set this variable to nil and call `mail-source-delete-old-incoming' interactively." - :group 'mail-source :version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed) :type '(choice (const :tag "immediately" t) (const :tag "never" nil) @@ -281,28 +273,23 @@ You may also set this variable to nil and call This variable only applies when `mail-source-delete-incoming' is a positive number." :version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed) - :group 'mail-source :type 'boolean) (defcustom mail-source-incoming-file-prefix "Incoming" "Prefix for file name for storing incoming mail." - :group 'mail-source :type 'string) (defcustom mail-source-report-new-mail-interval 5 "Interval in minutes between checks for new mail." - :group 'mail-source :type 'number) (defcustom mail-source-idle-time-delay 5 "Number of idle seconds to wait before checking for new mail." - :group 'mail-source :type 'number) (defcustom mail-source-movemail-program "movemail" "If non-nil, name of program for fetching new mail." :version "26.2" - :group 'mail-source :type '(choice (const nil) string)) ;;; Internal variables. @@ -393,13 +380,10 @@ All keywords that can be used must be listed here.")) ;; suitable for usage in a `let' form (eval-and-compile (defun mail-source-bind-1 (type) - (let* ((defaults (cdr (assq type mail-source-keyword-map))) - default bind) - (while (setq default (pop defaults)) - (push (list (mail-source-strip-keyword (car default)) - nil) - bind)) - bind))) + (mapcar (lambda (default) + (list (mail-source-strip-keyword (car default)) + nil)) + (cdr (assq type mail-source-keyword-map))))) (defmacro mail-source-bind (type-source &rest body) "Return a `let' form that binds all variables in source TYPE. @@ -418,18 +402,20 @@ of the second `let' form. The variables bound and their default values are described by the `mail-source-keyword-map' variable." - `(let* ,(mail-source-bind-1 (car type-source)) - (mail-source-set-1 ,(cadr type-source)) - ,@body)) - -(put 'mail-source-bind 'lisp-indent-function 1) -(put 'mail-source-bind 'edebug-form-spec '(sexp body)) + (declare (indent 1) (debug (sexp body))) + ;; FIXME: Use lexical vars, i.e. don't initialize the vars inside + ;; `mail-source-set-1' via `set'. + (let ((bindings (mail-source-bind-1 (car type-source)))) + `(with-suppressed-warnings ((lexical ,@(mapcar #'car bindings))) + (dlet ,bindings + (mail-source-set-1 ,(cadr type-source)) + ,@body)))) (defun mail-source-set-1 (source) (let* ((type (pop source)) (defaults (cdr (assq type mail-source-keyword-map))) (search '(:max 1)) - found default value keyword auth-info user-auth pass-auth) + found default value keyword user-auth pass-auth) ;; auth-info ;; append to the search the useful info from the source and the defaults: ;; user, host, and port @@ -463,21 +449,23 @@ the `mail-source-keyword-map' variable." (cond ((and (eq keyword :user) - (setq user-auth (plist-get - ;; cache the search result in `found' - (or found - (setq found (nth 0 (apply 'auth-source-search - search)))) - :user))) + (setq user-auth + (plist-get + ;; cache the search result in `found' + (or found + (setq found (nth 0 (apply #'auth-source-search + search)))) + :user))) user-auth) ((and (eq keyword :password) - (setq pass-auth (plist-get - ;; cache the search result in `found' - (or found - (setq found (nth 0 (apply 'auth-source-search - search)))) - :secret))) + (setq pass-auth + (plist-get + ;; cache the search result in `found' + (or found + (setq found (nth 0 (apply #'auth-source-search + search)))) + :secret))) ;; maybe set the password to the return of the :secret function (if (functionp pass-auth) (setq pass-auth (funcall pass-auth)) @@ -488,20 +476,16 @@ the `mail-source-keyword-map' variable." (eval-and-compile (defun mail-source-bind-common-1 () - (let* ((defaults mail-source-common-keyword-map) - default bind) - (while (setq default (pop defaults)) - (push (list (mail-source-strip-keyword (car default)) - nil) - bind)) - bind))) + (mapcar (lambda (default) + (list (mail-source-strip-keyword (car default)) + nil)) + mail-source-common-keyword-map))) (defun mail-source-set-common-1 (source) (let* ((type (pop source)) - (defaults mail-source-common-keyword-map) (defaults-1 (cdr (assq type mail-source-keyword-map))) - default value keyword) - (while (setq default (pop defaults)) + value keyword) + (dolist (default mail-source-common-keyword-map) (set (mail-source-strip-keyword (setq keyword (car default))) (if (setq value (plist-get source keyword)) (mail-source-value value) @@ -512,12 +496,14 @@ the `mail-source-keyword-map' variable." (defmacro mail-source-bind-common (source &rest body) "Return a `let' form that binds all common variables. See `mail-source-bind'." - `(let ,(mail-source-bind-common-1) - (mail-source-set-common-1 source) - ,@body)) - -(put 'mail-source-bind-common 'lisp-indent-function 1) -(put 'mail-source-bind-common 'edebug-form-spec '(sexp body)) + (declare (indent 1) (debug (sexp body))) + ;; FIXME: AFAICT this is a Rube Goldberg'esque way to bind and initialize the + ;; `plugged` variable. + (let ((bindings (mail-source-bind-common-1))) + `(with-suppressed-warnings ((lexical ,@(mapcar #'car bindings))) + (dlet ,bindings + (mail-source-set-common-1 ,source) + ,@body)))) (defun mail-source-value (value) "Return the value of VALUE." @@ -527,7 +513,7 @@ See `mail-source-bind'." value) ;; Function ((and (listp value) (symbolp (car value)) (fboundp (car value))) - (eval value)) + (eval value t)) ;; Just return the value. (t value))) @@ -688,7 +674,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) ;; find "our" movemail in exec-directory. ;; Bug#31737 (apply - 'call-process + #'call-process (append (list mail-source-movemail-program @@ -742,12 +728,13 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (declare-function gnus-get-buffer-create "gnus" (name)) (defun mail-source-call-script (script) (require 'gnus) - (let ((background nil) + (let (;; (background nil) (stderr (gnus-get-buffer-create " *mail-source-stderr*")) result) (when (string-match "& *$" script) (setq script (substring script 0 (match-beginning 0)) - background 0)) + ;; background 0 + )) (setq result (call-process shell-file-name nil stderr nil shell-command-switch script)) @@ -831,14 +818,14 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) ;; The default is to use pop3.el. (t (require 'pop3) - (let ((pop3-password password) - (pop3-maildrop user) - (pop3-mailhost server) - (pop3-port port) - (pop3-authentication-scheme - (if (eq authentication 'apop) 'apop 'pass)) - (pop3-stream-type stream) - (pop3-leave-mail-on-server leave)) + (dlet ((pop3-password password) + (pop3-maildrop user) + (pop3-mailhost server) + (pop3-port port) + (pop3-authentication-scheme + (if (eq authentication 'apop) 'apop 'pass)) + (pop3-stream-type stream) + (pop3-leave-mail-on-server leave)) (if (or debug-on-quit debug-on-error) (save-excursion (pop3-movemail mail-source-crash-box)) (condition-case err @@ -898,12 +885,12 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) ;; The default is to use pop3.el. (t (require 'pop3) - (let ((pop3-password password) - (pop3-maildrop user) - (pop3-mailhost server) - (pop3-port port) - (pop3-authentication-scheme - (if (eq authentication 'apop) 'apop 'pass))) + (dlet ((pop3-password password) + (pop3-maildrop user) + (pop3-mailhost server) + (pop3-port port) + (pop3-authentication-scheme + (if (eq authentication 'apop) 'apop 'pass))) (if (or debug-on-quit debug-on-error) (save-excursion (pop3-get-message-count)) (condition-case err @@ -933,7 +920,7 @@ authentication. To do that, you need to set the `message-send-mail-function' variable as `message-smtpmail-send-it' and put the following line in your ~/.gnus.el file: -\(add-hook \\='message-send-mail-hook \\='mail-source-touch-pop) +\(add-hook \\='message-send-mail-hook #\\='mail-source-touch-pop) See the Gnus manual for details." (let ((sources (if mail-source-primary-source @@ -977,6 +964,8 @@ See the Gnus manual for details." ;; (element 0 of the vector is nil if the timer is active). (aset mail-source-report-new-mail-idle-timer 0 nil))) +(declare-function display-time-event-handler "time" ()) + (defun mail-source-report-new-mail (arg) "Toggle whether to report when new mail is available. This only works when `display-time' is enabled." @@ -1005,11 +994,11 @@ This only works when `display-time' is enabled." #'mail-source-start-idle-timer)) ;; When you get new mail, clear "Mail" from the mode line. (add-hook 'nnmail-post-get-new-mail-hook - 'display-time-event-handler) + #'display-time-event-handler) (message "Mail check enabled")) (setq display-time-mail-function nil) (remove-hook 'nnmail-post-get-new-mail-hook - 'display-time-event-handler) + #'display-time-event-handler) (message "Mail check disabled")))) (defun mail-source-fetch-maildir (source callback) @@ -1089,7 +1078,8 @@ This only works when `display-time' is enabled." (if (and (imap-open server port stream authentication buf) (imap-authenticate user (or (cdr (assoc from mail-source-password-cache)) - password) buf)) + password) + buf)) (let ((mailbox-list (if (listp mailbox) mailbox (list mailbox)))) (dolist (mailbox mailbox-list) (when (imap-mailbox-select mailbox nil buf) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 1409a4384ab..5a5dbcebc1e 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -394,9 +394,8 @@ If nil, don't insert any text in the body." ;; inspired by JoH-followup-to by Jochem Huhman <joh at gmx.de> ;; new suggestions by R. Weikusat <rw at another.de> -(defvar message-cross-post-old-target nil +(defvar-local message-cross-post-old-target nil "Old target for cross-posts or follow-ups.") -(make-variable-buffer-local 'message-cross-post-old-target) (defcustom message-cross-post-default t "When non-nil `message-cross-post-followup-to' will perform a crosspost. @@ -2004,9 +2003,8 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (User-Agent)) "Alist used for formatting headers.") -(defvar message-options nil +(defvar-local message-options nil "Some saved answers when sending message.") -(make-variable-buffer-local 'message-options) (defvar message-send-mail-real-function nil "Internal send mail function.") @@ -2195,10 +2193,11 @@ see `message-narrow-to-headers-or-head'." (require 'gnus-sum) ; for gnus-list-identifiers (let ((regexp (if (stringp gnus-list-identifiers) gnus-list-identifiers - (mapconcat 'identity gnus-list-identifiers " *\\|")))) + (mapconcat #'identity gnus-list-identifiers " *\\|")))) (if (and (not (equal regexp "")) (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp - " *\\)\\)+\\(Re: +\\)?\\)") subject)) + " *\\)\\)+\\(Re: +\\)?\\)") + subject)) (concat (substring subject 0 (match-beginning 1)) (or (match-string 3 subject) (match-string 5 subject)) @@ -3173,7 +3172,7 @@ Like `text-mode', but with these additional commands: (defun message-setup-fill-variables () "Setup message fill variables." - (setq-local fill-paragraph-function 'message-fill-paragraph) + (setq-local fill-paragraph-function #'message-fill-paragraph) (make-local-variable 'adaptive-fill-first-line-regexp) (let ((quote-prefix-regexp ;; User should change message-cite-prefix-regexp if @@ -3197,7 +3196,7 @@ Like `text-mode', but with these additional commands: (concat quote-prefix-regexp "\\|" adaptive-fill-first-line-regexp))) (setq-local auto-fill-inhibit-regexp nil) - (setq-local normal-auto-fill-function 'message-do-auto-fill)) + (setq-local normal-auto-fill-function #'message-do-auto-fill)) @@ -3674,7 +3673,7 @@ are null." ((functionp message-signature) (funcall message-signature)) ((listp message-signature) - (eval message-signature)) + (eval message-signature t)) (t message-signature))) signature-file) (setq signature @@ -3991,11 +3990,12 @@ Just \\[universal-argument] as argument means don't indent, insert no prefix, and don't delete any headers." (interactive "P") ;; eval the let forms contained in message-cite-style - (eval - `(let ,(if (symbolp message-cite-style) - (symbol-value message-cite-style) - message-cite-style) - (message--yank-original-internal ',arg)))) + (let ((bindings (if (symbolp message-cite-style) + (symbol-value message-cite-style) + message-cite-style))) + (cl-progv (mapcar #'car bindings) + (mapcar (lambda (binding) (eval (cadr binding) t)) bindings) + (message--yank-original-internal arg)))) (defun message-yank-buffer (buffer) "Insert BUFFER into the current buffer and quote it." @@ -4064,7 +4064,7 @@ This function uses `mail-citation-hook' if that is non-nil." ;; Insert a blank line if it is peeled off. (insert "\n")))) (goto-char start) - (mapc 'funcall functions) + (mapc #'funcall functions) (when message-citation-line-function (unless (bolp) (insert "\n")) @@ -4315,6 +4315,10 @@ It should typically alter the sending method in some way or other." (when message-confirm-send (or (y-or-n-p "Send message? ") (keyboard-quit))) + (when (and (not (mml-secure-is-encrypted-p)) + (mml-secure-is-encrypted-p 'anywhere) + (not (yes-or-no-p "This message has a <#secure tag, but is not going to be encrypted. Send anyway?"))) + (error "Aborting sending")) (message message-sending-message) (let ((alist message-send-method-alist) (success t) @@ -4555,7 +4559,7 @@ An address might be bogus if there's a matching entry in (and message-bogus-addresses (let ((re (if (listp message-bogus-addresses) - (mapconcat 'identity + (mapconcat #'identity message-bogus-addresses "\\|") message-bogus-addresses))) @@ -4626,7 +4630,7 @@ Valid types are `send', `return', `exit', `kill' and `postpone'." (funcall action)) ;; Something to be evalled. (t - (eval action)))))) + (eval action t)))))) (defun message-send-mail-partially () "Send mail as message/partial." @@ -4942,7 +4946,7 @@ that instead." ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines. (goto-char (1+ delimline)) - (when (eval message-mailer-swallows-blank-line) + (when (eval message-mailer-swallows-blank-line t) (newline)) (when message-interactive (with-current-buffer errbuf @@ -4950,7 +4954,7 @@ that instead." (let* ((default-directory "/") (coding-system-for-write message-send-coding-system) (cpr (apply - 'call-process-region + #'call-process-region (append (list (point-min) (point-max) sendmail-program nil errbuf nil "-oi") @@ -5002,7 +5006,7 @@ to find out how to use this." (pcase (let ((coding-system-for-write message-send-coding-system)) (apply - 'call-process-region (point-min) (point-max) + #'call-process-region (point-min) (point-max) message-qmail-inject-program nil nil nil ;; qmail-inject's default behavior is to look for addresses on the ;; command line; if there're none, it scans the headers. @@ -5394,7 +5398,7 @@ Otherwise, generate and save a value for `canlock-password' first." "Really use %s possibly unknown group%s: %s? " (if (= (length errors) 1) "this" "these") (if (= (length errors) 1) "" "s") - (mapconcat 'identity errors ", ")))) + (mapconcat #'identity errors ", ")))) ;; There were no errors. ((not errors) t) @@ -6061,7 +6065,7 @@ subscribed address (and not the additional To and Cc header contents)." (cc (message-fetch-field "cc")) (msg-recipients (concat to (and to cc ", ") cc)) (recipients - (mapcar 'mail-strip-quoted-names + (mapcar #'mail-strip-quoted-names (message-tokenize-header msg-recipients))) (file-regexps (if message-subscribed-address-file @@ -6078,11 +6082,11 @@ subscribed address (and not the additional To and Cc header contents)." (if re (setq re (concat re "\\|" item)) (setq re (concat "\\`\\(" item)))) (and re (list (concat re "\\)\\'")))))))) - (mft-regexps (apply 'append message-subscribed-regexps - (mapcar 'regexp-quote + (mft-regexps (apply #'append message-subscribed-regexps + (mapcar #'regexp-quote message-subscribed-addresses) file-regexps - (mapcar 'funcall + (mapcar #'funcall message-subscribed-address-functions)))) (save-match-data (let ((list @@ -6103,7 +6107,7 @@ subscribed address (and not the additional To and Cc header contents)." (dolist (rhs (delete-dups (mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) "")) - (mapcar 'downcase + (mapcar #'downcase (mapcar (lambda (elem) (or (cadr elem) @@ -6569,7 +6573,7 @@ moved to the beginning " (if to (concat " to " (or (car (mail-extract-address-components to)) - to) "") + to)) "") (if (and group (not (string= group ""))) (concat " on " group) "") "*"))) @@ -6583,7 +6587,7 @@ moved to the beginning " (if to (concat " to " (or (car (mail-extract-address-components to)) - to) "") + to)) "") (if (and group (not (string= group ""))) (concat " on " group) "") "*"))) @@ -6612,7 +6616,7 @@ moved to the beginning " (cons (string-to-number (or (match-string 1 b) "1")) b))) (buffer-list))) - 'car-less-than-car))) + #'car-less-than-car))) new))))) (defun message-pop-to-buffer (name &optional switch-function) @@ -6968,8 +6972,8 @@ The function is called with one parameter, a cons cell ..." (message-fetch-field "original-to"))) cc (message-fetch-field "cc") extra (when message-extra-wide-headers - (mapconcat 'identity - (mapcar 'message-fetch-field + (mapconcat #'identity + (mapcar #'message-fetch-field message-extra-wide-headers) ", ")) mct (message-fetch-field "mail-copies-to") @@ -7053,7 +7057,7 @@ want to get rid of this query permanently."))) (setq recipients (cond ((functionp message-dont-reply-to-names) (mapconcat - 'identity + #'identity (delq nil (mapcar (lambda (mail) (unless (funcall message-dont-reply-to-names @@ -7087,7 +7091,7 @@ want to get rid of this query permanently."))) ;; Remove hierarchical lists that are contained within each other, ;; if message-hierarchical-addresses is defined. (when message-hierarchical-addresses - (let ((plain-addrs (mapcar 'car recipients)) + (let ((plain-addrs (mapcar #'car recipients)) subaddrs recip) (while plain-addrs (setq subaddrs (assoc (car plain-addrs) @@ -8366,7 +8370,7 @@ The following arguments may contain lists of values." (with-output-to-temp-buffer " *MESSAGE information message*" (with-current-buffer " *MESSAGE information message*" (fundamental-mode) - (mapc 'princ text) + (mapc #'princ text) (goto-char (point-min)))) (funcall ask question)) (funcall ask question))) diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el index 635e7f4ee84..1ecceeedeb7 100644 --- a/lisp/gnus/mm-archive.el +++ b/lisp/gnus/mm-archive.el @@ -1,4 +1,4 @@ -;;; mm-archive.el --- Functions for parsing archive files as MIME +;;; mm-archive.el --- Functions for parsing archive files as MIME -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2021 Free Software Foundation, Inc. @@ -54,10 +54,10 @@ (write-region (point-min) (point-max) file nil 'silent) (setq decoder (copy-sequence decoder)) (setcar (member "%f" decoder) file) - (apply 'call-process (car decoder) nil nil nil + (apply #'call-process (car decoder) nil nil nil (append (cdr decoder) (list dir))) (delete-file file)) - (apply 'call-process-region (point-min) (point-max) (car decoder) + (apply #'call-process-region (point-min) (point-max) (car decoder) nil (gnus-get-buffer-create "*tnef*") nil (append (cdr decoder) (list dir))))) `("multipart/mixed" @@ -100,11 +100,11 @@ (goto-char (point-max)) (mm-handle-set-undisplayer handle - `(lambda () - (let ((inhibit-read-only t) - (end ,(point-marker))) - (remove-images ,start end) - (delete-region ,start end))))))) + (let ((end (point-marker))) + (lambda () + (let ((inhibit-read-only t)) + (remove-images start end) + (delete-region start end)))))))) (provide 'mm-archive) diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index f35ba3a0b91..d6b71f15e54 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -1,4 +1,4 @@ -;;; mm-bodies.el --- Functions for decoding MIME things +;;; mm-bodies.el --- Functions for decoding MIME things -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2021 Free Software Foundation, Inc. diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 61946aa5811..02cd6af0c98 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -40,8 +40,8 @@ (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) +(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." @@ -603,7 +603,7 @@ files left at the next time." (if fails ;; Schedule the deletion of the files left at the next time. (with-file-modes #o600 - (write-region (concat (mapconcat 'identity (nreverse fails) "\n") + (write-region (concat (mapconcat #'identity (nreverse fails) "\n") "\n") nil cache-file nil 'silent)) (when (file-exists-p cache-file) @@ -1081,7 +1081,8 @@ external if displayed external." (string= total "\"%s\"")) (setq uses-stdin nil) (push (shell-quote-argument - (gnus-map-function mm-path-name-rewrite-functions file)) out)) + (gnus-map-function mm-path-name-rewrite-functions file)) + out)) ((string= total "%t") (push (shell-quote-argument (car type-list)) out)) (t @@ -1092,7 +1093,7 @@ external if displayed external." (push (shell-quote-argument (gnus-map-function mm-path-name-rewrite-functions file)) out)) - (mapconcat 'identity (nreverse out) ""))) + (mapconcat #'identity (nreverse out) ""))) (defun mm-remove-parts (handles) "Remove the displayed MIME parts represented by HANDLES." @@ -1255,6 +1256,7 @@ in HANDLE." (defmacro mm-with-part (handle &rest forms) "Run FORMS in the temp buffer containing the contents of HANDLE." + (declare (indent 1) (debug t)) ;; The handle-buffer's content is a sequence of bytes, not a sequence of ;; chars, so the buffer should be unibyte. It may happen that the ;; handle-buffer is multibyte for some reason, in which case now is a good @@ -1270,8 +1272,6 @@ in HANDLE." (mm-handle-encoding handle) (mm-handle-media-type handle)) ,@forms)))) -(put 'mm-with-part 'lisp-indent-function 1) -(put 'mm-with-part 'edebug-form-spec '(body)) (defun mm-get-part (handle &optional no-cache) "Return the contents of HANDLE as a string. diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el index 8bd3e0b3d2d..84a3b0a8d1c 100644 --- a/lisp/gnus/mm-encode.el +++ b/lisp/gnus/mm-encode.el @@ -1,4 +1,4 @@ -;;; mm-encode.el --- Functions for encoding MIME things +;;; mm-encode.el --- Functions for encoding MIME things -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2021 Free Software Foundation, Inc. @@ -98,9 +98,12 @@ This variable should never be set directly, but bound before a call to boundary)) ;;;###autoload -(defun mm-default-file-encoding (file) - "Return a default encoding for FILE." - (if (not (string-match "\\.[^.]+$" file)) +(define-obsolete-function-alias 'mm-default-file-encoding + #'mm-default-file-type "future") ;Old bad name. +;;;###autoload +(defun mm-default-file-type (file) + "Return a default content type for FILE." + (if (not (string-match "\\.[^.]+\\'" file)) "application/octet-stream" (mailcap-extension-to-mime (match-string 0 file)))) diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el index 165c19139ce..0c25c8f8bcd 100644 --- a/lisp/gnus/mm-partial.el +++ b/lisp/gnus/mm-partial.el @@ -1,4 +1,4 @@ -;;; mm-partial.el --- showing message/partial +;;; mm-partial.el --- showing message/partial -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. @@ -39,7 +39,8 @@ gnus-newsgroup-name) (when (search-forward id nil t) (let ((nhandles (mm-dissect-buffer - nil gnus-article-loose-mime)) nid) + nil gnus-article-loose-mime)) + nid) (if (consp (car nhandles)) (mm-destroy-parts nhandles) (setq nid (cdr (assq 'id @@ -49,6 +50,8 @@ (push nhandles phandles)))))))) phandles)) +(defvar gnus-displaying-mime) + ;;;###autoload (defun mm-inline-partial (handle &optional no-display) "Show the partial part of HANDLE. @@ -59,7 +62,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." phandles (b (point)) (n 1) total phandle nn ntotal - gnus-displaying-mime handles buffer) + gnus-displaying-mime handles) ;; buffer (unless (mm-handle-cache handle) (unless id (error "Can not find message/partial id")) @@ -90,7 +93,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." (if ntotal (if total (unless (eq total ntotal) - (error "The numbers of total are different")) + (error "The numbers of total are different")) (setq total ntotal))) (unless (< nn n) (unless (eq nn n) @@ -132,9 +135,11 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." (mm-merge-handles gnus-article-mime-handles handles))) (mm-handle-set-undisplayer handle - `(lambda () - (let (buffer-read-only) - (delete-region ,(point-min-marker) ,(point-max-marker)))))))))) + (let ((beg (point-min-marker)) + (end (point-max-marker))) + (lambda () + (let ((inhibit-read-only t)) + (delete-region beg end)))))))))) (provide 'mm-partial) diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index 412a4744125..3d58738d637 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -1,4 +1,4 @@ -;;; mm-url.el --- a wrapper of url functions/commands for Gnus +;;; mm-url.el --- a wrapper of url functions/commands for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. @@ -44,8 +44,7 @@ (defcustom mm-url-use-external nil "If non-nil, use external grab program `mm-url-program'." :version "22.1" - :type 'boolean - :group 'mm-url) + :type 'boolean) (defvar mm-url-predefined-programs '((wget "wget" "--user-agent=mm-url" "-q" "-O" "-") @@ -68,14 +67,12 @@ Likely values are `wget', `w3m', `lynx' and `curl'." (symbol :tag "w3m" w3m) (symbol :tag "lynx" lynx) (symbol :tag "curl" curl) - (string :tag "other")) - :group 'mm-url) + (string :tag "other"))) (defcustom mm-url-arguments nil "The arguments for `mm-url-program'." :version "22.1" - :type '(repeat string) - :group 'mm-url) + :type '(repeat string)) ;;; Internal variables @@ -299,7 +296,7 @@ If `mm-url-use-external' is non-nil, use `mm-url-program'." args (append (cdr item) (list url)))) (setq program mm-url-program args (append mm-url-arguments (list url)))) - (unless (eq 0 (apply 'call-process program nil t nil args)) + (unless (eq 0 (apply #'call-process program nil t nil args)) (error "Couldn't fetch %s" url)))) (defvar mm-url-timeout 30 diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index db42bfa4b10..92e04f9d2ee 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -144,9 +144,9 @@ is not available." ;; on there being some coding system matching each `mime-charset' ;; property defined, as there should be.) ((and (mm-coding-system-p charset) -;;; Doing this would potentially weed out incorrect charsets. -;;; charset -;;; (eq charset (coding-system-get charset 'mime-charset)) + ;; Doing this would potentially weed out incorrect charsets. + ;; charset + ;; (eq charset (coding-system-get charset 'mime-charset)) ) charset) ;; Use coding system Emacs knows. @@ -160,7 +160,7 @@ is not available." form (prog2 ;; Avoid errors... - (condition-case nil (eval form) (error nil)) + (condition-case nil (eval form t) (error nil)) ;; (message "Failed to eval `%s'" form)) (mm-coding-system-p cs) (message "Added charset `%s' via `mm-charset-eval-alist'" cs)) @@ -380,7 +380,7 @@ like \"€\" to the euro sign, mainly in html messages." "Return the MIME charset corresponding to the given Mule CHARSET." (let ((css (sort (sort-coding-systems (find-coding-systems-for-charsets (list charset))) - 'mm-sort-coding-systems-predicate)) + #'mm-sort-coding-systems-predicate)) cs mime) (while (and (not mime) css) @@ -501,7 +501,7 @@ charset, and a longer list means no appropriate charset." (let ((systems (find-coding-systems-region b e))) (when mm-coding-system-priorities (setq systems - (sort systems 'mm-sort-coding-systems-predicate))) + (sort systems #'mm-sort-coding-systems-predicate))) (setq systems (delq 'compound-text systems)) (unless (equal systems '(undecided)) (while systems @@ -751,7 +751,7 @@ decompressed data. The buffer's multibyteness must be turned off." (insert-buffer-substring cur) (condition-case err (progn - (unless (memq (apply 'call-process-region + (unless (memq (apply #'call-process-region (point-min) (point-max) prog t (list t err-file) nil args) jka-compr-acceptable-retval-list) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 0683703a4ea..3e36d6724ea 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -1,4 +1,4 @@ -;;; mm-view.el --- functions for viewing MIME objects +;;; mm-view.el --- functions for viewing MIME objects -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2021 Free Software Foundation, Inc. @@ -104,11 +104,10 @@ This is only used if `mm-inline-large-images' is set to (insert "\n") (mm-handle-set-undisplayer handle - `(lambda () - (let ((b ,b) - (inhibit-read-only t)) - (remove-images b b) - (delete-region b (1+ b))))))) + (lambda () + (let ((inhibit-read-only t)) + (remove-images b b) + (delete-region b (1+ b))))))) (defvar mm-w3m-setup nil "Whether gnus-article-mode has been setup to use emacs-w3m.") @@ -137,7 +136,7 @@ This is only used if `mm-inline-large-images' is set to (equal "multipart" (mm-handle-media-supertype elem))) (mm-w3m-cid-retrieve-1 url elem))))) -(defun mm-w3m-cid-retrieve (url &rest args) +(defun mm-w3m-cid-retrieve (url &rest _args) "Insert a content pointed by URL if it has the cid: scheme." (when (string-match "\\`cid:" url) (or (catch 'found-handle @@ -149,6 +148,9 @@ This is only used if `mm-inline-large-images' is set to nil (message "Failed to find \"Content-ID: %s\"" url))))) +(defvar w3m-force-redisplay) +(defvar w3m-safe-url-regexp) + (defun mm-inline-text-html-render-with-w3m (handle) "Render a text/html part using emacs-w3m." (mm-setup-w3m) @@ -199,10 +201,11 @@ This is only used if `mm-inline-large-images' is set to 'keymap w3m-minor-mode-map))) (mm-handle-set-undisplayer handle - `(lambda () - (let ((inhibit-read-only t)) - (delete-region ,(point-min-marker) - ,(point-max-marker))))))))) + (let ((beg (point-min-marker)) + (end (point-max-marker))) + (lambda () + (let ((inhibit-read-only t)) + (delete-region beg end))))))))) (defcustom mm-w3m-standalone-supports-m17n-p 'undecided "T means the w3m command supports the m17n feature." @@ -274,13 +277,13 @@ This is only used if `mm-inline-large-images' is set to (write-region (point-min) (point-max) file nil 'silent)) (delete-region (point-min) (point-max)) (unwind-protect - (apply 'call-process cmd nil t nil (mapcar 'eval args)) + (apply #'call-process cmd nil t nil (mapcar (lambda (e) (eval e t)) args)) (delete-file file)) (and post-func (funcall post-func)))) (defun mm-inline-wash-with-stdin (post-func cmd &rest args) (let ((coding-system-for-write 'binary)) - (apply 'call-process-region (point-min) (point-max) + (apply #'call-process-region (point-min) (point-max) cmd t t nil args)) (and post-func (funcall post-func))) @@ -290,7 +293,7 @@ This is only used if `mm-inline-large-images' is set to handle (mm-with-unibyte-buffer (insert source) - (apply 'mm-inline-wash-with-file post-func cmd args) + (apply #'mm-inline-wash-with-file post-func cmd args) (buffer-string))))) (defun mm-inline-render-with-stdin (handle post-func cmd &rest args) @@ -299,7 +302,7 @@ This is only used if `mm-inline-large-images' is set to handle (mm-with-unibyte-buffer (insert source) - (apply 'mm-inline-wash-with-stdin post-func cmd args) + (apply #'mm-inline-wash-with-stdin post-func cmd args) (buffer-string))))) (defun mm-inline-render-with-function (handle func &rest args) @@ -317,7 +320,7 @@ This is only used if `mm-inline-large-images' is set to (defun mm-inline-text-html (handle) (if (stringp (car handle)) - (mapcar 'mm-inline-text-html (cdr handle)) + (mapcar #'mm-inline-text-html (cdr handle)) (let* ((func mm-text-html-renderer) (entry (assq func mm-text-html-renderer-alist)) (inhibit-read-only t)) @@ -378,10 +381,11 @@ This is only used if `mm-inline-large-images' is set to handle (if (= (point-min) (point-max)) #'ignore - `(lambda () - (let ((inhibit-read-only t)) - (delete-region ,(copy-marker (point-min) t) - ,(point-max-marker))))))))) + (let ((beg (copy-marker (point-min) t)) + (end (point-max-marker))) + (lambda () + (let ((inhibit-read-only t)) + (delete-region beg end))))))))) (defun mm-insert-inline (handle text) "Insert TEXT inline from HANDLE." @@ -391,12 +395,13 @@ This is only used if `mm-inline-large-images' is set to (insert "\n")) (mm-handle-set-undisplayer handle - `(lambda () - (let ((inhibit-read-only t)) - (delete-region ,(copy-marker b t) - ,(point-marker))))))) + (let ((beg (copy-marker b t)) + (end (point-marker))) + (lambda () + (let ((inhibit-read-only t)) + (delete-region beg end))))))) -(defun mm-inline-audio (handle) +(defun mm-inline-audio (_handle) (message "Not implemented")) (defun mm-view-message () @@ -413,6 +418,10 @@ This is only used if `mm-inline-large-images' is set to (fundamental-mode) (goto-char (point-min))) +(defvar gnus-original-article-buffer) +(defvar gnus-article-prepare-hook) +(defvar gnus-displaying-mime) + (defun mm-inline-message (handle) (let ((b (point)) (bolp (bolp)) @@ -450,9 +459,11 @@ This is only used if `mm-inline-large-images' is set to (mm-merge-handles gnus-article-mime-handles handles))) (mm-handle-set-undisplayer handle - `(lambda () - (let ((inhibit-read-only t)) - (delete-region ,(point-min-marker) ,(point-max-marker))))))))) + (let ((beg (point-min-marker)) + (end (point-max-marker))) + (lambda () + (let ((inhibit-read-only t)) + (delete-region beg end))))))))) ;; Shut up byte-compiler. (defvar font-lock-mode-hook) diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index c117a3866ab..d41c9dd0d9a 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -1,4 +1,4 @@ -;;; mml-sec.el --- A package with security functions for MML documents +;;; mml-sec.el --- A package with security functions for MML documents -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. @@ -236,7 +236,7 @@ You can also customize or set `mml-signencrypt-style-alist' instead." (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n") nil t)) (goto-char (match-end 0)) - (apply 'mml-insert-tag 'part (cons (if sign 'sign 'encrypt) + (apply #'mml-insert-tag 'part (cons (if sign 'sign 'encrypt) (cons method tags)))) (t (error "The message is corrupted. No mail header separator")))))) @@ -298,14 +298,17 @@ Use METHOD if given. Else use `mml-secure-method' or (interactive) (mml-secure-part "smime")) -(defun mml-secure-is-encrypted-p () - "Check whether secure encrypt tag is present." +(defun mml-secure-is-encrypted-p (&optional tag-present) + "Whether the current buffer contains a mail message that should be encrypted. +If TAG-PRESENT, say whether the <#secure tag is present anywhere +in the buffer." (save-excursion (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n" - "<#secure[^>]+encrypt") - nil t))) + (message-goto-body) + (if tag-present + (re-search-forward "<#secure[^>]+encrypt" nil t) + (skip-chars-forward "[ \t\n") + (looking-at "<#secure[^>]+encrypt")))) (defun mml-secure-bcc-is-safe () "Check whether usage of Bcc is safe (or absent). @@ -346,8 +349,8 @@ either an error is raised or not." (concat "^" (regexp-quote mail-header-separator) "\n") nil t) (goto-char (setq insert-loc (match-end 0))) (unless (looking-at "<#secure") - (apply 'mml-insert-tag - 'secure 'method method 'mode mode tags))) + (apply #'mml-insert-tag + 'secure 'method method 'mode mode tags))) (t (error "The message is corrupted. No mail header separator")))) (when (eql insert-loc (point)) @@ -558,7 +561,7 @@ Return keys." (cl-assert keys) (let* ((usage-prefs (mml-secure-cust-usage-lookup context usage)) (curr-fprs (cdr (assoc name (cdr usage-prefs)))) - (key-fprs (mapcar 'mml-secure-fingerprint keys)) + (key-fprs (mapcar #'mml-secure-fingerprint keys)) (new-fprs (cl-union curr-fprs key-fprs :test 'equal))) (if curr-fprs (setcdr (assoc name (cdr usage-prefs)) new-fprs) @@ -622,7 +625,7 @@ Passphrase caching in Emacs is NOT recommended. Use gpg-agent instead." mml-smime-passphrase-cache-expiry) mml-secure-passphrase-cache-expiry)))) -(defun mml-secure-passphrase-callback (context key-id standard) +(defun mml-secure-passphrase-callback (context key-id _standard) "Ask for passphrase in CONTEXT for KEY-ID for STANDARD. The passphrase is read and cached." ;; Based on mml2015-epg-passphrase-callback. @@ -795,7 +798,7 @@ When `mml-secure-fail-when-key-problem' is t, fail with an error in case of outdated or multiple keys." (let* ((nname (mml-secure-normalize-cust-name name)) (fprs (mml-secure-cust-fpr-lookup context usage nname)) - (usable-fprs (mapcar 'mml-secure-fingerprint keys))) + (usable-fprs (mapcar #'mml-secure-fingerprint keys))) (if fprs (if (gnus-subsetp fprs usable-fprs) (mml-secure-filter-keys keys fprs) @@ -906,7 +909,7 @@ If no one is selected, symmetric encryption will be performed. " (error "No recipient specified"))) recipients)) -(defun mml-secure-epg-encrypt (protocol cont &optional sign) +(defun mml-secure-epg-encrypt (protocol _cont &optional sign) ;; Based on code appearing inside mml2015-epg-encrypt. (let* ((context (epg-make-context protocol)) (config (epg-find-configuration 'OpenPGP)) diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index 5baeaffa53a..5c133e680af 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -1,4 +1,4 @@ -;;; mml-smime.el --- S/MIME support for MML +;;; mml-smime.el --- S/MIME support for MML -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. @@ -129,7 +129,7 @@ Whether the passphrase is cached at all is controlled by (if func (funcall func handle ctl)))) -(defun mml-smime-openssl-sign (cont) +(defun mml-smime-openssl-sign (_cont) (when (null smime-keys) (customize-variable 'smime-keys) (error "No S/MIME keys configured, use customize to add your key")) @@ -179,7 +179,7 @@ Whether the passphrase is cached at all is controlled by (and from (smime-get-key-by-email from))) (smime-get-key-by-email (gnus-completing-read "Sign this part with what signature" - (mapcar 'car smime-keys) nil nil nil + (mapcar #'car smime-keys) nil nil nil (and (listp (car-safe smime-keys)) (caar smime-keys)))))))) @@ -287,7 +287,7 @@ Whether the passphrase is cached at all is controlled by (point-min) (point)) addresses))) (delete-region (point-min) (point))) - (setq addresses (mapcar 'downcase addresses)))) + (setq addresses (mapcar #'downcase addresses)))) (if (not (member (downcase (or (mm-handle-multipart-from ctl) "")) addresses)) (mm-sec-error 'gnus-info "Sender address forged") @@ -299,7 +299,7 @@ Whether the passphrase is cached at all is controlled by (concat "Sender claimed to be: " (mm-handle-multipart-from ctl) "\n" (if addresses (concat "Addresses in certificate: " - (mapconcat 'identity addresses ", ")) + (mapconcat #'identity addresses ", ")) "No addresses found in certificate. (Requires OpenSSL 0.9.6 or later.)") "\n" "\n" "OpenSSL output:\n" @@ -309,7 +309,7 @@ Whether the passphrase is cached at all is controlled by (buffer-string) "\n"))))) handle) -(defun mml-smime-openssl-verify-test (handle ctl) +(defun mml-smime-openssl-verify-test (_handle _ctl) smime-openssl-program) (defvar epg-user-id-alist) @@ -369,8 +369,8 @@ Content-Disposition: attachment; filename=smime.p7s (goto-char (point-max))))) (defun mml-smime-epg-encrypt (cont) - (let* ((inhibit-redisplay t) - (boundary (mml-compute-boundary cont)) + (let* ((inhibit-redisplay t) ;FIXME: Why? + ;; (boundary (mml-compute-boundary cont)) (cipher (mml-secure-epg-encrypt 'CMS cont))) (delete-region (point-min) (point-max)) (goto-char (point-min)) @@ -388,7 +388,7 @@ Content-Disposition: attachment; filename=smime.p7m (defun mml-smime-epg-verify (handle ctl) (catch 'error (let ((inhibit-redisplay t) - context plain signature-file part signature) + context part signature) ;; plain signature-file (when (or (null (setq part (mm-find-raw-part-by-type ctl (or (mm-handle-multipart-ctl-parameter ctl 'protocol) @@ -407,19 +407,20 @@ Content-Disposition: attachment; filename=smime.p7m (setq part (replace-regexp-in-string "\n" "\r\n" part) context (epg-make-context 'CMS)) (condition-case error - (setq plain (epg-verify-string context (mm-get-part signature) part)) + ;; (setq plain + (epg-verify-string context (mm-get-part signature) part) ;;) (error (mm-sec-error 'gnus-info "Failed") - (if (eq (car error) 'quit) - (mm-sec-status 'gnus-details "Quit.") - (mm-sec-status 'gnus-details (format "%S" error))) + (mm-sec-status 'gnus-details (if (eq (car error) 'quit) + "Quit." + (format "%S" error))) (throw 'error handle))) (mm-sec-status 'gnus-info (epg-verify-result-to-string (epg-context-result-for context 'verify))) handle))) -(defun mml-smime-epg-verify-test (handle ctl) +(defun mml-smime-epg-verify-test (_handle _ctl) t) (provide 'mml-smime) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 424215de941..f77e5c6434e 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1,4 +1,4 @@ -;;; mml.el --- A package for parsing and validating MML documents +;;; mml.el --- A package for parsing and validating MML documents -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2021 Free Software Foundation, Inc. @@ -206,8 +206,8 @@ part. This is for the internal use, you should never modify the value.") (defun mml-destroy-buffers () (let (kill-buffer-hook) - (mapc 'kill-buffer mml-buffer-list) - (setq mml-buffer-list nil))) + (mapc #'kill-buffer (prog1 mml-buffer-list + (setq mml-buffer-list nil))))) (defun mml-parse () "Parse the current buffer as an MML document." @@ -241,34 +241,37 @@ part. This is for the internal use, you should never modify the value.") (method (cdr (assq 'method taginfo))) tags) (save-excursion - (if (re-search-forward - "<#/?\\(multipart\\|part\\|external\\|mml\\)." nil t) - (setq secure-mode "multipart") - (setq secure-mode "part"))) + (setq secure-mode + (if (re-search-forward + "<#/?\\(multipart\\|part\\|external\\|mml\\)." + nil t) + "multipart" + "part"))) (save-excursion (goto-char location) (re-search-forward "<#secure[^\n]*>\n")) (delete-region (match-beginning 0) (match-end 0)) - (cond ((string= mode "sign") - (setq tags (list "sign" method))) - ((string= mode "encrypt") - (setq tags (list "encrypt" method))) - ((string= mode "signencrypt") - (setq tags (list "sign" method "encrypt" method))) - (t - (error "Unknown secure mode %s" mode))) - (eval `(mml-insert-tag ,secure-mode - ,@tags - ,(if keyfile "keyfile") - ,keyfile - ,@(apply #'append - (mapcar (lambda (certfile) - (list "certfile" certfile)) - certfiles)) - ,(if recipients "recipients") - ,recipients - ,(if sender "sender") - ,sender)) + (setq tags (cond ((string= mode "sign") + (list "sign" method)) + ((string= mode "encrypt") + (list "encrypt" method)) + ((string= mode "signencrypt") + (list "sign" method "encrypt" method)) + (t + (error "Unknown secure mode %s" mode)))) + (apply #'mml-insert-tag + secure-mode + `(,@tags + ,(if keyfile "keyfile") + ,keyfile + ,@(apply #'append + (mapcar (lambda (certfile) + (list "certfile" certfile)) + certfiles)) + ,(if recipients "recipients") + ,recipients + ,(if sender "sender") + ,sender)) ;; restart the parse (goto-char location))) ((looking-at "<#multipart") @@ -499,7 +502,7 @@ type detected." content-type) (setcdr (assq 'type (cdr (car cont))) content-type)) (when (fboundp 'libxml-parse-html-region) - (setq cont (mapcar 'mml-expand-all-html-into-multipart-related cont))) + (setq cont (mapcar #'mml-expand-all-html-into-multipart-related cont))) (prog1 (with-temp-buffer (set-buffer-multibyte nil) @@ -617,7 +620,7 @@ type detected." (filename (cdr (assq 'filename cont))) (type (or (cdr (assq 'type cont)) (if filename - (or (mm-default-file-encoding filename) + (or (mm-default-file-type filename) "application/octet-stream") "text/plain"))) (charset (cdr (assq 'charset cont))) @@ -775,7 +778,7 @@ type detected." (insert "Content-Type: " (or (cdr (assq 'type cont)) (if name - (or (mm-default-file-encoding name) + (or (mm-default-file-type name) "application/octet-stream") "text/plain")) "\n") @@ -862,7 +865,7 @@ type detected." (cl-incf mml-multipart-number))) (throw 'not-unique nil)))) ((eq (car cont) 'multipart) - (mapc 'mml-compute-boundary-1 (cddr cont)))) + (mapc #'mml-compute-boundary-1 (cddr cont)))) t) (defun mml-make-boundary (number) @@ -1077,7 +1080,7 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (goto-char (point-max)) (insert "<#/mml>\n")) ((stringp (car handle)) - (mapc 'mml-insert-mime (cdr handle)) + (mapc #'mml-insert-mime (cdr handle)) (insert "<#/multipart>\n")) (textp (let ((charset (mail-content-type-get @@ -1304,7 +1307,7 @@ If not set, `default-directory' will be used." (require 'mailcap) (mailcap-parse-mimetypes) (let* ((default (or default - (mm-default-file-encoding name) + (mm-default-file-type name) ;; Perhaps here we should check what the file ;; looks like, and offer text/plain if it looks ;; like text/plain. @@ -1426,7 +1429,7 @@ will be computed and used." (interactive (let* ((file (mml-minibuffer-read-file "Attach file: ")) (type (if current-prefix-arg - (or (mm-default-file-encoding file) + (or (mm-default-file-type file) "application/octet-stream") (mml-minibuffer-read-type file))) (description (if current-prefix-arg @@ -1456,7 +1459,7 @@ will be computed and used." (file-name-nondirectory file))) (goto-char head)))) -(defun mml-dnd-attach-file (uri action) +(defun mml-dnd-attach-file (uri _action) "Attach a drag and drop file. Ask for type, description or disposition according to @@ -1587,6 +1590,16 @@ Should be adopted if code in `message-send-mail' is changed." (declare-function message-generate-headers "message" (headers)) (declare-function message-sort-headers "message" ()) +(defvar gnus-newsgroup-name) +(defvar gnus-displaying-mime) +(defvar gnus-newsgroup-name) +(defvar gnus-article-prepare-hook) +(defvar gnus-newsgroup-charset) +(defvar gnus-original-article-buffer) +(defvar gnus-message-buffer) +(defvar message-this-is-news) +(defvar message-this-is-mail) + (defun mml-preview (&optional raw) "Display current buffer with Gnus, in a new buffer. If RAW, display a raw encoded MIME message. @@ -1598,7 +1611,8 @@ or the `pop-to-buffer' function." (interactive "P") (setq mml-preview-buffer (generate-new-buffer (concat (if raw "*Raw MIME preview of " - "*MIME preview of ") (buffer-name)))) + "*MIME preview of ") + (buffer-name)))) (require 'gnus-msg) ; for gnus-setup-posting-charset (save-excursion (let* ((buf (current-buffer)) @@ -1655,7 +1669,8 @@ or the `pop-to-buffer' function." (use-local-map nil) (add-hook 'kill-buffer-hook (lambda () - (mm-destroy-parts gnus-article-mime-handles)) nil t) + (mm-destroy-parts gnus-article-mime-handles)) + nil t) (setq buffer-read-only t) (local-set-key "q" (lambda () (interactive) (kill-buffer nil))) (local-set-key "=" (lambda () (interactive) (delete-other-windows))) @@ -1704,7 +1719,7 @@ or the `pop-to-buffer' function." cont) (let ((alist mml-tweak-sexp-alist)) (while alist - (if (eval (caar alist)) + (if (eval (caar alist) t) (funcall (cdar alist) cont)) (setq alist (cdr alist))))) cont) diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index a87e642c07d..05f44a1cbd8 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -1,4 +1,4 @@ -;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML +;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2021 Free Software Foundation, Inc. @@ -82,7 +82,7 @@ Whether the passphrase is cached at all is controlled by (defvar mml1991-decrypt-function 'mailcrypt-decrypt) (defvar mml1991-verify-function 'mailcrypt-verify) -(defun mml1991-mailcrypt-sign (cont) +(defun mml1991-mailcrypt-sign (_cont) (let ((text (current-buffer)) headers signature (result-buffer (get-buffer-create "*GPG Result*"))) @@ -118,7 +118,7 @@ Whether the passphrase is cached at all is controlled by (declare-function mc-encrypt-generic "ext:mc-toplev" (&optional recipients scheme start end from sign)) -(defun mml1991-mailcrypt-encrypt (cont &optional sign) +(defun mml1991-mailcrypt-encrypt (_cont &optional sign) (let ((text (current-buffer)) (mc-pgp-always-sign (or mc-pgp-always-sign @@ -171,8 +171,9 @@ Whether the passphrase is cached at all is controlled by (defvar pgg-default-user-id) (defvar pgg-errors-buffer) (defvar pgg-output-buffer) +(defvar pgg-text-mode) -(defun mml1991-pgg-sign (cont) +(defun mml1991-pgg-sign (_cont) (let ((pgg-text-mode t) (pgg-default-user-id (or (message-options-get 'mml-sender) pgg-default-user-id)) @@ -209,7 +210,7 @@ Whether the passphrase is cached at all is controlled by (buffer-string))) t)) -(defun mml1991-pgg-encrypt (cont &optional sign) +(defun mml1991-pgg-encrypt (_cont &optional sign) (goto-char (point-min)) (when (re-search-forward "^$" nil t) (let ((cte (save-restriction @@ -257,7 +258,7 @@ Whether the passphrase is cached at all is controlled by (autoload 'epg-configuration "epg-config") (autoload 'epg-expand-group "epg-config") -(defun mml1991-epg-sign (cont) +(defun mml1991-epg-sign (_cont) (let ((inhibit-redisplay t) headers cte) ;; Don't sign headers. diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 8eda59372fb..1af7d10d055 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -1,4 +1,4 @@ -;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP) +;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP) -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. @@ -185,7 +185,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (cadr err) (format "%S" (cdr err)))) -(defun mml2015-mailcrypt-decrypt (handle ctl) +(defun mml2015-mailcrypt-decrypt (handle _ctl) (catch 'error (let (child handles result) (unless (setq child (mm-find-part-by-type @@ -479,6 +479,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (defvar pgg-default-user-id) (defvar pgg-errors-buffer) (defvar pgg-output-buffer) +(defvar pgg-text-mode) (autoload 'pgg-decrypt-region "pgg") (autoload 'pgg-verify-region "pgg") @@ -486,10 +487,10 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (autoload 'pgg-encrypt-region "pgg") (autoload 'pgg-parse-armor "pgg-parse") -(defun mml2015-pgg-decrypt (handle ctl) +(defun mml2015-pgg-decrypt (handle _ctl) (catch 'error (let ((pgg-errors-buffer mml2015-result-buffer) - child handles result decrypt-status) + child handles decrypt-status) ;; result (unless (setq child (mm-find-part-by-type (cdr handle) "application/octet-stream" nil t)) @@ -751,7 +752,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (let ((key-image (mml2015-epg-key-image key-id))) (if (not key-image) "" - (condition-case error + (condition-case nil (let ((result " ")) (put-text-property 1 2 'display @@ -770,10 +771,10 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (defun mml2015-epg-verify-result-to-string (verify-result) (mapconcat #'mml2015-epg-signature-to-string verify-result "\n")) -(defun mml2015-epg-decrypt (handle ctl) +(defun mml2015-epg-decrypt (handle _ctl) (catch 'error (let ((inhibit-redisplay t) - context plain child handles result decrypt-status) + context plain child handles) ;; decrypt-status result (unless (setq child (mm-find-part-by-type (cdr handle) "application/octet-stream" nil t)) @@ -851,7 +852,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (defun mml2015-epg-verify (handle ctl) (catch 'error (let ((inhibit-redisplay t) - context plain signature-file part signature) + context part signature) ;; plain signature-file (when (or (null (setq part (mm-find-raw-part-by-type ctl (or (mm-handle-multipart-ctl-parameter ctl 'protocol) @@ -866,12 +867,13 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." signature (mm-get-part signature) context (epg-make-context)) (condition-case error - (setq plain (epg-verify-string context signature part)) + ;; (setq plain + (epg-verify-string context signature part) ;;) (error (mm-sec-error 'gnus-info "Failed") - (if (eq (car error) 'quit) - (mm-sec-status 'gnus-details "Quit.") - (mm-sec-status 'gnus-details (mml2015-format-error error))) + (mm-sec-status 'gnus-details (if (eq (car error) 'quit) + "Quit." + (mml2015-format-error error))) (throw 'error handle))) (mm-sec-status 'gnus-info (mml2015-epg-verify-result-to-string @@ -978,7 +980,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." handle))) ;;;###autoload -(defun mml2015-decrypt-test (handle ctl) +(defun mml2015-decrypt-test (_handle _ctl) mml2015-use) ;;;###autoload @@ -990,7 +992,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." handle))) ;;;###autoload -(defun mml2015-verify-test (handle ctl) +(defun mml2015-verify-test (_handle _ctl) mml2015-use) ;;;###autoload diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el index f2acea4fa64..76a7e21567a 100644 --- a/lisp/gnus/nnagent.el +++ b/lisp/gnus/nnagent.el @@ -1,4 +1,4 @@ -;;; nnagent.el --- offline backend for Gnus +;;; nnagent.el --- offline backend for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. @@ -86,7 +86,7 @@ server dir) t)))) -(deffoo nnagent-retrieve-groups (groups &optional server) +(deffoo nnagent-retrieve-groups (_groups &optional _server) (save-excursion (cond ((file-exists-p (gnus-agent-lib-file "groups")) @@ -106,13 +106,13 @@ (funcall (gnus-get-function gnus-command-method 'request-type) (gnus-group-real-name group) article))))) -(deffoo nnagent-request-newgroups (date server) +(deffoo nnagent-request-newgroups (_date _server) nil) -(deffoo nnagent-request-update-info (group info &optional server) +(deffoo nnagent-request-update-info (_group _info &optional _server) nil) -(deffoo nnagent-request-post (&optional server) +(deffoo nnagent-request-post (&optional _server) (gnus-agent-insert-meta-information 'news gnus-command-method) (gnus-request-accept-article "nndraft:queue" nil t t)) @@ -138,13 +138,13 @@ group action server))) nil) -(deffoo nnagent-retrieve-headers (articles &optional group server fetch-old) +(deffoo nnagent-retrieve-headers (articles &optional group _server fetch-old) (let ((file (gnus-agent-article-name ".overview" group)) arts n first) (save-excursion (gnus-agent-load-alist group) (setq arts (gnus-sorted-difference - articles (mapcar 'car gnus-agent-article-alist))) + articles (mapcar #'car gnus-agent-article-alist))) ;; Assume that articles with smaller numbers than the first one ;; Agent knows are gone. (setq first (caar gnus-agent-article-alist)) @@ -184,7 +184,7 @@ t) 'nov))) -(deffoo nnagent-request-expire-articles (articles group &optional server force) +(deffoo nnagent-request-expire-articles (articles _group &optional _server _force) articles) (deffoo nnagent-request-group (group &optional server dont-check info) @@ -249,7 +249,7 @@ (nnoo-parent-function 'nnagent 'nnml-request-regenerate (list (nnagent-server server)))) -(deffoo nnagent-retrieve-group-data-early (server infos) +(deffoo nnagent-retrieve-group-data-early (_server _infos) nil) ;; Use nnml functions for just about everything. diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el index 130f56ad92f..3e6f9e88eea 100644 --- a/lisp/gnus/nnbabyl.el +++ b/lisp/gnus/nnbabyl.el @@ -1,4 +1,4 @@ -;;; nnbabyl.el --- rmail mbox access for Gnus +;;; nnbabyl.el --- rmail mbox access for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -70,7 +70,7 @@ (nnoo-define-basics nnbabyl) -(deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old) +(deffoo nnbabyl-retrieve-headers (articles &optional group server _fetch-old) (with-current-buffer nntp-server-buffer (erase-buffer) (let ((number (length articles)) @@ -185,7 +185,7 @@ (cons nnbabyl-current-group article) (nnbabyl-article-group-number))))))) -(deffoo nnbabyl-request-group (group &optional server dont-check info) +(deffoo nnbabyl-request-group (group &optional server dont-check _info) (let ((active (cadr (assoc group nnbabyl-group-alist)))) (save-excursion (cond @@ -224,10 +224,10 @@ (insert-buffer-substring in-buf))) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))) -(deffoo nnbabyl-close-group (group &optional server) +(deffoo nnbabyl-close-group (_group &optional _server) t) -(deffoo nnbabyl-request-create-group (group &optional server args) +(deffoo nnbabyl-request-create-group (group &optional _server _args) (nnmail-activate 'nnbabyl) (unless (assoc group nnbabyl-group-alist) (push (list group (cons 1 0)) @@ -235,18 +235,20 @@ (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) t) -(deffoo nnbabyl-request-list (&optional server) +(deffoo nnbabyl-request-list (&optional _server) (save-excursion (nnmail-find-file nnbabyl-active-file) (setq nnbabyl-group-alist (nnmail-get-active)) t)) -(deffoo nnbabyl-request-newgroups (date &optional server) +(deffoo nnbabyl-request-newgroups (_date &optional server) (nnbabyl-request-list server)) -(deffoo nnbabyl-request-list-newsgroups (&optional server) +(deffoo nnbabyl-request-list-newsgroups (&optional _server) (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented.")) +(defvar nnml-current-directory) + (deffoo nnbabyl-request-expire-articles (articles newsgroup &optional server force) (nnbabyl-possibly-change-newsgroup newsgroup server) @@ -263,7 +265,8 @@ (nnmail-expired-article-p newsgroup (buffer-substring - (point) (progn (end-of-line) (point))) force)) + (point) (progn (end-of-line) (point))) + force)) (progn (unless (eq nnmail-expiry-target 'delete) (with-temp-buffer @@ -292,7 +295,7 @@ (nconc rest articles)))) (deffoo nnbabyl-request-move-article - (article group server accept-form &optional last move-is-internal) + (article group server accept-form &optional last _move-is-internal) (let ((buf (gnus-get-buffer-create " *nnbabyl move*")) result) (and @@ -304,7 +307,7 @@ "^X-Gnus-Newsgroup:" (save-excursion (search-forward "\n\n" nil t) (point)) t) (delete-region (point-at-bol) (progn (forward-line 1) (point)))) - (setq result (eval accept-form)) + (setq result (eval accept-form t)) (kill-buffer (current-buffer)) result) (save-excursion @@ -554,13 +557,12 @@ (with-current-buffer nnbabyl-mbox-buffer (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file)))) ;; This buffer has changed since we read it last. Possibly. - (save-excursion - (let ((delim (concat "^" nnbabyl-mail-delimiter)) - (alist nnbabyl-group-alist) - start end number) - (set-buffer (setq nnbabyl-mbox-buffer - (nnheader-find-file-noselect - nnbabyl-mbox-file nil t))) + (let ((delim (concat "^" nnbabyl-mail-delimiter)) + (alist nnbabyl-group-alist) + start end number) + (with-current-buffer (setq nnbabyl-mbox-buffer + (nnheader-find-file-noselect + nnbabyl-mbox-file nil t)) ;; Save previous buffer mode. (setq nnbabyl-previous-buffer-mode (cons (cons (point-min) (point-max)) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index b3e83e494d7..15003fabcd2 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -1,4 +1,4 @@ -;;; nndiary.el --- A diary back end for Gnus +;;; nndiary.el --- A diary back end for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -149,7 +149,6 @@ In order to make this clear, here are some examples: - (360 . minute): for an appointment at 18:30 and 15 seconds, this would pop up the appointment message at 12:30." - :group 'nndiary :type '(repeat (cons :format "%v\n" (integer :format "%v") (choice :format "%[%v(s)%] before...\n" @@ -163,8 +162,7 @@ In order to make this clear, here are some examples: (defcustom nndiary-week-starts-on-monday nil "Whether a week starts on monday (otherwise, sunday)." - :type 'boolean - :group 'nndiary) + :type 'boolean) (define-obsolete-variable-alias 'nndiary-request-create-group-hooks @@ -172,7 +170,6 @@ In order to make this clear, here are some examples: (defcustom nndiary-request-create-group-functions nil "Hook run after `nndiary-request-create-group' is executed. The hook functions will be called with the full group name as argument." - :group 'nndiary :type 'hook) (define-obsolete-variable-alias 'nndiary-request-update-info-hooks @@ -180,7 +177,6 @@ The hook functions will be called with the full group name as argument." (defcustom nndiary-request-update-info-functions nil "Hook run after `nndiary-request-update-info' is executed. The hook functions will be called with the full group name as argument." - :group 'nndiary :type 'hook) (define-obsolete-variable-alias 'nndiary-request-accept-article-hooks @@ -189,12 +185,10 @@ The hook functions will be called with the full group name as argument." "Hook run before accepting an article. Executed near the beginning of `nndiary-request-accept-article'. The hook functions will be called with the article in the current buffer." - :group 'nndiary :type 'hook) (defcustom nndiary-check-directory-twice t "If t, check directories twice to avoid NFS failures." - :group 'nndiary :type 'boolean) @@ -475,7 +469,7 @@ all. This may very well take some time.") (cons (if group-num (car group-num) group) (string-to-number (file-name-nondirectory path))))))) -(deffoo nndiary-request-group (group &optional server dont-check info) +(deffoo nndiary-request-group (group &optional server dont-check _info) (let ((file-name-coding-system nnmail-pathname-coding-system)) (cond ((not (nndiary-possibly-change-directory group server)) @@ -509,11 +503,11 @@ all. This may very well take some time.") (nndiary-possibly-change-directory group server) (nnmail-get-new-mail 'nndiary 'nndiary-save-nov nndiary-directory group))) -(deffoo nndiary-close-group (group &optional server) +(deffoo nndiary-close-group (_group &optional _server) (setq nndiary-article-file-alist nil) t) -(deffoo nndiary-request-create-group (group &optional server args) +(deffoo nndiary-request-create-group (group &optional server _args) (nndiary-possibly-change-directory nil server) (nnmail-activate 'nndiary) (cond @@ -532,8 +526,8 @@ all. This may very well take some time.") (nndiary-possibly-change-directory group server) (let ((articles (nnheader-directory-articles nndiary-current-directory))) (when articles - (setcar active (apply 'min articles)) - (setcdr active (apply 'max articles)))) + (setcar active (apply #'min articles)) + (setcdr active (apply #'max articles)))) (nnmail-save-active nndiary-group-alist nndiary-active-file) (run-hook-with-args 'nndiary-request-create-group-functions (gnus-group-prefixed-name group @@ -541,7 +535,7 @@ all. This may very well take some time.") t)) )) -(deffoo nndiary-request-list (&optional server) +(deffoo nndiary-request-list (&optional _server) (save-excursion (let ((nnmail-file-coding-system nnmail-active-file-coding-system) (file-name-coding-system nnmail-pathname-coding-system)) @@ -549,10 +543,10 @@ all. This may very well take some time.") (setq nndiary-group-alist (nnmail-get-active)) t)) -(deffoo nndiary-request-newgroups (date &optional server) +(deffoo nndiary-request-newgroups (_date &optional server) (nndiary-request-list server)) -(deffoo nndiary-request-list-newsgroups (&optional server) +(deffoo nndiary-request-list-newsgroups (&optional _server) (save-excursion (nnmail-find-file nndiary-newsgroups-file))) @@ -589,14 +583,14 @@ all. This may very well take some time.") (let ((active (nth 1 (assoc group nndiary-group-alist)))) (when active (setcar active (or (and active-articles - (apply 'min active-articles)) + (apply #'min active-articles)) (1+ (cdr active))))) (nnmail-save-active nndiary-group-alist nndiary-active-file)) (nndiary-save-nov) (nconc rest articles))) (deffoo nndiary-request-move-article - (article group server accept-form &optional last move-is-internal) + (article group server accept-form &optional last _move-is-internal) (let ((buf (gnus-get-buffer-create " *nndiary move*")) result) (nndiary-possibly-change-directory group server) @@ -609,7 +603,7 @@ all. This may very well take some time.") nndiary-article-file-alist) (with-current-buffer buf (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) + (setq result (eval accept-form t)) (kill-buffer (current-buffer)) result)) (progn @@ -772,7 +766,7 @@ all. This may very well take some time.") ;;; Interface optional functions ============================================ -(deffoo nndiary-request-update-info (group info &optional server) +(deffoo nndiary-request-update-info (group info &optional _server) (nndiary-possibly-change-directory group) (let ((timestamp (gnus-group-parameter-value (gnus-info-params info) 'timestamp t))) @@ -960,7 +954,7 @@ all. This may very well take some time.") (setq nndiary-article-file-alist (sort (nnheader-article-to-file-alist nndiary-current-directory) - 'car-less-than-car))) + #'car-less-than-car))) (setq active (if nndiary-article-file-alist (cons (caar nndiary-article-file-alist) @@ -1039,6 +1033,8 @@ all. This may very well take some time.") ;; Save the active file. (nnmail-save-active nndiary-group-alist nndiary-active-file)) +(defvar nndiary-files) ; dynamically bound in nndiary-generate-nov-databases-1 + (defun nndiary-generate-nov-databases-1 (dir &optional seen no-active) "Regenerate the NOV database in DIR." (interactive "DRegenerate NOV in: ") @@ -1055,7 +1051,7 @@ all. This may very well take some time.") (nndiary-generate-nov-databases-1 dir seen)))) ;; Do this directory. (let ((nndiary-files (sort (nnheader-article-to-file-alist dir) - 'car-less-than-car))) + #'car-less-than-car))) (if (not nndiary-files) (let* ((group (nnheader-file-to-group (directory-file-name dir) nndiary-directory)) @@ -1068,7 +1064,6 @@ all. This may very well take some time.") (unless no-active (nnmail-save-active nndiary-group-alist nndiary-active-file)))))) -(defvar nndiary-files) ; dynamically bound in nndiary-generate-nov-databases-1 (defun nndiary-generate-active-info (dir) ;; Update the active info for this group. (let* ((group (nnheader-file-to-group @@ -1245,7 +1240,7 @@ all. This may very well take some time.") (defun nndiary-unflatten (spec) ;; opposite of flatten: build ranges if possible - (setq spec (sort spec '<)) + (setq spec (sort spec #'<)) (let (min max res) (while (setq min (pop spec)) (setq max min) @@ -1300,7 +1295,7 @@ all. This may very well take some time.") (apply #'encode-time 0 0 0 1 1 (nthcdr 5 date-elts)) (* (car reminder) 400861056)))) res)) - (sort res 'time-less-p))) + (sort res #'time-less-p))) (defun nndiary-last-occurrence (sched) ;; Returns the last occurrence of schedule SCHED as an Emacs time struct, or @@ -1318,8 +1313,8 @@ all. This may very well take some time.") ;; bored in finding a good algorithm for doing that ;-) ;; ### FIXME: remove identical entries. (let ((dom-list (nth 2 sched)) - (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '>)) - (year-list (sort (nndiary-flatten (nth 4 sched) 1971) '>)) + (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) #'>)) + (year-list (sort (nndiary-flatten (nth 4 sched) 1971) #'>)) (dow-list (nth 5 sched))) ;; Special case: an asterisk in one of the days specifications means ;; that only the other should be taken into account. If both are @@ -1370,7 +1365,7 @@ all. This may very well take some time.") (setq day (+ 7 day)))) ;; Finally, if we have some days, they are valid (when days - (sort days '>) + (sort days #'>) (throw 'found (encode-time 0 minute hour (car days) month year time-zone))) @@ -1396,12 +1391,12 @@ all. This may very well take some time.") (this-day (decoded-time-day today)) (this-month (decoded-time-month today)) (this-year (decoded-time-year today)) - (minute-list (sort (nndiary-flatten (nth 0 sched) 0 59) '<)) - (hour-list (sort (nndiary-flatten (nth 1 sched) 0 23) '<)) + (minute-list (sort (nndiary-flatten (nth 0 sched) 0 59) #'<)) + (hour-list (sort (nndiary-flatten (nth 1 sched) 0 23) #'<)) (dom-list (nth 2 sched)) - (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '<)) + (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) #'<)) (years (if (nth 4 sched) - (sort (nndiary-flatten (nth 4 sched) 1971) '<) + (sort (nndiary-flatten (nth 4 sched) 1971) #'<) t)) (dow-list (nth 5 sched)) (year (1- this-year)) @@ -1474,7 +1469,7 @@ all. This may very well take some time.") ;; Aaaaaaall right. Now we have a valid list of DAYS for ;; this month and this year. (when days - (setq days (sort days '<)) + (setq days (sort days #'<)) ;; Remove past days for this year and this month. (and (= year this-year) (= month this-month) diff --git a/lisp/gnus/nndir.el b/lisp/gnus/nndir.el index 46351d0004f..bfc22836583 100644 --- a/lisp/gnus/nndir.el +++ b/lisp/gnus/nndir.el @@ -1,4 +1,4 @@ -;;; nndir.el --- single directory newsgroup access for Gnus +;;; nndir.el --- single directory newsgroup access for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index a3a66454853..172433ef3b8 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -1,4 +1,4 @@ -;;; nndoc.el --- single file access for Gnus +;;; nndoc.el --- single file access for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -225,7 +225,7 @@ from the document.") (nnoo-define-basics nndoc) -(deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old) +(deffoo nndoc-retrieve-headers (articles &optional newsgroup server _fetch-old) (when (nndoc-possibly-change-buffer newsgroup server) (with-current-buffer nntp-server-buffer (erase-buffer) @@ -256,11 +256,10 @@ from the document.") (deffoo nndoc-request-article (article &optional newsgroup server buffer) (nndoc-possibly-change-buffer newsgroup server) - (save-excursion - (let ((buffer (or buffer nntp-server-buffer)) - (entry (cdr (assq article nndoc-dissection-alist))) - beg) - (set-buffer buffer) + (let ((buffer (or buffer nntp-server-buffer)) + (entry (cdr (assq article nndoc-dissection-alist))) + beg) + (with-current-buffer buffer (erase-buffer) (when entry (cond @@ -281,7 +280,7 @@ from the document.") (funcall nndoc-article-transform-function article)) t)))))) -(deffoo nndoc-request-group (group &optional server dont-check info) +(deffoo nndoc-request-group (group &optional server dont-check _info) "Select news GROUP." (let (number) (cond @@ -302,7 +301,7 @@ from the document.") (nndoc-request-group group server)) t) -(deffoo nndoc-request-type (group &optional article) +(deffoo nndoc-request-type (_group &optional article) (cond ((not article) 'unknown) (nndoc-post-type nndoc-post-type) (t 'unknown))) @@ -318,19 +317,19 @@ from the document.") (setq nndoc-dissection-alist nil) t) -(deffoo nndoc-request-list (&optional server) +(deffoo nndoc-request-list (&optional _server) t) -(deffoo nndoc-request-newgroups (date &optional server) +(deffoo nndoc-request-newgroups (_date &optional _server) nil) -(deffoo nndoc-request-list-newsgroups (&optional server) +(deffoo nndoc-request-list-newsgroups (&optional _server) nil) ;;; Internal functions. -(defun nndoc-possibly-change-buffer (group source) +(defun nndoc-possibly-change-buffer (group _source) (let (buf) (cond ;; The current buffer is this group's buffer. @@ -427,9 +426,9 @@ from the document.") (setq result nil)))) (unless (or result results) (error "Document is not of any recognized type")) - (if result - (car entry) - (cadar (last (sort results 'car-less-than-car)))))) + (car (if result + entry + (cdar (last (sort results #'car-less-than-car))))))) ;;; ;;; Built-in type predicates and functions @@ -678,7 +677,7 @@ from the document.") (search-forward "\ncommit " nil t) (search-forward "\nAuthor: " nil t))) -(defun nndoc-transform-git-article (article) +(defun nndoc-transform-git-article (_article) (goto-char (point-min)) (when (re-search-forward "^Author: " nil t) (replace-match "From: " t t))) @@ -702,7 +701,7 @@ from the document.") (re-search-forward "^\\\\\\\\\n\\(Paper\\( (\\*cross-listing\\*)\\)?: [a-zA-Z\\.-]+/[0-9]+\\|arXiv:\\)" nil t)) t)) -(defun nndoc-transform-lanl-gov-announce (article) +(defun nndoc-transform-lanl-gov-announce (_article) (let ((case-fold-search nil)) (goto-char (point-max)) (when (re-search-backward "^\\\\\\\\ +( *\\([^ ]*\\) , *\\([^ ]*\\))" nil t) @@ -859,7 +858,7 @@ from the document.") nil) (goto-char point)))) -(deffoo nndoc-request-accept-article (group &optional server last) +(deffoo nndoc-request-accept-article (_group &optional _server _last) nil) ;;; diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index 1f87beda5f5..394b6fcc4fc 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -1,4 +1,4 @@ -;;; nndraft.el --- draft article access for Gnus +;;; nndraft.el --- draft article access for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -79,7 +79,7 @@ are generated if and only if they are also in `message-draft-headers'." server nndraft-directory) t))) -(deffoo nndraft-retrieve-headers (articles &optional group server fetch-old) +(deffoo nndraft-retrieve-headers (articles &optional group server _fetch-old) (nndraft-possibly-change-group group) (with-current-buffer nntp-server-buffer (erase-buffer) @@ -108,7 +108,7 @@ are generated if and only if they are also in `message-draft-headers'." (nnheader-fold-continuation-lines) 'headers)))) -(deffoo nndraft-request-article (id &optional group server buffer) +(deffoo nndraft-request-article (id &optional group _server buffer) (nndraft-possibly-change-group group) (when (numberp id) ;; We get the newest file of the auto-saved file and the @@ -145,7 +145,7 @@ are generated if and only if they are also in `message-draft-headers'." ;;(message-remove-header "date") t)) -(deffoo nndraft-request-update-info (group info &optional server) +(deffoo nndraft-request-update-info (group info &optional _server) (nndraft-possibly-change-group group) (setf (gnus-info-read info) (gnus-update-read-articles @@ -204,13 +204,13 @@ are generated if and only if they are also in `message-draft-headers'." (setq buffer-file-name (expand-file-name file) buffer-auto-save-file-name (make-auto-save-file-name)) (clear-visited-file-modtime) - (add-hook 'write-contents-functions 'nndraft-generate-headers nil t) - (add-hook 'after-save-hook 'nndraft-update-unread-articles nil t) + (add-hook 'write-contents-functions #'nndraft-generate-headers nil t) + (add-hook 'after-save-hook #'nndraft-update-unread-articles nil t) (message-add-action '(nndraft-update-unread-articles) 'exit 'postpone 'kill) article)) -(deffoo nndraft-request-group (group &optional server dont-check info) +(deffoo nndraft-request-group (group &optional server dont-check _info) (nndraft-possibly-change-group group) (unless dont-check (let* ((pathname (nnmail-group-pathname group nndraft-directory)) @@ -229,7 +229,7 @@ are generated if and only if they are also in `message-draft-headers'." (list group server dont-check))) (deffoo nndraft-request-move-article (article group server accept-form - &optional last move-is-internal) + &optional _last _move-is-internal) (nndraft-possibly-change-group group) (let ((buf (gnus-get-buffer-create " *nndraft move*")) result) @@ -238,7 +238,7 @@ are generated if and only if they are also in `message-draft-headers'." (with-current-buffer buf (erase-buffer) (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) + (setq result (eval accept-form t)) (kill-buffer (current-buffer)) result) (null (nndraft-request-expire-articles (list article) group server 'force)) @@ -292,7 +292,7 @@ are generated if and only if they are also in `message-draft-headers'." (nnoo-parent-function 'nndraft 'nnmh-request-replace-article (list article group buffer)))) -(deffoo nndraft-request-create-group (group &optional server args) +(deffoo nndraft-request-create-group (group &optional _server _args) (nndraft-possibly-change-group group) (if (file-exists-p nndraft-current-directory) (if (file-directory-p nndraft-current-directory) @@ -316,27 +316,25 @@ are generated if and only if they are also in `message-draft-headers'." (nnheader-concat nndraft-directory group)))) (defun nndraft-article-filename (article &rest args) - (apply 'concat + (apply #'concat (file-name-as-directory nndraft-current-directory) (int-to-string article) args)) (defun nndraft-auto-save-file-name (file) - (save-excursion + (with-current-buffer (gnus-get-buffer-create " *draft tmp*") + (setq buffer-file-name file) (prog1 - (progn - (set-buffer (gnus-get-buffer-create " *draft tmp*")) - (setq buffer-file-name file) - (make-auto-save-file-name)) + (make-auto-save-file-name) (kill-buffer (current-buffer))))) (defun nndraft-articles () "Return the list of messages in the group." (gnus-make-directory nndraft-current-directory) (sort - (mapcar 'string-to-number + (mapcar #'string-to-number (directory-files nndraft-current-directory nil "\\`[0-9]+\\'" t)) - '<)) + #'<)) (nnoo-import nndraft (nnmh diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index 014ad3adfb1..d881d6ce055 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -1,4 +1,4 @@ -;;; nneething.el --- arbitrary file access for Gnus +;;; nneething.el --- arbitrary file access for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -77,7 +77,7 @@ included.") (nnoo-define-basics nneething) -(deffoo nneething-retrieve-headers (articles &optional group server fetch-old) +(deffoo nneething-retrieve-headers (articles &optional group _server _fetch-old) (nneething-possibly-change-directory group) (with-current-buffer nntp-server-buffer @@ -114,7 +114,7 @@ included.") (nnheader-fold-continuation-lines) 'headers)))) -(deffoo nneething-request-article (id &optional group server buffer) +(deffoo nneething-request-article (id &optional group _server buffer) (nneething-possibly-change-directory group) (let ((file (unless (stringp id) (nneething-file-name id))) @@ -143,7 +143,7 @@ included.") (insert "\n")) t)))) -(deffoo nneething-request-group (group &optional server dont-check info) +(deffoo nneething-request-group (group &optional server dont-check _info) (nneething-possibly-change-directory group server) (unless dont-check (nneething-create-mapping) @@ -156,16 +156,16 @@ included.") group))) t) -(deffoo nneething-request-list (&optional server dir) +(deffoo nneething-request-list (&optional _server _dir) (nnheader-report 'nneething "LIST is not implemented.")) -(deffoo nneething-request-newgroups (date &optional server) +(deffoo nneething-request-newgroups (_date &optional _server) (nnheader-report 'nneething "NEWSGROUPS is not implemented.")) -(deffoo nneething-request-type (group &optional article) +(deffoo nneething-request-type (_group &optional _article) 'unknown) -(deffoo nneething-close-group (group &optional server) +(deffoo nneething-close-group (_group &optional _server) (setq nneething-current-directory nil) t) diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 9a0219c1436..1dd784d5a5b 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -1,4 +1,4 @@ -;;; nnfolder.el --- mail folder access for Gnus +;;; nnfolder.el --- mail folder access for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -145,7 +145,7 @@ all. This may very well take some time.") 'nov (setq articles (gnus-sorted-intersection ;; Is ARTICLES sorted? - (sort articles '<) + (sort articles #'<) (nnfolder-existing-articles))) (while (setq article (pop articles)) (set-buffer nnfolder-current-buffer) @@ -261,7 +261,7 @@ all. This may very well take some time.") (point) (point-at-eol))) -1)))))))) -(deffoo nnfolder-request-group (group &optional server dont-check info) +(deffoo nnfolder-request-group (group &optional server dont-check _info) (nnfolder-possibly-change-group group server t) (save-excursion (cond ((not (assoc group nnfolder-group-alist)) @@ -314,7 +314,7 @@ all. This may very well take some time.") ;; over the buffer again unless we add new mail to it or modify it in some ;; way. -(deffoo nnfolder-close-group (group &optional server force) +(deffoo nnfolder-close-group (group &optional _server _force) ;; Make sure we _had_ the group open. (when (or (assoc group nnfolder-buffer-alist) (equal group nnfolder-current-group)) @@ -342,7 +342,7 @@ all. This may very well take some time.") nnfolder-current-buffer nil) t) -(deffoo nnfolder-request-create-group (group &optional server args) +(deffoo nnfolder-request-create-group (group &optional server _args) (nnfolder-possibly-change-group nil server) (nnmail-activate 'nnfolder) (cond ((zerop (length group)) @@ -369,7 +369,7 @@ all. This may very well take some time.") (setq nnfolder-group-alist (nnmail-get-active))) t)) -(deffoo nnfolder-request-newgroups (date &optional server) +(deffoo nnfolder-request-newgroups (_date &optional server) (nnfolder-possibly-change-group nil server) (nnfolder-request-list server)) @@ -383,9 +383,8 @@ all. This may very well take some time.") ;; current folder. (defun nnfolder-existing-articles () - (save-excursion - (when nnfolder-current-buffer - (set-buffer nnfolder-current-buffer) + (when nnfolder-current-buffer + (with-current-buffer nnfolder-current-buffer (goto-char (point-min)) (let ((marker (concat "\n" nnfolder-article-marker)) (number "[0-9]+") @@ -395,12 +394,13 @@ all. This may very well take some time.") (let ((newnum (string-to-number (match-string 0)))) (if (nnmail-within-headers-p) (push newnum numbers)))) - ;; The article numbers are increasing, so this result is sorted. + ;; The article numbers are increasing, so this result is sorted. (nreverse numbers))))) (autoload 'gnus-request-group "gnus-int") (declare-function gnus-request-create-group "gnus-int" (group &optional gnus-command-method args)) +(defvar nnfolder-current-directory) (deffoo nnfolder-request-expire-articles (articles newsgroup &optional server force) @@ -463,7 +463,7 @@ all. This may very well take some time.") (gnus-sorted-difference articles (nreverse deleted-articles))))) (deffoo nnfolder-request-move-article (article group server accept-form - &optional last move-is-internal) + &optional last _move-is-internal) (save-excursion (let ((buf (gnus-get-buffer-create " *nnfolder move*")) result) @@ -478,7 +478,7 @@ all. This may very well take some time.") (save-excursion (and (search-forward "\n\n" nil t) (point))) t) (gnus-delete-line)) - (setq result (eval accept-form)) + (setq result (eval accept-form t)) (kill-buffer buf) result) (save-excursion @@ -499,7 +499,7 @@ all. This may very well take some time.") (save-excursion (nnfolder-possibly-change-group group server) (nnmail-check-syntax) - (let ((buf (current-buffer)) + (let (;; (buf (current-buffer)) result art-group) (goto-char (point-min)) (when (looking-at "X-From-Line: ") diff --git a/lisp/gnus/nngateway.el b/lisp/gnus/nngateway.el index 15e4876642c..c10989aa1e9 100644 --- a/lisp/gnus/nngateway.el +++ b/lisp/gnus/nngateway.el @@ -1,4 +1,4 @@ -;;; nngateway.el --- posting news via mail gateways +;;; nngateway.el --- posting news via mail gateways -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index a381720f24c..708887cb9c7 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -1,4 +1,4 @@ -;;; nnheader.el --- header access macros for Gnus and its backends +;;; nnheader.el --- header access macros for Gnus and its backends -*- lexical-binding: t; -*- ;; Copyright (C) 1987-1990, 1993-1998, 2000-2021 Free Software ;; Foundation, Inc. @@ -468,7 +468,7 @@ leaving the original buffer untouched." (defun nnheader-write-overview-file (file headers) "Write HEADERS to FILE." (with-temp-file file - (mapcar 'nnheader-insert-nov headers))) + (mapcar #'nnheader-insert-nov headers))) (defun nnheader-insert-header (header) (insert @@ -723,15 +723,15 @@ an alarming frequency on NFS mounted file systems. If it is nil, (defun nnheader-directory-files-safe (&rest args) "Execute `directory-files' twice and returns the longer result." - (let ((first (apply 'directory-files args)) - (second (apply 'directory-files args))) + (let ((first (apply #'directory-files args)) + (second (apply #'directory-files args))) (if (> (length first) (length second)) first second))) (defun nnheader-directory-articles (dir) "Return a list of all article files in directory DIR." - (mapcar 'nnheader-file-to-number + (mapcar #'nnheader-file-to-number (if nnheader-directory-files-is-safe (directory-files dir nil nnheader-numerical-short-files t) @@ -783,7 +783,7 @@ The first string in ARGS can be a format string." (set (intern (format "%s-status-string" backend)) (if (< (length args) 2) (car args) - (apply 'format args))) + (apply #'format args))) nil) (defun nnheader-get-report-string (backend) @@ -804,8 +804,8 @@ without formatting." (with-current-buffer nntp-server-buffer (erase-buffer) (if (string-match "%" format) - (insert (apply 'format format args)) - (apply 'insert format args)) + (insert (apply #'format format args)) + (apply #'insert format args)) t)) (defsubst nnheader-replace-chars-in-string (string from to) @@ -841,12 +841,13 @@ without formatting." (defun nnheader-message (level &rest args) "Message if the Gnus backends are talkative." - (if (or (not (numberp gnus-verbose-backends)) - (<= level gnus-verbose-backends)) - (if gnus-add-timestamp-to-message - (apply 'gnus-message-with-timestamp args) - (apply 'message args)) - (apply 'format args))) + (apply (cond + ((and (numberp gnus-verbose-backends) + (> level gnus-verbose-backends)) + #'format) + (gnus-add-timestamp-to-message #'gnus-message-with-timestamp) + (t #'message)) + args)) (defun nnheader-be-verbose (level) "Return whether the backends should be verbose on LEVEL." @@ -877,7 +878,7 @@ without formatting." (defun nnheader-concat (dir &rest files) "Concat DIR as directory to FILES." - (apply 'concat (file-name-as-directory dir) files)) + (apply #'concat (file-name-as-directory dir) files)) (defun nnheader-ms-strip-cr () "Strip ^M from the end of all lines." @@ -915,7 +916,7 @@ first. Otherwise, find the newest one, though it may take a time." (setq path (cdr path)))) (if (or first (not (cdr results))) (car results) - (car (sort results 'file-newer-than-file-p))))) + (car (sort results #'file-newer-than-file-p))))) (defvar ange-ftp-path-format) (defvar efs-path-regexp) @@ -961,15 +962,15 @@ find-file-hook, etc. "Open a file with some variables bound. See `find-file-noselect' for the arguments." (cl-letf* ((format-alist nil) - (auto-mode-alist (mm-auto-mode-alist)) - ((default-value 'major-mode) 'fundamental-mode) - (enable-local-variables nil) - (after-insert-file-functions nil) - (enable-local-eval nil) - (coding-system-for-read nnheader-file-coding-system) - (version-control 'never) - (find-file-hook nil)) - (apply 'find-file-noselect args))) + (auto-mode-alist (mm-auto-mode-alist)) + ((default-value 'major-mode) 'fundamental-mode) + (enable-local-variables nil) + (after-insert-file-functions nil) + (enable-local-eval nil) + (coding-system-for-read nnheader-file-coding-system) + (version-control 'never) + (find-file-hook nil)) + (apply #'find-file-noselect args))) (defun nnheader-directory-regular-files (dir) "Return a list of all regular files in DIR." @@ -983,7 +984,7 @@ See `find-file-noselect' for the arguments." (defun nnheader-directory-files (&rest args) "Same as `directory-files', but prune \".\" and \"..\"." - (let ((files (apply 'directory-files args)) + (let ((files (apply #'directory-files args)) out) (while files (unless (member (file-name-nondirectory (car files)) '("." "..")) @@ -1065,7 +1066,7 @@ See `find-file-noselect' for the arguments." (let ((now (current-time))) (when (time-less-p 1 (time-subtract now nnheader-last-message-time)) (setq nnheader-last-message-time now) - (apply 'nnheader-message args)))) + (apply #'nnheader-message args)))) (make-obsolete-variable 'nnheader-load-hook "use `with-eval-after-load' instead." "28.1") diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 121513117b2..f4f4ef89a9e 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -1,4 +1,4 @@ -;;; nnimap.el --- IMAP interface for Gnus +;;; nnimap.el --- IMAP interface for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2021 Free Software Foundation, Inc. @@ -143,8 +143,7 @@ textual parts.") (defcustom nnimap-request-articles-find-limit nil "Limit the number of articles to look for after moving an article." :type '(choice (const nil) integer) - :version "24.4" - :group 'nnimap) + :version "24.4") (define-obsolete-variable-alias 'nnimap-split-download-body-default 'nnimap-split-download-body @@ -1005,7 +1004,7 @@ during splitting, which may be slow." internal-move-group server message-id nnimap-request-articles-find-limit))))) ;; Move the article to a different method. - (when-let* ((result (eval accept-form))) + (when-let* ((result (eval accept-form t))) (nnimap-change-group group server) (nnimap-delete-article article) result)))))) @@ -1166,7 +1165,7 @@ If LIMIT, first try to limit the search to the N last articles." 7 "Article marked for deletion, but not expunged.") nil)))) -(deffoo nnimap-request-scan (&optional group server) +(deffoo nnimap-request-scan (&optional _group server) (when (and (nnimap-change-group nil server) nnimap-inbox nnimap-split-methods) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index d043ae1b426..9826bc6172c 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -1,4 +1,4 @@ -;;; nnmail.el --- mail support functions for the Gnus mail backends +;;; nnmail.el --- mail support functions for the Gnus mail backends -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -598,7 +598,7 @@ These will be logged to the \"*nnmail split*\" buffer." -(defun nnmail-request-post (&optional server) +(defun nnmail-request-post (&optional _server) (mail-send-and-exit nil)) (defvar nnmail-file-coding-system 'raw-text @@ -664,7 +664,7 @@ nn*-request-list should have been called before calling this function." (let ((buffer (current-buffer)) group-assoc group max min) (while (not (eobp)) - (condition-case err + (condition-case nil (progn (narrow-to-region (point) (point-at-eol)) (setq group (read buffer) @@ -712,7 +712,7 @@ If SOURCE is a directory spec, try to return the group name component." (if (eq (car source) 'directory) (let ((file (file-name-nondirectory file))) (mail-source-bind (directory source) - (if (string-match (concat (regexp-quote suffix) "$") file) + (if (string-match (concat (regexp-quote suffix) "\\'") file) (substring file 0 (match-beginning 0)) nil))) nil)) @@ -1281,7 +1281,7 @@ Return the number of characters in the body." "Remove list identifiers from Subject headers." (let ((regexp (if (consp nnmail-list-identifiers) - (mapconcat 'identity nnmail-list-identifiers " *\\|") + (mapconcat #'identity nnmail-list-identifiers " *\\|") nnmail-list-identifiers))) (when regexp (goto-char (point-min)) @@ -1321,8 +1321,8 @@ Eudora has a broken References line, but an OK In-Reply-To." (when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t) (replace-match "\\1" t)))) -(defalias 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references) -(make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references "Emacs 23.1") +(defalias 'nnmail-fix-eudora-headers #'nnmail-ignore-broken-references) +(make-obsolete 'nnmail-fix-eudora-headers #'nnmail-ignore-broken-references "Emacs 23.1") (custom-add-option 'nnmail-prepare-incoming-header-hook 'nnmail-ignore-broken-references) @@ -1332,14 +1332,15 @@ Eudora has a broken References line, but an OK In-Reply-To." (declare-function gnus-activate-group "gnus-start" (group &optional scan dont-check method dont-sub-check)) -(defun nnmail-do-request-post (accept-func &optional server) +(defun nnmail-do-request-post (accept-func &optional _server) "Utility function to directly post a message to an nnmail-derived group. Calls ACCEPT-FUNC (which should be `nnchoke-request-accept-article') to actually put the message in the right group." (let ((success t)) (dolist (mbx (message-unquote-tokens (message-tokenize-header - (message-fetch-field "Newsgroups") ", ")) success) + (message-fetch-field "Newsgroups") ", ")) + success) (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method))) (or (gnus-active to-newsgroup) (gnus-activate-group to-newsgroup) @@ -1396,7 +1397,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." ;; Builtin : operation. ((eq (car split) ':) (nnmail-log-split split) - (nnmail-split-it (save-excursion (eval (cdr split))))) + (nnmail-split-it (save-excursion (eval (cdr split) t)))) ;; Builtin ! operation. ((eq (car split) '!) @@ -1433,11 +1434,11 @@ See the documentation for the variable `nnmail-split-fancy' for details." ;; we do not exclude foo.list just because ;; the header is: ``To: x-foo, foo'' (goto-char end) - (if (and (re-search-backward (cadr split-rest) - after-header-name t) - (> (match-end 0) start-of-value)) - (setq split-rest nil) - (setq split-rest (cddr split-rest)))) + (setq split-rest + (unless (and (re-search-backward (cadr split-rest) + after-header-name t) + (> (match-end 0) start-of-value)) + (cddr split-rest)))) (when split-rest (goto-char end) ;; Someone might want to do a \N sub on this match, so @@ -1528,7 +1529,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." expanded)))) (setq pos (1+ pos))) (if did-expand - (apply 'concat (nreverse expanded)) + (apply #'concat (nreverse expanded)) newtext))) ;; Activate a backend only if it isn't already activated. @@ -1623,7 +1624,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." (gnus-methods-equal-p gnus-command-method (nnmail-cache-primary-mail-backend))) (let ((regexp (if (consp nnmail-cache-ignore-groups) - (mapconcat 'identity nnmail-cache-ignore-groups + (mapconcat #'identity nnmail-cache-ignore-groups "\\|") nnmail-cache-ignore-groups))) (unless (and regexp (string-match regexp grp)) @@ -1766,7 +1767,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (defvar nnmail-fetched-sources nil) (defun nnmail-get-value (&rest args) - (let ((sym (intern (apply 'format args)))) + (let ((sym (intern (apply #'format args)))) (when (boundp sym) (symbol-value sym)))) @@ -1811,10 +1812,10 @@ be called once per group or once for all groups." (setq source (append source (list :predicate - (gnus-byte-compile - `(lambda (file) + (let ((str (concat group suffix))) + (lambda (file) (string-equal - ,(concat group suffix) + str (file-name-nondirectory file))))))))) (when nnmail-fetched-sources (if (member source nnmail-fetched-sources) @@ -1835,17 +1836,19 @@ be called once per group or once for all groups." (condition-case cond (mail-source-fetch source - (gnus-byte-compile - `(lambda (file orig-file) + (let ((smsym (intern (format "%s-save-mail" method))) + (ansym (intern (format "%s-active-number" method))) + (src source)) + (lambda (file orig-file) (nnmail-split-incoming - file ',(intern (format "%s-save-mail" method)) - ',spool-func + file smsym + spool-func (or in-group (if (equal file orig-file) nil (nnmail-get-split-group orig-file - ',source))) - ',(intern (format "%s-active-number" method)))))) + src))) + ansym)))) ((error quit) (message "Mail source %s failed: %s" source cond) 0))) @@ -1917,7 +1920,7 @@ If TIME is nil, then return the cutoff time for oldness instead." (cdr group-art)) (gnus-group-mark-article-read target (cdr group-art)))))))) -(defun nnmail-fancy-expiry-target (group) +(defun nnmail-fancy-expiry-target (_group) "Return a target expiry group determined by `nnmail-fancy-expiry-targets'." (let* (header (case-fold-search nil) diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 2a4c74db5e8..46691e3494b 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -48,16 +48,6 @@ ;;; Code: -;; eval this before editing -[(progn - (put 'nnmaildir--with-nntp-buffer 'lisp-indent-function 0) - (put 'nnmaildir--with-work-buffer 'lisp-indent-function 0) - (put 'nnmaildir--with-nov-buffer 'lisp-indent-function 0) - (put 'nnmaildir--with-move-buffer 'lisp-indent-function 0) - (put 'nnmaildir--condcase 'lisp-indent-function 2) - ) -] - (require 'nnheader) (require 'gnus) (require 'gnus-util) @@ -111,7 +101,7 @@ SUFFIX should start with \":2,\"." (new-flags (concat (gnus-delete-duplicates ;; maildir flags must be sorted - (sort (cons flag flags-as-list) '<))))) + (sort (cons flag flags-as-list) #'<))))) (concat ":2," new-flags))) (defun nnmaildir--remove-flag (flag suffix) @@ -264,19 +254,19 @@ This variable is set by `nnmaildir-request-article'.") (eval param t)) (defmacro nnmaildir--with-nntp-buffer (&rest body) - (declare (debug (body))) + (declare (indent 0) (debug t)) `(with-current-buffer nntp-server-buffer ,@body)) (defmacro nnmaildir--with-work-buffer (&rest body) - (declare (debug (body))) + (declare (indent 0) (debug t)) `(with-current-buffer (gnus-get-buffer-create " *nnmaildir work*") ,@body)) (defmacro nnmaildir--with-nov-buffer (&rest body) - (declare (debug (body))) + (declare (indent 0) (debug t)) `(with-current-buffer (gnus-get-buffer-create " *nnmaildir nov*") ,@body)) (defmacro nnmaildir--with-move-buffer (&rest body) - (declare (debug (body))) + (declare (indent 0) (debug t)) `(with-current-buffer (gnus-get-buffer-create " *nnmaildir move*") ,@body)) @@ -302,7 +292,7 @@ This variable is set by `nnmaildir-request-article'.") (write-region "" nil file nil 'no-message)) (defun nnmaildir--delete-dir-files (dir ls) (when (file-attributes dir) - (mapc 'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort)) + (mapc #'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort)) (delete-directory dir))) (defun nnmaildir--group-maxnum (server group) @@ -358,7 +348,7 @@ This variable is set by `nnmaildir-request-article'.") string) (defmacro nnmaildir--condcase (errsym body &rest handler) - (declare (debug (sexp form body))) + (declare (indent 2) (debug (sexp form body))) `(condition-case ,errsym (let ((system-messages-locale "C")) ,body) (error . ,handler))) @@ -865,8 +855,8 @@ This variable is set by `nnmaildir-request-article'.") file)) files) files (delq nil files) - files (mapcar 'nnmaildir--parse-filename files) - files (sort files 'nnmaildir--sort-files)) + files (mapcar #'nnmaildir--parse-filename files) + files (sort files #'nnmaildir--sort-files)) (dolist (file files) (setq file (if (consp file) file (aref file 3)) x (make-nnmaildir--art :prefix (car file) :suffix (cdr file))) @@ -1008,7 +998,7 @@ This variable is set by `nnmaildir-request-article'.") always-marks (nnmaildir--param pgname 'always-marks) never-marks (nnmaildir--param pgname 'never-marks) existing (nnmaildir--grp-nlist group) - existing (mapcar 'car existing) + existing (mapcar #'car existing) existing (nreverse existing) existing (gnus-compress-sequence existing 'always-list) missing (list (cons 1 (nnmaildir--group-maxnum @@ -1023,8 +1013,8 @@ This variable is set by `nnmaildir-request-article'.") ;; get mark names from mark dirs and from flag ;; mappings (append - (mapcar 'cdr nnmaildir-flag-mark-mapping) - (mapcar 'intern (funcall ls dir nil "\\`[^.]" 'nosort)))) + (mapcar #'cdr nnmaildir-flag-mark-mapping) + (mapcar #'intern (funcall ls dir nil "\\`[^.]" 'nosort)))) new-mmth (make-hash-table :size (length all-marks)) old-mmth (nnmaildir--grp-mmth group)) (dolist (mark all-marks) @@ -1080,7 +1070,7 @@ This variable is set by `nnmaildir-request-article'.") (let ((article (nnmaildir--flist-art flist prefix))) (when article (push (nnmaildir--art-num article) article-list)))))) - (setq ranges (gnus-add-to-range ranges (sort article-list '<))))) + (setq ranges (gnus-add-to-range ranges (sort article-list #'<))))) (if (eq mark 'read) (setq read ranges) (if ranges (setq marks (cons (cons mark ranges) marks))))) (setf (gnus-info-read info) (gnus-range-add read missing)) @@ -1705,8 +1695,8 @@ This variable is set by `nnmaildir-request-article'.") ;; get mark names from mark dirs and from flag ;; mappings (append - (mapcar 'cdr nnmaildir-flag-mark-mapping) - (mapcar 'intern all-marks)))) + (mapcar #'cdr nnmaildir-flag-mark-mapping) + (mapcar #'intern all-marks)))) (dolist (action actions) (setq ranges (car action) todo-marks (caddr action)) diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index c061031b40a..c6aaf460ece 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -1,4 +1,4 @@ -;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader +;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -193,8 +193,8 @@ (define-key gnus-summary-mode-map (kbd "G G u") 'nnmairix-remove-tick-mark-original-article)) -(add-hook 'gnus-group-mode-hook 'nnmairix-group-mode-hook) -(add-hook 'gnus-summary-mode-hook 'nnmairix-summary-mode-hook) +(add-hook 'gnus-group-mode-hook #'nnmairix-group-mode-hook) +(add-hook 'gnus-summary-mode-hook #'nnmairix-summary-mode-hook) ;; ;;;###autoload ;; (defun nnmairix-initialize (&optional force) @@ -202,8 +202,8 @@ ;; (if (not (or (file-readable-p "~/.mairixrc") ;; force)) ;; (message "No file `~/.mairixrc', skipping nnmairix setup") -;; (add-hook 'gnus-group-mode-hook 'nnmairix-group-mode-hook) -;; (add-hook 'gnus-summary-mode-hook 'nnmairix-summary-mode-hook))) +;; (add-hook 'gnus-group-mode-hook #'nnmairix-group-mode-hook) +;; (add-hook 'gnus-summary-mode-hook #'nnmairix-summary-mode-hook))) ;; Customizable stuff @@ -219,20 +219,17 @@ server will be this prefix plus a random number. You can delete unused nnmairix groups on the back end using `nnmairix-purge-old-groups'." :version "23.1" - :type 'string - :group 'nnmairix) + :type 'string) (defcustom nnmairix-mairix-output-buffer "*mairix output*" "Buffer used for mairix output." :version "23.1" - :type 'string - :group 'nnmairix) + :type 'string) (defcustom nnmairix-customize-query-buffer "*mairix query*" "Name of the buffer for customizing Mairix queries." :version "23.1" - :type 'string - :group 'nnmairix) + :type 'string) (defcustom nnmairix-mairix-update-options '("-F" "-Q") "Options when calling mairix for updating the database. @@ -240,21 +237,18 @@ The default is \"-F\" and \"-Q\" for making updates faster. You should call mairix without these options from time to time (e.g. via cron job)." :version "23.1" - :type '(repeat string) - :group 'nnmairix) + :type '(repeat string)) (defcustom nnmairix-mairix-search-options '("-Q") "Options when calling mairix for searching. The default is \"-Q\" for making searching faster." :version "23.1" - :type '(repeat string) - :group 'nnmairix) + :type '(repeat string)) (defcustom nnmairix-mairix-synchronous-update nil "Set this to t if you want Emacs to wait for mairix updating the database." :version "23.1" - :type 'boolean - :group 'nnmairix) + :type 'boolean) (defcustom nnmairix-rename-files-for-nnml t "Rename nnml mail files so that they are consecutively numbered. @@ -263,8 +257,7 @@ article numbers which will produce wrong article counts by Gnus. This option controls whether nnmairix should rename the files consecutively." :version "23.1" - :type 'boolean - :group 'nnmairix) + :type 'boolean) (defcustom nnmairix-widget-fields-list '(("from" "f" "From") ("to" "t" "To") ("cc" "c" "Cc") @@ -288,16 +281,14 @@ nil for disabling this)." (const :tag "Subject" "subject") (const :tag "Message ID" "Message-ID")) (string :tag "Command") - (string :tag "Description"))) - :group 'nnmairix) + (string :tag "Description")))) (defcustom nnmairix-widget-select-window-function (lambda () (select-window (get-largest-window))) "Function for selecting the window for customizing the mairix query. The default chooses the largest window in the current frame." :version "23.1" - :type 'function - :group 'nnmairix) + :type 'function) (defcustom nnmairix-propagate-marks-upon-close t "Flag if marks should be propagated upon closing a group. @@ -308,8 +299,7 @@ call `nnmairix-propagate-marks'." :version "23.1" :type '(choice (const :tag "always" t) (const :tag "ask" ask) - (const :tag "never" nil)) - :group 'nnmairix) + (const :tag "never" nil))) (defcustom nnmairix-propagate-marks-to-nnmairix-groups nil "Flag if marks from original articles should be seen in nnmairix groups. @@ -319,8 +309,7 @@ e.g. an IMAP server (which stores the marks in the maildir file name). You may safely set this to t for testing - the worst that can happen are wrong marks in nnmairix groups." :version "23.1" - :type 'boolean - :group 'nnmairix) + :type 'boolean) (defcustom nnmairix-only-use-registry nil "Use only the registry for determining original group(s). @@ -330,16 +319,14 @@ propagating marks). If set to nil, it will also try to determine the group from an additional mairix search which might be slow when propagating lots of marks." :version "23.1" - :type 'boolean - :group 'nnmairix) + :type 'boolean) (defcustom nnmairix-allowfast-default nil "Whether fast entering should be the default for nnmairix groups. You may set this to t to make entering the group faster, but note that this might lead to problems, especially when used with marks propagation." :version "23.1" - :type 'boolean - :group 'nnmairix) + :type 'boolean) ;; ==== Other variables @@ -417,7 +404,7 @@ Other back ends might or might not work.") (setq nnmairix-current-server server) (nnoo-change-server 'nnmairix server definitions)) -(deffoo nnmairix-request-group (group &optional server fast info) +(deffoo nnmairix-request-group (group &optional server fast _info) ;; Call mairix and request group on back end server (when server (nnmairix-open-server server)) (let* ((qualgroup (if server @@ -430,7 +417,7 @@ Other back ends might or might not work.") (backendmethod (gnus-server-to-method (format "%s:%s" (symbol-name nnmairix-backend) nnmairix-backend-server))) - rval mfolder folderpath args) + rval mfolder folderpath) ;; args (cond ((not folder) ;; No folder parameter -> error @@ -510,12 +497,12 @@ Other back ends might or might not work.") nil)))))) -(deffoo nnmairix-request-create-group (group &optional server args) +(deffoo nnmairix-request-create-group (group &optional server _args) (let ((qualgroup (if server (gnus-group-prefixed-name group (list 'nnmairix server)) group)) (exist t) (count 0) - groupname info) + groupname) ;; info (when server (nnmairix-open-server server)) (gnus-group-add-parameter qualgroup '(query . nil)) (gnus-group-add-parameter qualgroup '(threads . nil)) @@ -574,7 +561,7 @@ Other back ends might or might not work.") (deffoo nnmairix-request-list (&optional server) (when server (nnmairix-open-server server)) (if (nnmairix-call-backend "request-list" nnmairix-backend-server) - (let (cpoint cur qualgroup folder) + (let (cpoint cur qualgroup) ;; folder (with-current-buffer nntp-server-buffer (goto-char (point-min)) (setq cpoint (point)) @@ -603,7 +590,7 @@ Other back ends might or might not work.") (nnmairix-open-server server)) (let* ((qualgroup (gnus-group-prefixed-name group (list 'nnmairix nnmairix-current-server))) (propmarks (gnus-group-get-parameter qualgroup 'propmarks)) - (propto (gnus-group-get-parameter qualgroup 'propto t)) + ;; (propto (gnus-group-get-parameter qualgroup 'propto t)) (corr (nnmairix-get-numcorr group server)) (folder (nnmairix-get-backend-folder group server))) (save-excursion @@ -611,7 +598,7 @@ Other back ends might or might not work.") (let ((type (nth 1 cur)) (cmdmarks (nth 2 cur)) (range (gnus-uncompress-range (nth 0 cur))) - mid ogroup number method temp) + mid ogroup temp) ;; number method (when (and corr (not (zerop (cadr corr)))) (setq range (mapcar (lambda (arg) @@ -674,7 +661,7 @@ Other back ends might or might not work.") (nnmairix-open-server server)) (let* ((qualgroup (gnus-group-prefixed-name group (list 'nnmairix nnmairix-current-server))) (propmarks (gnus-group-get-parameter qualgroup 'propmarks)) - method) + ) ;; method (when (and propmarks nnmairix-marks-cache) (when (or (eq nnmairix-propagate-marks-upon-close t) @@ -689,9 +676,9 @@ Other back ends might or might not work.") (autoload 'nnimap-request-update-info-internal "nnimap") (deffoo nnmairix-request-marks (group info &optional server) -;; propagate info from underlying IMAP folder to nnmairix group -;; This is currently experimental and must be explicitly activated -;; with nnmairix-propagate-marks-to-nnmairix-group + ;; propagate info from underlying IMAP folder to nnmairix group + ;; This is currently experimental and must be explicitly activated + ;; with nnmairix-propagate-marks-to-nnmairix-group (when server (nnmairix-open-server server)) (let* ((qualgroup (gnus-group-prefixed-name @@ -703,7 +690,7 @@ Other back ends might or might not work.") (corr (nnmairix-get-numcorr group server)) (docorr (and corr (not (zerop (cadr corr))))) (folderinfo `(,group 1 ((1 . 1)))) - readrange marks) + ) ;; readrange marks (when (and propmarks nnmairix-propagate-marks-to-nnmairix-groups) ;; these groups are not subscribed, so we have to ask the back end directly @@ -714,8 +701,8 @@ Other back ends might or might not work.") (setf (gnus-info-read info) (if docorr (nnmairix-map-range - ;; FIXME: Use lexical-binding. - `(lambda (x) (+ x ,(cadr corr))) + (let ((off (cadr corr))) + (lambda (x) (+ x off))) (gnus-info-read folderinfo)) (gnus-info-read folderinfo))) ;; set other marks @@ -725,8 +712,8 @@ Other back ends might or might not work.") (cons (car cur) (nnmairix-map-range - ;; FIXME: Use lexical-binding. - `(lambda (x) (+ x ,(cadr corr))) + (let ((off (cadr corr))) + (lambda (x) (+ x off))) (list (cadr cur))))) (gnus-info-marks folderinfo)) (gnus-info-marks folderinfo)))) @@ -757,10 +744,9 @@ called interactively, user will be asked for parameters." (when (not (listp query)) (setq query (list query))) (when (and server group query) - (save-excursion - (let ((groupname (gnus-group-prefixed-name group server)) - info) - (set-buffer gnus-group-buffer) + (let ((groupname (gnus-group-prefixed-name group server)) + ) ;; info + (with-current-buffer gnus-group-buffer (gnus-group-make-group group server) (gnus-group-set-parameter groupname 'query query) (gnus-group-set-parameter groupname 'threads threads) @@ -783,7 +769,7 @@ called interactively, user will be asked for parameters." (setq finished (not (y-or-n-p "Add another search query? ")) achar nil)) (nnmairix-search - (mapconcat 'identity query " ") + (mapconcat #'identity query " ") (car (nnmairix-get-server)) (y-or-n-p "Include whole threads? ")))) @@ -792,7 +778,7 @@ called interactively, user will be asked for parameters." (interactive) (let ((char-header nnmairix-interactive-query-parameters) (server (nnmairix-backend-to-server gnus-current-select-method)) - query achar header finished group threads cq) + query achar header finished group threads) ;; cq (when (or (not (gnus-buffer-live-p gnus-article-buffer)) (not (gnus-buffer-live-p gnus-summary-buffer))) (error "No article or summary buffer")) @@ -810,7 +796,8 @@ called interactively, user will be asked for parameters." (setq achar nil))) (set-buffer gnus-article-buffer) (setq header nil) - (when (setq cq (nth 1 (assoc achar char-header))) + (when ;; (setq cq + (nth 1 (assoc achar char-header)) ;;) (setq header (nnmairix-replace-illegal-chars (gnus-fetch-field (nth 1 (assoc achar char-header)))))) @@ -824,7 +811,7 @@ called interactively, user will be asked for parameters." (setq group (read-string "Group name: ")) (set-buffer gnus-summary-buffer) (message "Creating group %s on server %s with query %s." group - (gnus-method-to-server server) (mapconcat 'identity query " ")) + (gnus-method-to-server server) (mapconcat #'identity query " ")) (nnmairix-create-search-group server group query threads))) (defun nnmairix-create-server-and-default-group () @@ -841,7 +828,7 @@ All necessary information will be queried from the user." (hidden (and (string-match "^nn\\(imap\\|maildir\\)$" backend) (y-or-n-p "Does the back end server work with maildir++ (i.e. hidden directories)? "))) - create) + ) ;; create (apply (intern (format "%s-%s" backend "open-server")) (list servername)) @@ -866,7 +853,7 @@ All necessary information will be queried from the user." (if (eq (car method) 'nnmairix) (progn (when (listp oldquery) - (setq oldquery (mapconcat 'identity oldquery " "))) + (setq oldquery (mapconcat #'identity oldquery " "))) (setq query (or query (read-string "New query: " oldquery))) (when (stringp query) @@ -1023,7 +1010,7 @@ before deleting a group on the back end. SERVER specifies nnmairix server." (if (nnmairix-open-server (nth 1 server)) (when (nnmairix-call-backend "request-list" nnmairix-backend-server) - (let (cur qualgroup folder) + (let (cur qualgroup) ;; folder (with-current-buffer nntp-server-buffer (goto-char (point-min)) (while (re-search-forward nnmairix-group-regexp (point-max) t) @@ -1068,7 +1055,7 @@ with `nnmairix-mairix-update-options'." (if (> (length commandsplit) 1) (setq args (append args (cdr commandsplit) nnmairix-mairix-update-options)) (setq args (append args nnmairix-mairix-update-options))) - (apply 'call-process args) + (apply #'call-process args) (nnheader-message 7 "Updating mairix database for %s... done" cur)) (progn (setq args (append (list cur (get-buffer nnmairix-mairix-output-buffer) @@ -1076,7 +1063,7 @@ with `nnmairix-mairix-update-options'." (if (> (length commandsplit) 1) (setq args (append args (cdr commandsplit) nnmairix-mairix-update-options)) (setq args (append args nnmairix-mairix-update-options))) - (set-process-sentinel (apply 'start-process args) + (set-process-sentinel (apply #'start-process args) 'nnmairix-sentinel-mairix-update-finished)))))) (defun nnmairix-group-delete-recreate-this-group () @@ -1186,7 +1173,7 @@ Marks propagation has to be enabled for this to work." (error "Not in a nnmairix group")) (save-excursion (let ((mid (mail-header-message-id (gnus-summary-article-header))) - groups cur) + groups) ;; cur (when mid (setq groups (nnmairix-determine-original-group-from-registry mid)) (unless (or groups @@ -1260,7 +1247,7 @@ If THREADS is non-nil, enable full threads." (setq args (append args '("-c")))) (when threads (setq args (append args '("-t")))) - (apply 'call-process + (apply #'call-process (append args (list "-o" folder) searchquery))))) (defun nnmairix-call-mairix-binary-raw (command query) @@ -1272,7 +1259,7 @@ If THREADS is non-nil, enable full threads." (when (> (length command) 1) (setq args (append args (cdr command)))) (setq args (append args '("-r"))) - (apply 'call-process + (apply #'call-process (append args query))))) (defun nnmairix-get-server () @@ -1313,7 +1300,7 @@ If ALL is t, return also the unopened/failed ones." "Return list of valid back end servers for nnmairix groups." (let ((alist gnus-opened-servers) (mairixservers (nnmairix-get-nnmairix-servers t)) - server mserver openedserver occ cur) + server mserver openedserver occ) ;; cur ;; Get list of all nnmairix backends (i.e. backends which are ;; already occupied) (dolist (cur mairixservers) @@ -1382,9 +1369,9 @@ This should correct problems of wrong article counts when using nnmairix with nnml backends." (let* ((files (sort - (mapcar 'string-to-number + (mapcar #'string-to-number (directory-files path nil "[0-9]+" t)) - '<)) + #'<)) (lastplusone (car files)) (path (file-name-as-directory path))) (dolist (cur files) @@ -1407,7 +1394,7 @@ TYPE is either `nov' or `headers'." (let ((buf (gnus-get-buffer-create " *nnmairix buffer*")) (corr (not (zerop numc))) (name (buffer-name nntp-server-buffer)) - header cur xref) + cur xref) ;; header (with-current-buffer buf (erase-buffer) (set-buffer nntp-server-buffer) @@ -1600,7 +1587,7 @@ search in raw mode." (when (not (gnus-buffer-live-p gnus-article-buffer)) (error "No article buffer available")) (let ((server (nth 1 gnus-current-select-method)) - mid rval group allgroups) + mid group allgroups) ;; rval ;; get message id (with-current-buffer gnus-article-buffer (gnus-summary-toggle-header 1) @@ -1774,7 +1761,7 @@ If VERSION is a string: must be contained in mairix version output." (let* ((commandsplit (split-string nnmairix-mairix-command)) (args (append (list (car commandsplit)) '(nil t nil) (cdr commandsplit) '("-V")))) - (apply 'call-process args) + (apply #'call-process args) (goto-char (point-min)) (re-search-forward "mairix.*") (match-string 0)))) @@ -1831,10 +1818,10 @@ MVALUES may contain values from current article." (widget-create 'push-button :notify (if mvalues - (lambda (&rest ignore) + (lambda (&rest _ignore) (nnmairix-widget-send-query nnmairix-widgets t)) - (lambda (&rest ignore) + (lambda (&rest _ignore) (nnmairix-widget-send-query nnmairix-widgets nil))) "Send Query") @@ -1842,16 +1829,16 @@ MVALUES may contain values from current article." (widget-create 'push-button :notify (if mvalues - (lambda (&rest ignore) + (lambda (&rest _ignore) (nnmairix-widget-create-group nnmairix-widgets t)) - (lambda (&rest ignore) + (lambda (&rest _ignore) (nnmairix-widget-create-group nnmairix-widgets nil))) "Create permanent group") (widget-insert " ") (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (&rest _ignore) (kill-buffer nnmairix-customize-query-buffer)) "Cancel") (use-local-map widget-keymap) @@ -1920,13 +1907,13 @@ If WITHVALUES is t, query is based on current article." (when (not (zerop (length flag))) (push (concat "F:" flag) query))) ;; return query string - (mapconcat 'identity query " "))) + (mapconcat #'identity query " "))) (defun nnmairix-widget-create-query (&optional values) "Create widgets for creating mairix queries. Fill in VALUES if based on an article." - (let (allwidgets) + ;;(let (allwidgets) (when (get-buffer nnmairix-customize-query-buffer) (kill-buffer nnmairix-customize-query-buffer)) (switch-to-buffer nnmairix-customize-query-buffer) @@ -1957,7 +1944,7 @@ Fill in VALUES if based on an article." (when (member 'threads nnmairix-widget-other) (widget-insert "\n") (nnmairix-widget-add "Threads" 'checkbox nil)) - (widget-insert " Show full threads\n\n"))) + (widget-insert " Show full threads\n\n")) ;; ) (defun nnmairix-widget-build-editable-fields (values) "Build editable field widgets in `nnmairix-widget-fields-list'. @@ -1974,7 +1961,7 @@ VALUES may contain values for editable fields from current article." (concat "c" field) (widget-create 'checkbox :tag field - :notify (lambda (widget &rest ignore) + :notify (lambda (widget &rest _ignore) (nnmairix-widget-toggle-activate widget)) nil))) (list @@ -1997,7 +1984,7 @@ VALUES may contain values for editable fields from current article." "Add a widget NAME with optional ARGS." (push (list name - (apply 'widget-create args)) + (apply #'widget-create args)) nnmairix-widgets)) (defun nnmairix-widget-toggle-activate (widget) diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el index a4863c3e1fa..66c22670b23 100644 --- a/lisp/gnus/nnmbox.el +++ b/lisp/gnus/nnmbox.el @@ -1,4 +1,4 @@ -;;; nnmbox.el --- mail mbox access for Gnus +;;; nnmbox.el --- mail mbox access for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -76,7 +76,7 @@ (nnoo-define-basics nnmbox) -(deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old) +(deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server _fetch-old) (with-current-buffer nntp-server-buffer (erase-buffer) (let ((number (length sequence)) @@ -168,7 +168,7 @@ (cons nnmbox-current-group article) (nnmbox-article-group-number nil)))))))) -(deffoo nnmbox-request-group (group &optional server dont-check info) +(deffoo nnmbox-request-group (group &optional server dont-check _info) (nnmbox-possibly-change-newsgroup nil server) (let ((active (cadr (assoc group nnmbox-group-alist)))) (cond @@ -207,17 +207,16 @@ (file-name-directory nnmbox-mbox-file) group (lambda () - (save-excursion - (let ((in-buf (current-buffer))) - (set-buffer nnmbox-mbox-buffer) + (let ((in-buf (current-buffer))) + (with-current-buffer nnmbox-mbox-buffer (goto-char (point-max)) (insert-buffer-substring in-buf))) (nnmbox-save-active nnmbox-group-alist nnmbox-active-file)))) -(deffoo nnmbox-close-group (group &optional server) +(deffoo nnmbox-close-group (_group &optional _server) t) -(deffoo nnmbox-request-create-group (group &optional server args) +(deffoo nnmbox-request-create-group (group &optional _server _args) (nnmail-activate 'nnmbox) (unless (assoc group nnmbox-group-alist) (push (list group (cons 1 0)) @@ -225,7 +224,7 @@ (nnmbox-save-active nnmbox-group-alist nnmbox-active-file)) t) -(deffoo nnmbox-request-list (&optional server) +(deffoo nnmbox-request-list (&optional _server) (save-excursion (let ((nnmail-file-coding-system nnmbox-active-file-coding-system)) @@ -233,12 +232,14 @@ (setq nnmbox-group-alist (nnmail-get-active)) t)) -(deffoo nnmbox-request-newgroups (date &optional server) +(deffoo nnmbox-request-newgroups (_date &optional server) (nnmbox-request-list server)) -(deffoo nnmbox-request-list-newsgroups (&optional server) +(deffoo nnmbox-request-list-newsgroups (&optional _server) (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented.")) +(defvar nnml-current-directory) + (deffoo nnmbox-request-expire-articles (articles newsgroup &optional server force) (nnmbox-possibly-change-newsgroup newsgroup server) @@ -279,7 +280,7 @@ (nconc rest articles)))) (deffoo nnmbox-request-move-article - (article group server accept-form &optional last move-is-internal) + (article group server accept-form &optional last _move-is-internal) (let ((buf (gnus-get-buffer-create " *nnmbox move*")) result) (and @@ -292,7 +293,7 @@ "^X-Gnus-Newsgroup:" (save-excursion (search-forward "\n\n" nil t) (point)) t) (gnus-delete-line)) - (setq result (eval accept-form)) + (setq result (eval accept-form t)) (kill-buffer buf) result) (save-excursion @@ -622,16 +623,15 @@ (with-current-buffer nnmbox-mbox-buffer (= (buffer-size) (nnheader-file-size nnmbox-mbox-file)))) () - (save-excursion - (let ((delim (concat "^" message-unix-mail-delimiter)) - (alist nnmbox-group-alist) - (nnmbox-group-building-active-articles t) - start end end-header number) - (set-buffer (setq nnmbox-mbox-buffer - (let ((nnheader-file-coding-system - nnmbox-file-coding-system)) - (nnheader-find-file-noselect - nnmbox-mbox-file t t)))) + (let ((delim (concat "^" message-unix-mail-delimiter)) + (alist nnmbox-group-alist) + (nnmbox-group-building-active-articles t) + start end end-header number) + (with-current-buffer (setq nnmbox-mbox-buffer + (let ((nnheader-file-coding-system + nnmbox-file-coding-system)) + (nnheader-find-file-noselect + nnmbox-mbox-file t t))) (mm-enable-multibyte) (buffer-disable-undo) (gnus-add-buffer) diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index 82ed091982e..231583fae83 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -1,4 +1,4 @@ -;;; nnmh.el --- mhspool access for Gnus +;;; nnmh.el --- mhspool access for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -72,7 +72,7 @@ as unread by Gnus.") (nnoo-define-basics nnmh) -(deffoo nnmh-retrieve-headers (articles &optional newsgroup server fetch-old) +(deffoo nnmh-retrieve-headers (articles &optional newsgroup server _fetch-old) (with-current-buffer nntp-server-buffer (erase-buffer) (let* ((file nil) @@ -147,7 +147,7 @@ as unread by Gnus.") (save-excursion (nnmail-find-file file)) (string-to-number (file-name-nondirectory file))))) -(deffoo nnmh-request-group (group &optional server dont-check info) +(deffoo nnmh-request-group (group &optional server dont-check _info) (nnheader-init-server-buffer) (nnmh-possibly-change-directory group server) (let ((pathname (nnmail-group-pathname group nnmh-directory)) @@ -171,9 +171,9 @@ as unread by Gnus.") (nnheader-re-read-dir pathname) (setq dir (sort - (mapcar 'string-to-number + (mapcar #'string-to-number (directory-files pathname nil "\\`[0-9]+\\'" t)) - '<)) + #'<)) (cond (dir (setq nnmh-group-alist @@ -188,9 +188,11 @@ as unread by Gnus.") (nnheader-report 'nnmh "Empty group %s" group) (nnheader-insert (format "211 0 1 0 %s\n" group)))))))))) -(deffoo nnmh-request-scan (&optional group server) +(deffoo nnmh-request-scan (&optional group _server) (nnmail-get-new-mail 'nnmh nil nnmh-directory group)) +(defvar nnmh-toplev) + (deffoo nnmh-request-list (&optional server dir) (nnheader-insert "") (nnmh-possibly-change-directory nil server) @@ -201,13 +203,12 @@ as unread by Gnus.") (setq nnmh-group-alist (nnmail-get-active)) t) -(defvar nnmh-toplev) (defun nnmh-request-list-1 (dir) (setq dir (expand-file-name dir)) ;; Recurse down all directories. (let ((files (nnheader-directory-files dir t nil t)) (max 0) - min rdir num subdirectoriesp file) + min num subdirectoriesp file) ;; rdir ;; Recurse down directories. (setq subdirectoriesp ;; link number always 1 on MS Windows :( @@ -252,7 +253,7 @@ as unread by Gnus.") (or min 1)))))) t) -(deffoo nnmh-request-newgroups (date &optional server) +(deffoo nnmh-request-newgroups (_date &optional server) (nnmh-request-list server)) (deffoo nnmh-request-expire-articles (articles newsgroup @@ -291,11 +292,11 @@ as unread by Gnus.") (nnheader-message 5 "") (nconc rest articles))) -(deffoo nnmh-close-group (group &optional server) +(deffoo nnmh-close-group (_group &optional _server) t) -(deffoo nnmh-request-move-article (article group server accept-form - &optional last move-is-internal) +(deffoo nnmh-request-move-article ( article group server accept-form + &optional _last _move-is-internal) (let ((buf (gnus-get-buffer-create " *nnmh move*")) result) (and @@ -304,7 +305,7 @@ as unread by Gnus.") (with-current-buffer buf (erase-buffer) (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) + (setq result (eval accept-form t)) (kill-buffer (current-buffer)) result) (progn @@ -350,7 +351,7 @@ as unread by Gnus.") nil (if (nnheader-be-verbose 5) nil 'nomesg)) t))) -(deffoo nnmh-request-create-group (group &optional server args) +(deffoo nnmh-request-create-group (group &optional server _args) (nnheader-init-server-buffer) (unless (assoc group nnmh-group-alist) (let (active) @@ -358,12 +359,12 @@ as unread by Gnus.") nnmh-group-alist) (nnmh-possibly-create-directory group) (nnmh-possibly-change-directory group server) - (let ((articles (mapcar 'string-to-number + (let ((articles (mapcar #'string-to-number (directory-files nnmh-current-directory nil "\\`[0-9]+\\'")))) (when articles - (setcar active (apply 'min articles)) - (setcdr active (apply 'max articles)))))) + (setcar active (apply #'min articles)) + (setcdr active (apply #'max articles)))))) t) (deffoo nnmh-request-delete-group (group &optional force server) @@ -484,9 +485,9 @@ as unread by Gnus.") (gnus-make-directory dir)) ;; Find the highest number in the group. (let ((files (sort - (mapcar 'string-to-number + (mapcar #'string-to-number (directory-files dir nil "\\`[0-9]+\\'")) - '>))) + #'>))) (when files (setcdr active (car files))))) (setcdr active (1+ (cdr active))) @@ -507,10 +508,10 @@ as unread by Gnus.") ;; articles in this folder. The articles that are "new" will be ;; marked as unread by Gnus. (let* ((dir nnmh-current-directory) - (files (sort (mapcar 'string-to-number + (files (sort (mapcar #'string-to-number (directory-files nnmh-current-directory nil "\\`[0-9]+\\'" t)) - '<)) + #'<)) (nnmh-file (concat dir ".nnmh-articles")) new articles) ;; Load the .nnmh-articles file. @@ -557,7 +558,7 @@ as unread by Gnus.") (when new (gnus-make-articles-unread (gnus-group-prefixed-name group (list 'nnmh "")) - (setq new (sort new '<)))) + (setq new (sort new #'<)))) ;; Sort the article list with highest numbers first. (setq articles (sort articles (lambda (art1 art2) (> (car art1) (car art2))))) diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 3cdfc749703..18acc73aadd 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -1,4 +1,4 @@ -;;; nnml.el --- mail spool access for Gnus +;;; nnml.el --- mail spool access for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1995-2021 Free Software Foundation, Inc. @@ -111,7 +111,7 @@ non-nil.") (nnoo-define-basics nnml) -(defun nnml-group-pathname (group &optional file server) +(defun nnml-group-pathname (group &optional file _server) "Return an absolute file name of FILE for GROUP on SERVER." (nnmail-group-pathname group nnml-directory file)) @@ -215,7 +215,7 @@ non-nil.") (cons (if group-num (car group-num) group) (string-to-number (file-name-nondirectory path))))))) -(deffoo nnml-request-group (group &optional server dont-check info) +(deffoo nnml-request-group (group &optional server dont-check _info) (let ((file-name-coding-system nnmail-pathname-coding-system)) (cond ((not (nnml-possibly-change-directory group server)) @@ -252,11 +252,11 @@ non-nil.") (t (nnmail-get-new-mail 'nnml 'nnml-save-incremental-nov nnml-directory nil)))) -(deffoo nnml-close-group (group &optional server) +(deffoo nnml-close-group (_group &optional _server) (setq nnml-article-file-alist nil) t) -(deffoo nnml-request-create-group (group &optional server args) +(deffoo nnml-request-create-group (group &optional server _args) (nnml-possibly-change-directory nil server) (nnmail-activate 'nnml) (cond @@ -278,12 +278,12 @@ non-nil.") (let* ((file-name-coding-system nnmail-pathname-coding-system) (articles (nnml-directory-articles nnml-current-directory))) (when articles - (setcar active (apply 'min articles)) - (setcdr active (apply 'max articles)))) + (setcar active (apply #'min articles)) + (setcdr active (apply #'max articles)))) (nnmail-save-active nnml-group-alist nnml-active-file) t)))) -(deffoo nnml-request-list (&optional server) +(deffoo nnml-request-list (&optional _server) (save-excursion (let ((nnmail-file-coding-system nnmail-active-file-coding-system) (file-name-coding-system nnmail-pathname-coding-system)) @@ -291,10 +291,10 @@ non-nil.") (setq nnml-group-alist (nnmail-get-active)) t)) -(deffoo nnml-request-newgroups (date &optional server) +(deffoo nnml-request-newgroups (_date &optional server) (nnml-request-list server)) -(deffoo nnml-request-list-newsgroups (&optional server) +(deffoo nnml-request-list-newsgroups (&optional _server) (save-excursion (nnmail-find-file nnml-newsgroups-file))) @@ -307,7 +307,7 @@ non-nil.") article rest mod-time number target) (nnmail-activate 'nnml) - (setq active-articles (sort active-articles '<)) + (setq active-articles (sort active-articles #'<)) ;; Articles not listed in active-articles are already gone, ;; so don't try to expire them. (setq articles (gnus-sorted-intersection articles active-articles)) @@ -353,14 +353,14 @@ non-nil.") (let ((active (nth 1 (assoc-string group nnml-group-alist)))) (when active (setcar active (or (and active-articles - (apply 'min active-articles)) + (apply #'min active-articles)) (1+ (cdr active))))) (nnmail-save-active nnml-group-alist nnml-active-file)) (nnml-save-nov) (nconc rest articles))) (deffoo nnml-request-move-article - (article group server accept-form &optional last move-is-internal) + (article group server accept-form &optional last _move-is-internal) (let ((buf (gnus-get-buffer-create " *nnml move*")) (file-name-coding-system nnmail-pathname-coding-system) result) @@ -374,7 +374,7 @@ non-nil.") nnml-article-file-alist) (with-current-buffer buf (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) + (setq result (eval accept-form t)) (kill-buffer (current-buffer)) result)) (progn @@ -411,8 +411,8 @@ non-nil.") (and (nnmail-activate 'nnml) (if (and (not (setq result (nnmail-article-group - `(lambda (group) - (nnml-active-number group ,server))))) + (lambda (group) + (nnml-active-number group server))))) (yes-or-no-p "Moved to `junk' group; delete article? ")) (setq result 'junk) (setq result (car (nnml-save-mail result server t)))) @@ -705,7 +705,7 @@ article number. This function is called narrowed to an article." (setq nnml-article-file-alist (sort (nnml-current-group-article-to-file-alist) - 'car-less-than-car))) + #'car-less-than-car))) (setq active (if nnml-article-file-alist (cons (caar nnml-article-file-alist) @@ -856,7 +856,7 @@ Unless no-active is non-nil, update the active file too." (nnml-generate-nov-databases-directory dir seen))) ;; Do this directory. (let ((nnml-files (sort (nnheader-article-to-file-alist dir) - 'car-less-than-car))) + #'car-less-than-car))) (if (not nnml-files) (let* ((group (nnheader-file-to-group (directory-file-name dir) nnml-directory)) @@ -889,7 +889,7 @@ Unless no-active is non-nil, update the active file too." (let* ((dir (file-name-as-directory dir)) (nov (concat dir nnml-nov-file-name)) (nov-buffer (gnus-get-buffer-create " *nov*")) - chars file headers) + chars headers) ;; file (with-current-buffer nov-buffer ;; Init the nov buffer. (buffer-disable-undo) @@ -1010,7 +1010,7 @@ Use the nov database for the current group if available." (unless nnml-article-file-alist (setq nnml-article-file-alist (sort (nnml-current-group-article-to-file-alist) - 'car-less-than-car))) + #'car-less-than-car))) (if (not nnml-article-file-alist) ;; The group is empty: do nothing but return t t diff --git a/lisp/gnus/nnnil.el b/lisp/gnus/nnnil.el index 7d400791fa2..36a8bc4581b 100644 --- a/lisp/gnus/nnnil.el +++ b/lisp/gnus/nnnil.el @@ -1,4 +1,4 @@ -;;; nnnil.el --- empty backend for Gnus +;;; nnnil.el --- empty backend for Gnus -*- lexical-binding: t; -*- ;; This file is in the public domain. @@ -32,31 +32,31 @@ (defvar nnnil-status-string "") -(defun nnnil-retrieve-headers (articles &optional group server fetch-old) +(defun nnnil-retrieve-headers (_articles &optional _group _server _fetch-old) (with-current-buffer nntp-server-buffer (erase-buffer)) 'nov) -(defun nnnil-open-server (server &optional definitions) +(defun nnnil-open-server (_server &optional _definitions) t) -(defun nnnil-close-server (&optional server) +(defun nnnil-close-server (&optional _server) t) (defun nnnil-request-close () t) -(defun nnnil-server-opened (&optional server) +(defun nnnil-server-opened (&optional _server) t) -(defun nnnil-status-message (&optional server) +(defun nnnil-status-message (&optional _server) nnnil-status-string) -(defun nnnil-request-article (article &optional group server to-buffer) +(defun nnnil-request-article (_article &optional _group _server _to-buffer) (setq nnnil-status-string "No such group") nil) -(defun nnnil-request-group (group &optional server fast info) +(defun nnnil-request-group (_group &optional _server _fast _info) (let (deactivate-mark) (with-current-buffer nntp-server-buffer (erase-buffer) @@ -64,15 +64,15 @@ (setq nnnil-status-string "No such group") nil) -(defun nnnil-close-group (group &optional server) +(defun nnnil-close-group (_group &optional _server) t) -(defun nnnil-request-list (&optional server) +(defun nnnil-request-list (&optional _server) (with-current-buffer nntp-server-buffer (erase-buffer)) t) -(defun nnnil-request-post (&optional server) +(defun nnnil-request-post (&optional _server) (setq nnnil-status-string "Read-only server") nil) diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el index 9bb86d65aba..7759951662a 100644 --- a/lisp/gnus/nnoo.el +++ b/lisp/gnus/nnoo.el @@ -1,4 +1,4 @@ -;;; nnoo.el --- OO Gnus Backends +;;; nnoo.el --- OO Gnus Backends -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. @@ -33,21 +33,24 @@ (defmacro defvoo (var init &optional doc &rest map) "The same as `defvar', only takes list of variables to MAP to." + (declare (indent 2) + (debug (var init &optional doc &rest map))) `(prog1 ,(if doc `(defvar ,var ,init ,(concat doc "\n\nThis is a Gnus server variable. See Info node `(gnus)Select Methods'.")) `(defvar ,var ,init)) (nnoo-define ',var ',map))) -(put 'defvoo 'lisp-indent-function 2) -(put 'defvoo 'edebug-form-spec '(var init &optional doc &rest map)) (defmacro deffoo (func args &rest forms) "The same as `defun', only register FUNC." + (declare (indent 2) + (debug (&define name lambda-list def-body))) `(prog1 (defun ,func ,args ,@forms) (nnoo-register-function ',func))) -(put 'deffoo 'lisp-indent-function 2) -(put 'deffoo 'edebug-form-spec '(&define name lambda-list def-body)) + +(defun noo--defalias (fun val) + (prog1 (defalias fun val) (nnoo-register-function fun))) (defun nnoo-register-function (func) (let ((funcs (nthcdr 3 (assoc (nnoo-backend func) @@ -57,18 +60,18 @@ (setcar funcs (cons func (car funcs))))) (defmacro nnoo-declare (backend &rest parents) + (declare (indent 1)) `(eval-and-compile (if (assq ',backend nnoo-definition-alist) (setcar (cdr (assq ',backend nnoo-definition-alist)) - (mapcar 'list ',parents)) + (mapcar #'list ',parents)) (push (list ',backend - (mapcar 'list ',parents) + (mapcar #'list ',parents) nil nil) nnoo-definition-alist)) (unless (assq ',backend nnoo-state-alist) (push (list ',backend "*internal-non-initialized-backend*") nnoo-state-alist)))) -(put 'nnoo-declare 'lisp-indent-function 1) (defun nnoo-parents (backend) (nth 1 (assoc backend nnoo-definition-alist))) @@ -80,25 +83,19 @@ (nth 3 (assoc backend nnoo-definition-alist))) (defmacro nnoo-import (backend &rest imports) + (declare (indent 1)) `(nnoo-import-1 ',backend ',imports)) -(put 'nnoo-import 'lisp-indent-function 1) (defun nnoo-import-1 (backend imports) (let ((call-function - (if (symbolp (car imports)) (pop imports) 'nnoo-parent-function)) - imp functions function) - (while (setq imp (pop imports)) - (setq functions - (or (cdr imp) - (nnoo-functions (car imp)))) - (while functions - (unless (fboundp - (setq function - (nnoo-symbol backend - (nnoo-rest-symbol (car functions))))) - (eval `(deffoo ,function (&rest args) - (,call-function ',backend ',(car functions) args)))) - (pop functions))))) + (if (symbolp (car imports)) (pop imports) #'nnoo-parent-function))) + (dolist (imp imports) + (dolist (fun (or (cdr imp) (nnoo-functions (car imp)))) + (let ((function (nnoo-symbol backend (nnoo-rest-symbol fun)))) + (unless (fboundp function) + (noo--defalias function + (lambda (&rest args) + (funcall call-function backend fun args))))))))) (defun nnoo-parent-function (backend function args) (let ((pbackend (nnoo-backend function)) @@ -130,23 +127,22 @@ (setq vars (cdr vars))))))) (defmacro nnoo-map-functions (backend &rest maps) - `(nnoo-map-functions-1 ',backend ',maps)) -(put 'nnoo-map-functions 'lisp-indent-function 1) - -(defun nnoo-map-functions-1 (backend maps) - (let (m margs i) - (while (setq m (pop maps)) - (setq i 0 - margs nil) - (while (< i (length (cdr m))) - (if (numberp (nth i (cdr m))) - (push `(nth ,i args) margs) - (push (nth i (cdr m)) margs)) - (cl-incf i)) - (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m))) + (declare (indent 1)) + `(progn + ,@(mapcar + (lambda (m) + (let ((margs nil)) + (dotimes (i (length (cdr m))) + (push (if (numberp (nth i (cdr m))) + `(nth ,i args) + (nth i (cdr m))) + margs)) + `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m))) (&rest args) + (ignore args) ;; Not always used! (nnoo-parent-function ',backend ',(car m) - ,(cons 'list (nreverse margs)))))))) + ,(cons 'list (nreverse margs)))))) + maps))) (defun nnoo-backend (symbol) (string-match "^[^-]+-" (symbol-name symbol)) @@ -264,7 +260,7 @@ nnoo-state-alist)) t) -(defun nnoo-status-message (backend server) +(defun nnoo-status-message (backend _server) (nnheader-get-report backend)) (defun nnoo-server-opened (backend server) @@ -273,19 +269,27 @@ (defmacro nnoo-define-basics (backend) "Define `close-server', `server-opened' and `status-message'." - `(eval-and-compile - (nnoo-define-basics-1 ',backend))) - -(defun nnoo-define-basics-1 (backend) - (dolist (function '(server-opened status-message)) - (eval `(deffoo ,(nnoo-symbol backend function) (&optional server) - (,(nnoo-symbol 'nnoo function) ',backend server)))) - (dolist (function '(close-server)) - (eval `(deffoo ,(nnoo-symbol backend function) (&optional server defs) - (,(nnoo-symbol 'nnoo function) ',backend server)))) - (eval `(deffoo ,(nnoo-symbol backend 'open-server) - (server &optional defs) - (nnoo-change-server ',backend server defs)))) + (let ((form + ;; We wrap the definitions in `when t' here so that a subsequent + ;; "real" definition of one those doesn't trigger a "defined multiple + ;; times" warning. + `(when t + ,@(mapcar (lambda (fun) + `(deffoo ,(nnoo-symbol backend fun) (&optional server) + (,(nnoo-symbol 'nnoo fun) ',backend server))) + '(server-opened status-message)) + (deffoo ,(nnoo-symbol backend 'close-server) (&optional server _defs) + (,(nnoo-symbol 'nnoo 'close-server) ',backend server)) + (deffoo ,(nnoo-symbol backend 'open-server) (server &optional defs) + (nnoo-change-server ',backend server defs))))) + ;; Wrapping with `when' has the downside that the compiler now doesn't + ;; "know" that these functions are defined, so to avoid "not known to be + ;; defined" warnings we eagerly define them during the compilation. + ;; This is fairly nasty since it will override previous "real" definitions + ;; (e.g. when compiling this in an Emacs instance that's running Gnus), but + ;; that's also what the previous code did, so it sucks but is not worse. + (eval form t) + form)) (defmacro nnoo-define-skeleton (backend) "Define all required backend functions for BACKEND. @@ -294,17 +298,15 @@ All functions will return nil and report an error." (nnoo-define-skeleton-1 ',backend))) (defun nnoo-define-skeleton-1 (backend) - (let ((functions '(retrieve-headers - request-close request-article - request-group close-group - request-list request-post request-list-newsgroups)) - function fun) - (while (setq function (pop functions)) - (when (not (fboundp (setq fun (nnoo-symbol backend function)))) - (eval `(deffoo ,fun - (&rest args) - (nnheader-report ',backend ,(format "%s-%s not implemented" - backend function)))))))) + (dolist (op '(retrieve-headers + request-close request-article + request-group close-group + request-list request-post request-list-newsgroups)) + (let ((fun (nnoo-symbol backend op))) + (unless (fboundp fun) + (let ((msg (format "%s-%s not implemented" backend op))) + (noo--defalias fun + (lambda (&rest _args) (nnheader-report backend msg)))))))) (defun nnoo-set (server &rest args) (let ((parents (nnoo-parents (car server))) diff --git a/lisp/gnus/nnregistry.el b/lisp/gnus/nnregistry.el index e78f93d829a..15e41e9d425 100644 --- a/lisp/gnus/nnregistry.el +++ b/lisp/gnus/nnregistry.el @@ -1,5 +1,4 @@ -;;; nnregistry.el --- access to articles via Gnus' message-id registry -;;; -*- coding: utf-8 -*- +;;; nnregistry.el --- access to articles via Gnus' message-id registry -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2021 Free Software Foundation, Inc. @@ -36,21 +35,21 @@ (nnoo-declare nnregistry) -(deffoo nnregistry-server-opened (server) +(deffoo nnregistry-server-opened (_server) gnus-registry-enabled) -(deffoo nnregistry-close-server (server &optional defs) +(deffoo nnregistry-close-server (_server &optional _defs) t) -(deffoo nnregistry-status-message (server) +(deffoo nnregistry-status-message (_server) nil) -(deffoo nnregistry-open-server (server &optional defs) +(deffoo nnregistry-open-server (_server &optional _defs) gnus-registry-enabled) (defvar nnregistry-within-nnregistry nil) -(deffoo nnregistry-request-article (id &optional group server buffer) +(deffoo nnregistry-request-article (id &optional _group _server buffer) (and (not nnregistry-within-nnregistry) (let* ((nnregistry-within-nnregistry t) (group (nth 0 (gnus-registry-get-id-key id 'group))) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index f9e0a08a06e..aa7c8e584a5 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -1,4 +1,4 @@ -;;; nnrss.el --- interfacing with RSS +;;; nnrss.el --- interfacing with RSS -*- lexical-binding: t; -*- ;; Copyright (C) 2001-2021 Free Software Foundation, Inc. @@ -100,7 +100,6 @@ Note that you have to regenerate all the nnrss groups if you change the value. Moreover, you should be patient even if you are made to read the same articles twice, that arises for the difference of the versions of xml.el." - :group 'nnrss :type 'coding-system) (defvar nnrss-compatible-encoding-alist @@ -126,7 +125,7 @@ for decoding when the cdr that the data specify is not available.") (setq group (decode-coding-string group 'utf-8)) group)) -(deffoo nnrss-retrieve-headers (articles &optional group server fetch-old) +(deffoo nnrss-retrieve-headers (articles &optional group server _fetch-old) (setq group (nnrss-decode-group-name group)) (nnrss-possibly-change-group group server) (let (e) @@ -174,7 +173,7 @@ for decoding when the cdr that the data specify is not available.") "\n"))))) 'nov) -(deffoo nnrss-request-group (group &optional server dont-check info) +(deffoo nnrss-request-group (group &optional server dont-check _info) (setq group (nnrss-decode-group-name group)) (nnheader-message 6 "nnrss: Requesting %s..." group) (nnrss-possibly-change-group group server) @@ -189,7 +188,7 @@ for decoding when the cdr that the data specify is not available.") t)) (nnheader-message 6 "nnrss: Requesting %s...done" group))) -(deffoo nnrss-close-group (group &optional server) +(deffoo nnrss-close-group (_group &optional _server) t) (deffoo nnrss-request-article (article &optional group server buffer) @@ -201,7 +200,7 @@ for decoding when the cdr that the data specify is not available.") (nnrss-possibly-change-group group server) (let ((e (assq article nnrss-group-data)) (nntp-server-buffer (or buffer nntp-server-buffer)) - post err) + err) ;; post (when e (with-current-buffer nntp-server-buffer (erase-buffer) @@ -223,7 +222,7 @@ for decoding when the cdr that the data specify is not available.") (cons '("Newsgroups" . utf-8) rfc2047-header-encoding-alist) rfc2047-header-encoding-alist)) - rfc2047-encode-encoded-words body fn) + rfc2047-encode-encoded-words body) ;; fn (when (or text link enclosure comments) (insert "\n") (insert "<#multipart type=alternative>\n" @@ -312,7 +311,7 @@ for decoding when the cdr that the data specify is not available.") ;; we return the article number. (cons nnrss-group (car e)))))) -(deffoo nnrss-open-server (server &optional defs connectionless) +(deffoo nnrss-open-server (server &optional defs _connectionless) (nnrss-read-server-data server) (nnoo-change-server 'nnrss server defs) t) @@ -336,7 +335,7 @@ for decoding when the cdr that the data specify is not available.") (nnrss-save-group-data group server)) not-expirable)) -(deffoo nnrss-request-delete-group (group &optional force server) +(deffoo nnrss-request-delete-group (group &optional _force server) (setq group (nnrss-decode-group-name group)) (nnrss-possibly-change-group group server) (let (elem) @@ -562,7 +561,7 @@ which RSS 2.0 allows." ;;; URL interface -(defun nnrss-no-cache (url) +(defun nnrss-no-cache (_url) "") (defun nnrss-insert (url) @@ -614,7 +613,7 @@ which RSS 2.0 allows." (defun nnrss-check-group (group server) (let (file xml subject url extra changed author date feed-subject - enclosure comments rss-ns rdf-ns content-ns dc-ns + enclosure comments rss-ns content-ns dc-ns ;; rdf-ns hash-index) (if (and nnrss-use-local (file-exists-p (setq file (expand-file-name @@ -638,7 +637,7 @@ which RSS 2.0 allows." (setq changed t)) (setq xml (nnrss-fetch url))) (setq dc-ns (nnrss-get-namespace-prefix xml "http://purl.org/dc/elements/1.1/") - rdf-ns (nnrss-get-namespace-prefix xml "http://www.w3.org/1999/02/22-rdf-syntax-ns#") + ;; rdf-ns (nnrss-get-namespace-prefix xml "http://www.w3.org/1999/02/22-rdf-syntax-ns#") rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/") content-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/modules/content/")) (dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml))) @@ -798,7 +797,7 @@ It is useful when `(setq nnrss-use-local t)'." (defun nnrss-node-just-text (node) (if (and node (listp node)) - (mapconcat 'nnrss-node-just-text (cddr node) " ") + (mapconcat #'nnrss-node-just-text (cddr node) " ") node)) (defun nnrss-find-el (tag data &optional found-list) diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index ba0e60a2673..fffa2d27312 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -81,12 +81,12 @@ "Compress ARTLIST." (let (selection) (pcase-dolist (`(,artgroup . ,arts) - (nnselect-categorize artlist 'nnselect-artitem-group)) + (nnselect-categorize artlist #'nnselect-artitem-group)) (let (list) (pcase-dolist (`(,rsv . ,articles) (nnselect-categorize - arts 'nnselect-artitem-rsv 'nnselect-artitem-number)) - (push (cons rsv (gnus-compress-sequence (sort articles '<))) + arts #'nnselect-artitem-rsv #'nnselect-artitem-number)) + (push (cons rsv (gnus-compress-sequence (sort articles #'<))) list)) (push (cons artgroup list) selection))) selection)) @@ -200,25 +200,27 @@ as `(keyfunc member)' and the corresponding element is just (define-inline ids-by-group (articles) (inline-quote - (nnselect-categorize ,articles 'nnselect-article-group - 'nnselect-article-id))) + (nnselect-categorize ,articles #'nnselect-article-group + #'nnselect-article-id))) (define-inline numbers-by-group (articles &optional type) (inline-quote (cond ((eq ,type 'range) (nnselect-categorize (gnus-uncompress-range ,articles) - 'nnselect-article-group 'nnselect-article-number)) + #'nnselect-article-group #'nnselect-article-number)) ((eq ,type 'tuple) (nnselect-categorize ,articles #'(lambda (elem) (nnselect-article-group (car elem))) #'(lambda (elem) (cons (nnselect-article-number - (car elem)) (cdr elem))))) + (car elem)) + (cdr elem))))) (t (nnselect-categorize ,articles - 'nnselect-article-group 'nnselect-article-number))))) + #'nnselect-article-group + #'nnselect-article-number))))) (defmacro nnselect-add-prefix (group) "Ensures that the GROUP has an nnselect prefix." @@ -319,7 +321,7 @@ If this variable is nil, or if the provided function returns nil, headers) (with-current-buffer nntp-server-buffer (pcase-dolist (`(,artgroup . ,artids) gartids) - (let ((artlist (sort (mapcar 'cdr artids) '<)) + (let ((artlist (sort (mapcar #'cdr artids) #'<)) (gnus-override-method (gnus-find-method-for-group artgroup)) (fetch-old (or @@ -385,7 +387,8 @@ If this variable is nil, or if the provided function returns nil, (list (gnus-method-to-server (gnus-find-method-for-group - (nnselect-article-group x)))) servers :test 'equal))) + (nnselect-article-group x)))) + servers :test 'equal))) (gnus-articles-in-thread thread))))) (setq servers (list (list server)))) (setq artlist @@ -455,7 +458,7 @@ If this variable is nil, or if the provided function returns nil, (if force (let (not-expired) (pcase-dolist (`(,artgroup . ,artids) (ids-by-group articles)) - (let ((artlist (sort (mapcar 'cdr artids) '<))) + (let ((artlist (sort (mapcar #'cdr artids) #'<))) (unless (gnus-check-backend-function 'request-expire-articles artgroup) (error "Group %s does not support article expiration" artgroup)) @@ -467,7 +470,7 @@ If this variable is nil, or if the provided function returns nil, (gnus-request-expire-articles artlist artgroup force))) not-expired))) - (sort (delq nil not-expired) '<)) + (sort (delq nil not-expired) #'<)) articles)) @@ -518,11 +521,11 @@ If this variable is nil, or if the provided function returns nil, (mapcar (lambda (artgroup) (list (car artgroup) - (gnus-compress-sequence (sort (cdr artgroup) '<)) + (gnus-compress-sequence (sort (cdr artgroup) #'<)) action marks)) (numbers-by-group range 'range)))) actions) - 'car 'cdr))) + #'car #'cdr))) (deffoo nnselect-request-update-info (group info &optional _server) (let* ((group (nnselect-add-prefix group)) @@ -651,8 +654,9 @@ If this variable is nil, or if the provided function returns nil, new-nnselect-artlist) (setq headers (gnus-fetch-headers - (append (sort old-arts '<) - (number-sequence first last)) nil t)) + (append (sort old-arts #'<) + (number-sequence first last)) + nil t)) (gnus-group-set-parameter group 'nnselect-artlist @@ -942,7 +946,7 @@ article came from is also searched." (gnus-remove-from-range old-unread (cdr (assoc artgroup select-reads))) - (sort (cdr (assoc artgroup select-unreads)) '<)))) + (sort (cdr (assoc artgroup select-unreads)) #'<)))) (gnus-get-unread-articles-in-group group-info (gnus-active artgroup) t) (gnus-group-update-group artgroup t t))))))) diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el index 9de59d8631d..ce9ab3c53c1 100644 --- a/lisp/gnus/nnspool.el +++ b/lisp/gnus/nnspool.el @@ -1,4 +1,4 @@ -;;; nnspool.el --- spool access for GNU Emacs +;;; nnspool.el --- spool access for GNU Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1988-1990, 1993-1998, 2000-2021 Free Software ;; Foundation, Inc. @@ -126,7 +126,7 @@ there.") (nnoo-define-basics nnspool) -(deffoo nnspool-retrieve-headers (articles &optional group server fetch-old) +(deffoo nnspool-retrieve-headers (articles &optional group _server fetch-old) "Retrieve the headers of ARTICLES." (with-current-buffer nntp-server-buffer (erase-buffer) @@ -203,7 +203,7 @@ there.") server nnspool-spool-directory) t))) -(deffoo nnspool-request-article (id &optional group server buffer) +(deffoo nnspool-request-article (id &optional group _server buffer) "Select article by message ID (or number)." (nnspool-possibly-change-directory group) (let ((nntp-server-buffer (or buffer nntp-server-buffer)) @@ -222,7 +222,7 @@ there.") (cons nnspool-current-group id) ag)))) -(deffoo nnspool-request-body (id &optional group server) +(deffoo nnspool-request-body (id &optional group _server) "Select article body by message ID (or number)." (nnspool-possibly-change-directory group) (let ((res (nnspool-request-article id))) @@ -233,7 +233,7 @@ there.") (delete-region (point-min) (point))) res)))) -(deffoo nnspool-request-head (id &optional group server) +(deffoo nnspool-request-head (id &optional group _server) "Select article head by message ID (or number)." (nnspool-possibly-change-directory group) (let ((res (nnspool-request-article id))) @@ -245,7 +245,7 @@ there.") (nnheader-fold-continuation-lines))) res)) -(deffoo nnspool-request-group (group &optional server dont-check info) +(deffoo nnspool-request-group (group &optional _server dont-check _info) "Select news GROUP." (let ((pathname (nnspool-article-pathname group)) dir) @@ -261,7 +261,7 @@ there.") ;; Yes, completely empty spool directories *are* possible. ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu> (when (setq dir (directory-files pathname nil "\\`[0-9]+\\'" t)) - (setq dir (sort (mapcar 'string-to-number dir) '<))) + (setq dir (sort (mapcar #'string-to-number dir) #'<))) (if dir (nnheader-insert "211 %d %d %d %s\n" (length dir) (car dir) @@ -269,26 +269,26 @@ there.") (nnheader-report 'nnspool "Empty group %s" group) (nnheader-insert "211 0 0 0 %s\n" group)))))) -(deffoo nnspool-request-type (group &optional article) +(deffoo nnspool-request-type (_group &optional _article) 'news) -(deffoo nnspool-close-group (group &optional server) +(deffoo nnspool-close-group (_group &optional _server) t) -(deffoo nnspool-request-list (&optional server) +(deffoo nnspool-request-list (&optional _server) "List active newsgroups." (save-excursion (or (nnspool-find-file nnspool-active-file) (nnheader-report 'nnspool (nnheader-file-error nnspool-active-file))))) -(deffoo nnspool-request-list-newsgroups (&optional server) +(deffoo nnspool-request-list-newsgroups (&optional _server) "List newsgroups (defined in NNTP2)." (save-excursion (or (nnspool-find-file nnspool-newsgroups-file) (nnheader-report 'nnspool (nnheader-file-error nnspool-newsgroups-file))))) -(deffoo nnspool-request-list-distributions (&optional server) +(deffoo nnspool-request-list-distributions (&optional _server) "List distributions (defined in NNTP2)." (save-excursion (or (nnspool-find-file nnspool-distributions-file) @@ -296,7 +296,7 @@ there.") nnspool-distributions-file))))) ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. -(deffoo nnspool-request-newgroups (date &optional server) +(deffoo nnspool-request-newgroups (date &optional _server) "List groups created after DATE." (if (nnspool-find-file nnspool-active-times-file) (save-excursion @@ -323,7 +323,7 @@ there.") t) nil)) -(deffoo nnspool-request-post (&optional server) +(deffoo nnspool-request-post (&optional _server) "Post a new news in current buffer." (save-excursion (let* ((process-connection-type nil) ; t bugs out on Solaris @@ -331,7 +331,7 @@ there.") (buf (current-buffer)) (proc (condition-case err - (apply 'start-process "*nnspool inews*" inews-buffer + (apply #'start-process "*nnspool inews*" inews-buffer nnspool-inews-program nnspool-inews-switches) (error (nnheader-report 'nnspool "inews error: %S" err))))) @@ -356,7 +356,7 @@ there.") ;;; Internal functions. -(defun nnspool-inews-sentinel (proc status) +(defun nnspool-inews-sentinel (proc _status) (with-current-buffer (process-buffer proc) (goto-char (point-min)) (if (or (zerop (buffer-size)) @@ -409,7 +409,7 @@ there.") (<= last (car arts))) (pop arts)) ;; The articles in `arts' are missing from the buffer. - (mapc 'nnspool-insert-nov-head arts) + (mapc #'nnspool-insert-nov-head arts) t)))))))))) (defun nnspool-insert-nov-head (article) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index c2bb960f945..1eb604d6754 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -335,16 +335,16 @@ retried once before actually displaying the error report." (apply #'error args))) -(defmacro nntp-copy-to-buffer (buffer start end) +(defsubst nntp-copy-to-buffer (buffer start end) "Copy string from unibyte current buffer to multibyte buffer." - `(let ((string (buffer-substring ,start ,end))) - (with-current-buffer ,buffer + (let ((string (buffer-substring start end))) + (with-current-buffer buffer (erase-buffer) (insert string) (goto-char (point-min)) nil))) -(defsubst nntp-wait-for (process wait-for buffer &optional decode discard) +(defun nntp-wait-for (process wait-for buffer &optional decode discard) "Wait for WAIT-FOR to arrive from PROCESS." (with-current-buffer (process-buffer process) @@ -436,7 +436,7 @@ retried once before actually displaying the error report." (when process (process-buffer process)))) -(defsubst nntp-retrieve-data (command address _port buffer +(defun nntp-retrieve-data (command address _port buffer &optional wait-for callback decode) "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS." (let ((process (or (nntp-find-connection buffer) @@ -469,7 +469,7 @@ retried once before actually displaying the error report." nil))) (nnheader-report 'nntp "Couldn't open connection to %s" address)))) -(defsubst nntp-send-command (wait-for &rest strings) +(defun nntp-send-command (wait-for &rest strings) "Send STRINGS to server and wait until WAIT-FOR returns." (when (not (or nnheader-callback-function nntp-inhibit-output)) @@ -1330,7 +1330,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the (dolist (entry nntp-server-action-alist) (when (string-match (car entry) nntp-server-type) (if (not (functionp (cadr entry))) - (eval (cadr entry)) + (eval (cadr entry) t) (funcall (cadr entry))))))) (defun nntp-async-wait (process wait-for buffer decode callback) diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index 1e2feda6365..b3b701e4126 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -1,4 +1,4 @@ -;;; nnvirtual.el --- virtual newsgroups access for Gnus +;;; nnvirtual.el --- virtual newsgroups access for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1994-2021 Free Software Foundation, Inc. @@ -94,8 +94,8 @@ It is computed from the marks of individual component groups.") (nnoo-define-basics nnvirtual) -(deffoo nnvirtual-retrieve-headers (articles &optional newsgroup - server fetch-old) +(deffoo nnvirtual-retrieve-headers (articles &optional _newsgroup + server _fetch-old) (when (nnvirtual-possibly-change-server server) (with-current-buffer nntp-server-buffer (erase-buffer) @@ -186,7 +186,7 @@ It is computed from the marks of individual component groups.") (defvoo nnvirtual-last-accessed-component-group nil) -(deffoo nnvirtual-request-article (article &optional group server buffer) +(deffoo nnvirtual-request-article (article &optional _group server buffer) (when (nnvirtual-possibly-change-server server) (if (stringp article) ;; This is a fetch by Message-ID. @@ -250,7 +250,7 @@ It is computed from the marks of individual component groups.") t))) -(deffoo nnvirtual-request-group (group &optional server dont-check info) +(deffoo nnvirtual-request-group (group &optional server dont-check _info) (nnvirtual-possibly-change-server server) (setq nnvirtual-component-groups (delete (nnvirtual-current-group) nnvirtual-component-groups)) @@ -269,7 +269,7 @@ It is computed from the marks of individual component groups.") nnvirtual-mapping-len nnvirtual-mapping-len group)))) -(deffoo nnvirtual-request-type (group &optional article) +(deffoo nnvirtual-request-type (_group &optional article) (if (not article) 'unknown (if (numberp article) @@ -279,7 +279,7 @@ It is computed from the marks of individual component groups.") (gnus-request-type nnvirtual-last-accessed-component-group nil)))) -(deffoo nnvirtual-request-update-mark (group article mark) +(deffoo nnvirtual-request-update-mark (_group article mark) (let* ((nart (nnvirtual-map-article article)) (cgroup (car nart))) (when (and nart @@ -291,22 +291,22 @@ It is computed from the marks of individual component groups.") mark) -(deffoo nnvirtual-close-group (group &optional server) +(deffoo nnvirtual-close-group (_group &optional server) (when (and (nnvirtual-possibly-change-server server) (not (gnus-ephemeral-group-p (nnvirtual-current-group)))) (nnvirtual-update-read-and-marked t t)) t) -(deffoo nnvirtual-request-newgroups (date &optional server) +(deffoo nnvirtual-request-newgroups (_date &optional _server) (nnheader-report 'nnvirtual "NEWGROUPS is not supported.")) -(deffoo nnvirtual-request-list-newsgroups (&optional server) +(deffoo nnvirtual-request-list-newsgroups (&optional _server) (nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented.")) -(deffoo nnvirtual-request-update-info (group info &optional server) +(deffoo nnvirtual-request-update-info (_group info &optional server) (when (and (nnvirtual-possibly-change-server server) (not nnvirtual-info-installed)) ;; Install the precomputed lists atomically, so the virtual group @@ -321,7 +321,7 @@ It is computed from the marks of individual component groups.") t)) -(deffoo nnvirtual-catchup-group (group &optional server all) +(deffoo nnvirtual-catchup-group (_group &optional server all) (when (and (nnvirtual-possibly-change-server server) (not (gnus-ephemeral-group-p (nnvirtual-current-group)))) ;; copy over existing marks first, in case they set anything @@ -339,12 +339,12 @@ It is computed from the marks of individual component groups.") (gnus-group-catchup-current nil all))))) -(deffoo nnvirtual-find-group-art (group article) +(deffoo nnvirtual-find-group-art (_group article) "Return the real group and article for virtual GROUP and ARTICLE." (nnvirtual-map-article article)) -(deffoo nnvirtual-request-post (&optional server) +(deffoo nnvirtual-request-post (&optional _server) (if (not gnus-message-group-art) (nnheader-report 'nnvirtual "Can't post to an nnvirtual group") (let ((group (car (nnvirtual-find-group-art @@ -353,8 +353,8 @@ It is computed from the marks of individual component groups.") (gnus-request-post (gnus-find-method-for-group group))))) -(deffoo nnvirtual-request-expire-articles (articles group - &optional server force) +(deffoo nnvirtual-request-expire-articles ( _articles _group + &optional server _force) (nnvirtual-possibly-change-server server) (setq nnvirtual-component-groups (delete (nnvirtual-current-group) nnvirtual-component-groups)) @@ -367,7 +367,7 @@ It is computed from the marks of individual component groups.") group article)) (gnus-uncompress-range (gnus-group-expire-articles-1 group)))))) - (sort (delq nil unexpired) '<))) + (sort (delq nil unexpired) #'<))) ;;; Internal functions. @@ -378,7 +378,7 @@ It is computed from the marks of individual component groups.") (let* ((dependencies (make-hash-table :test #'equal)) (headers (gnus-get-newsgroup-headers dependencies))) (erase-buffer) - (mapc 'nnheader-insert-nov headers)))) + (mapc #'nnheader-insert-nov headers)))) (defun nnvirtual-update-xref-header (group article prefix sysname) @@ -502,7 +502,7 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." "Merge many sorted lists of numbers." (if (null (cdr lists)) (car lists) - (sort (apply 'nconc lists) '<))) + (sort (apply #'nconc lists) #'<))) ;; We map between virtual articles and real articles in a manner @@ -648,7 +648,7 @@ numbers has no corresponding component article, then it is left out of the result." (when (numberp (cdr-safe articles)) (setq articles (list articles))) - (let ((carticles (mapcar 'list nnvirtual-component-groups)) + (let ((carticles (mapcar #'list nnvirtual-component-groups)) a i j article entry) (while (setq a (pop articles)) (if (atom a) @@ -750,7 +750,7 @@ based on the marks on the component groups." ;; Now that the mapping tables are generated, we can convert ;; and combine the separate component unreads and marks lists ;; into single lists of virtual article numbers. - (setq unreads (apply 'nnvirtual-merge-sorted-lists + (setq unreads (apply #'nnvirtual-merge-sorted-lists (mapcar (lambda (x) (nnvirtual-reverse-map-sequence (car x) (cdr x))) @@ -760,7 +760,7 @@ based on the marks on the component groups." (cons (cdr type) (gnus-compress-sequence (apply - 'nnvirtual-merge-sorted-lists + #'nnvirtual-merge-sorted-lists (mapcar (lambda (x) (nnvirtual-reverse-map-sequence (car x) diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index b8fb4a8373a..f08dc47e313 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -1,4 +1,4 @@ -;;; nnweb.el --- retrieving articles via web search engines +;;; nnweb.el --- retrieving articles via web search engines -*- lexical-binding: t; -*- ;; Copyright (C) 1996-2021 Free Software Foundation, Inc. @@ -96,7 +96,7 @@ Valid types include `google', `dejanews', and `gmane'.") (nnoo-define-basics nnweb) -(deffoo nnweb-retrieve-headers (articles &optional group server fetch-old) +(deffoo nnweb-retrieve-headers (articles &optional group server _fetch-old) (nnweb-possibly-change-server group server) (with-current-buffer nntp-server-buffer (erase-buffer) @@ -117,7 +117,7 @@ Valid types include `google', `dejanews', and `gmane'.") (nnweb-write-active) (nnweb-write-overview group))) -(deffoo nnweb-request-group (group &optional server dont-check info) +(deffoo nnweb-request-group (group &optional server dont-check _info) (nnweb-possibly-change-server group server) (unless (or nnweb-ephemeral-p dont-check @@ -154,17 +154,17 @@ Valid types include `google', `dejanews', and `gmane'.") (and (stringp article) (nnweb-definition 'id t) (let ((fetch (nnweb-definition 'id)) - art active) - (when (string-match "^<\\(.*\\)>$" article) - (setq art (match-string 1 article))) + (art (when (string-match "^<\\(.*\\)>$" article) + (match-string 1 article))) + ) ;; active (when (and fetch art) (setq url (format fetch (mm-url-form-encode-xwfu art))) (mm-url-insert url) (if (nnweb-definition 'reference t) (setq article - (funcall (nnweb-definition - 'reference) article))))))) + (funcall (nnweb-definition 'reference) + article))))))) (unless nnheader-callback-function (funcall (nnweb-definition 'article))) (nnheader-report 'nnweb "Fetched article %s" article) @@ -184,19 +184,19 @@ Valid types include `google', `dejanews', and `gmane'.") (nnmail-generate-active (list (assoc server nnweb-group-alist))) t)) -(deffoo nnweb-request-update-info (group info &optional server)) +(deffoo nnweb-request-update-info (_group _info &optional _server)) (deffoo nnweb-asynchronous-p () nil) -(deffoo nnweb-request-create-group (group &optional server args) +(deffoo nnweb-request-create-group (group &optional server _args) (nnweb-possibly-change-server nil server) (nnweb-request-delete-group group) (push `(,group ,(cons 1 0)) nnweb-group-alist) (nnweb-write-active) t) -(deffoo nnweb-request-delete-group (group &optional force server) +(deffoo nnweb-request-delete-group (group &optional _force server) (nnweb-possibly-change-server group server) (gnus-alist-pull group nnweb-group-alist t) (nnweb-write-active) @@ -317,7 +317,7 @@ Valid types include `google', `dejanews', and `gmane'.") (let ((i 0) (case-fold-search t) (active (cadr (assoc nnweb-group nnweb-group-alist))) - Subject Score Date Newsgroups From + Subject Date Newsgroups From map url mid) (unless active (push (list nnweb-group (setq active (cons 1 0))) @@ -411,7 +411,7 @@ Valid types include `google', `dejanews', and `gmane'.") ;; Return the articles in the right order. (nnheader-message 7 "Searching google...done") (setq nnweb-articles - (sort nnweb-articles 'car-less-than-car)))))) + (sort nnweb-articles #'car-less-than-car)))))) (defun nnweb-google-search (search) (mm-url-insert @@ -481,7 +481,7 @@ Valid types include `google', `dejanews', and `gmane'.") (forward-line 1))) (nnheader-message 7 "Searching Gmane...done") (setq nnweb-articles - (sort (nconc nnweb-articles map) 'car-less-than-car))))) + (sort (nconc nnweb-articles map) #'car-less-than-car))))) (defun nnweb-gmane-wash-article () (let ((case-fold-search t)) @@ -534,7 +534,7 @@ Valid types include `google', `dejanews', and `gmane'.") (nth 1 parse) " ")) (insert ">\n") - (mapc 'nnweb-insert-html (nth 2 parse)) + (mapc #'nnweb-insert-html (nth 2 parse)) (insert "</" (symbol-name (car parse)) ">\n"))) (defun nnweb-parse-find (type parse &optional maxdepth) diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el index b8726c03c3e..d3ed3600ad9 100644 --- a/lisp/gnus/score-mode.el +++ b/lisp/gnus/score-mode.el @@ -1,4 +1,4 @@ -;;; score-mode.el --- mode for editing Gnus score files +;;; score-mode.el --- mode for editing Gnus score files -*- lexical-binding: t; -*- ;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc. diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el index d9e04f3b40c..3ee59479cf5 100644 --- a/lisp/gnus/smiley.el +++ b/lisp/gnus/smiley.el @@ -1,4 +1,4 @@ -;;; smiley.el --- displaying smiley faces +;;; smiley.el --- displaying smiley faces -*- lexical-binding: t; -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. @@ -71,9 +71,8 @@ (set-default symbol value) (setq smiley-data-directory (smiley-directory)) (smiley-update-cache)) - :initialize 'custom-initialize-default - :version "23.1" ;; No Gnus - :group 'smiley) + :initialize #'custom-initialize-default + :version "23.1") ;; No Gnus ;; For compatibility, honor the variable `smiley-data-directory' if the user ;; has set it. @@ -94,9 +93,8 @@ is nil, use `smiley-style'." :set (lambda (symbol value) (set-default symbol value) (smiley-update-cache)) - :initialize 'custom-initialize-default - :type 'directory - :group 'smiley) + :initialize #'custom-initialize-default + :type 'directory) (defcustom smiley-emoji-regexp-alist '(("\\(;-)\\)\\W" 1 "😉") @@ -124,8 +122,7 @@ regexp to replace with EMOJI." :set (lambda (symbol value) (set-default symbol value) (smiley-update-cache)) - :initialize 'custom-initialize-default - :group 'smiley) + :initialize #'custom-initialize-default) ;; The XEmacs version has a baroque, if not rococo, set of these. (defcustom smiley-regexp-alist @@ -154,8 +151,7 @@ regexp to replace with IMAGE. IMAGE is the name of an image file in :set (lambda (symbol value) (set-default symbol value) (smiley-update-cache)) - :initialize 'custom-initialize-default - :group 'smiley) + :initialize #'custom-initialize-default) (defcustom gnus-smiley-file-types (let ((types (list "pbm"))) @@ -166,8 +162,7 @@ regexp to replace with IMAGE. IMAGE is the name of an image file in types) "List of suffixes on smiley file names to try." :version "24.1" - :type '(repeat string) - :group 'smiley) + :type '(repeat string)) (defvar smiley-cached-regexp-alist nil) diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index ae5d171d871..8900be5e4f1 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -135,8 +135,7 @@ certificates to be sent with every message to each address." :type '(repeat (list (string :tag "Mail address") (file :tag "File name") (repeat :tag "Additional certificate files" - (file :tag "File name")))) - :group 'smime) + (file :tag "File name"))))) (defcustom smime-CA-directory nil "Directory containing certificates for CAs you trust. @@ -148,16 +147,14 @@ $ ln -s ca.pem \\=`openssl x509 -noout -hash -in ca.pem\\=`.0 where `ca.pem' is the file containing a PEM encoded X.509 CA certificate." :type '(choice (const :tag "none" nil) - directory) - :group 'smime) + directory)) (defcustom smime-CA-file nil "Files containing certificates for CAs you trust. File should contain certificates in PEM format." :version "22.1" :type '(choice (const :tag "none" nil) - file) - :group 'smime) + file)) (defcustom smime-certificate-directory "~/Mail/certs/" "Directory containing other people's certificates. @@ -166,8 +163,7 @@ and the files themselves should be in PEM format." ;The S/MIME library provide simple functionality for fetching ;certificates into this directory, so there is no need to populate it ;manually. - :type 'directory - :group 'smime) + :type 'directory) (defcustom smime-openssl-program (and (condition-case () @@ -176,8 +172,7 @@ and the files themselves should be in PEM format." "openssl") "Name of OpenSSL binary or nil if none." :type '(choice string - (const :tag "none" nil)) - :group 'smime) + (const :tag "none" nil))) ;; OpenSSL option to select the encryption cipher @@ -191,8 +186,7 @@ and the files themselves should be in PEM format." (const :tag "AES 128 bits" "-aes128") (const :tag "RC2 40 bits" "-rc2-40") (const :tag "RC2 64 bits" "-rc2-64") - (const :tag "RC2 128 bits" "-rc2-128")) - :group 'smime) + (const :tag "RC2 128 bits" "-rc2-128"))) (defcustom smime-crl-check nil "Check revocation status of signers certificate using CRLs. @@ -212,24 +206,21 @@ certificate with .r0 as file name extension. At least OpenSSL version 0.9.7 is required for this to work." :type '(choice (const :tag "No check" nil) (const :tag "Check certificate" "-crl_check") - (const :tag "Check certificate chain" "-crl_check_all")) - :group 'smime) + (const :tag "Check certificate chain" "-crl_check_all"))) (defcustom smime-dns-server nil "DNS server to query certificates from. If nil, use system defaults." :version "22.1" :type '(choice (const :tag "System defaults") - string) - :group 'smime) + string)) (defcustom smime-ldap-host-list nil "A list of LDAP hosts with S/MIME user certificates. If needed search base, binddn, passwd, etc. for the LDAP host must be set in `ldap-host-parameters-alist'." :type '(repeat (string :tag "Host name")) - :version "23.1" ;; No Gnus - :group 'smime) + :version "23.1") ;; No Gnus (defvar smime-details-buffer "*OpenSSL output*") @@ -282,7 +273,7 @@ key and certificate itself." (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) (prog1 (when (prog1 - (apply 'smime-call-openssl-region b e (list buffer tmpfile) + (apply #'smime-call-openssl-region b e (list buffer tmpfile) "smime" "-sign" "-signer" (expand-file-name keyfile) (append (smime-make-certfiles certfiles) @@ -314,9 +305,9 @@ is expected to contain of a PEM encoded certificate." (tmpfile (make-temp-file "smime"))) (prog1 (when (prog1 - (apply 'smime-call-openssl-region b e (list buffer tmpfile) + (apply #'smime-call-openssl-region b e (list buffer tmpfile) "smime" "-encrypt" smime-encrypt-cipher - (mapcar 'expand-file-name certfiles)) + (mapcar #'expand-file-name certfiles)) (with-current-buffer smime-details-buffer (insert-file-contents tmpfile) (delete-file tmpfile))) @@ -384,7 +375,7 @@ Any details (stdout and stderr) are left in the buffer specified by (with-temp-buffer (let ((result-buffer (current-buffer))) (with-current-buffer input-buffer - (if (apply 'smime-call-openssl-region b e (list result-buffer + (if (apply #'smime-call-openssl-region b e (list result-buffer smime-details-buffer) "smime" "-verify" "-out" "-" CAs) (with-current-buffer result-buffer @@ -397,7 +388,7 @@ Returns non-nil on success. Any details (stdout and stderr) are left in the buffer specified by `smime-details-buffer'." (smime-new-details-buffer) - (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t) + (if (apply #'smime-call-openssl-region b e (list smime-details-buffer t) "smime" "-verify" "-noverify" "-out" `(,null-device)) t (insert-buffer-substring smime-details-buffer) @@ -416,7 +407,7 @@ in the buffer specified by `smime-details-buffer'." (if passphrase (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) (if (prog1 - (apply 'smime-call-openssl-region b e + (apply #'smime-call-openssl-region b e (list buffer tmpfile) "smime" "-decrypt" "-recip" (expand-file-name keyfile) (if passphrase diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index 8c148ce9d91..d87a6c2af0d 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -1,4 +1,4 @@ -;;; spam-report.el --- Reporting spam +;;; spam-report.el --- Reporting spam -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. @@ -43,8 +43,7 @@ If you are using spam.el, consider setting gnus-spam-process-newsgroups or the gnus-group-spam-exit-processor-report-gmane group/topic parameter instead." :type '(radio (const nil) - (regexp :value "^nntp\\+.*:gmane\\.")) - :group 'spam-report) + (regexp :value "^nntp\\+.*:gmane\\."))) (defcustom spam-report-gmane-use-article-number t "Whether the article number (faster!) or the header should be used. @@ -52,8 +51,7 @@ instead." You must set this to nil if you don't read Gmane groups directly from news.gmane.org, e.g. when using local newsserver such as leafnode." - :type 'boolean - :group 'spam-report) + :type 'boolean) (defcustom spam-report-url-ping-function 'spam-report-url-ping-plain @@ -66,23 +64,20 @@ The function must accept the arguments `host' and `report'." spam-report-url-ping-mm-url) (const :tag "Store request URLs in `spam-report-requests-file'" spam-report-url-to-file) - (function :tag "User defined function" nil)) - :group 'spam-report) + (function :tag "User defined function" nil))) (defcustom spam-report-requests-file (nnheader-concat gnus-directory "spam/" "spam-report-requests.url") ;; Is there a convention for the extension of such a file? ;; Should we use `spam-directory'? "File where spam report request are stored." - :type 'file - :group 'spam-report) + :type 'file) (defcustom spam-report-resend-to nil "Email address that spam articles are resent to when reporting. If not set, the user will be prompted to enter a value which will be saved for future use." - :type '(choice (const :tag "Prompt" nil) string) - :group 'spam-report) + :type '(choice (const :tag "Prompt" nil) string)) (defvar spam-report-url-ping-temp-agent-function nil "Internal variable for `spam-report-agentize' and `spam-report-deagentize'. @@ -232,8 +227,7 @@ the function specified by `spam-report-url-ping-function'." This is initialized based on `user-mail-address'." :type '(choice string (const :tag "Don't expose address" nil)) - :version "23.1" ;; No Gnus - :group 'spam-report) + :version "23.1") ;; No Gnus (defvar spam-report-user-agent (if spam-report-user-mail-address @@ -345,8 +339,8 @@ Spam reports will be queued with \\[spam-report-url-to-file] when the Agent is unplugged, and will be submitted in a batch when the Agent is plugged." (interactive) - (add-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent) - (add-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent)) + (add-hook 'gnus-agent-plugged-hook #'spam-report-plug-agent) + (add-hook 'gnus-agent-unplugged-hook #'spam-report-unplug-agent)) ;;;###autoload (defun spam-report-deagentize () @@ -354,8 +348,8 @@ Agent is plugged." Spam reports will be queued with the method used when \\[spam-report-agentize] was run." (interactive) - (remove-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent) - (remove-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent)) + (remove-hook 'gnus-agent-plugged-hook #'spam-report-plug-agent) + (remove-hook 'gnus-agent-unplugged-hook #'spam-report-unplug-agent)) (defun spam-report-plug-agent () "Adjust spam report settings for plugged state. diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index 3662ade2663..70753cad9ca 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -1,4 +1,4 @@ -;;; spam-stat.el --- detecting spam based on statistics +;;; spam-stat.el --- detecting spam based on statistics -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. @@ -135,42 +135,35 @@ whether a buffer contains spam or not." (defcustom spam-stat-file "~/.spam-stat.el" "File used to save and load the dictionary. See `spam-stat-to-hash-table' for the format of the file." - :type 'file - :group 'spam-stat) + :type 'file) (defcustom spam-stat-unknown-word-score 0.2 "The score to use for unknown words. Also used for words that don't appear often enough." - :type 'number - :group 'spam-stat) + :type 'number) (defcustom spam-stat-max-word-length 15 "Only words shorter than this will be considered." - :type 'integer - :group 'spam-stat) + :type 'integer) (defcustom spam-stat-max-buffer-length 10240 "Only the beginning of buffers will be analyzed. This variable says how many characters this will be." - :type 'integer - :group 'spam-stat) + :type 'integer) (defcustom spam-stat-split-fancy-spam-group "mail.spam" "Name of the group where spam should be stored. If `spam-stat-split-fancy' is used in fancy splitting rules. Has no effect when spam-stat is invoked through spam.el." - :type 'string - :group 'spam-stat) + :type 'string) (defcustom spam-stat-split-fancy-spam-threshold 0.9 "Spam score threshold in spam-stat-split-fancy." - :type 'number - :group 'spam-stat) + :type 'number) (defcustom spam-stat-washing-hook nil "Hook applied to each message before analysis." - :type 'hook - :group 'spam-stat) + :type 'hook) (defcustom spam-stat-score-buffer-user-functions nil "List of additional scoring functions. @@ -187,8 +180,7 @@ Also be careful when defining such functions. If they take a long time, they will slow down your mail splitting. Thus, if the buffer is large, don't forget to use smaller regions, by wrapping your work in, say, `with-spam-stat-max-buffer-size'." - :type '(repeat sexp) - :group 'spam-stat) + :type '(repeat sexp)) (defcustom spam-stat-process-directory-age 90 "Max. age of files to be processed in directory, in days. @@ -197,8 +189,7 @@ When using `spam-stat-process-spam-directory' or been touched in this many days will be considered. Without this filter, re-training spam-stat with several thousand messages will start to take a very long time." - :type 'number - :group 'spam-stat) + :type 'number) (defvar spam-stat-last-saved-at nil "Time stamp of last change of spam-stat-file on this run") @@ -260,9 +251,6 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good', (defvar spam-stat-nbad 0 "The number of bad mails in the dictionary.") -(defvar spam-stat-error-holder nil - "A holder for condition-case errors while scoring buffers.") - (defsubst spam-stat-good (entry) "Return the number of times this word belongs to good mails." (aref entry 0)) @@ -486,8 +474,8 @@ The default score for unknown words is stored in These are the words whose spam-stat differs the most from 0.5. The list returned contains elements of the form \(WORD SCORE DIFF), where DIFF is the difference between SCORE and 0.5." - (let (result word score) - (maphash (lambda (word ignore) + (let (result score) ;; word + (maphash (lambda (word _ignore) (setq score (spam-stat-score-word word) result (cons (list word score (abs (- score 0.5))) result))) @@ -501,14 +489,13 @@ where DIFF is the difference between SCORE and 0.5." Add user supplied modifications if supplied." (interactive) ; helps in debugging. (setq spam-stat-score-data (spam-stat-buffer-words-with-scores)) - (let* ((probs (mapcar 'cadr spam-stat-score-data)) + (let* ((probs (mapcar #'cadr spam-stat-score-data)) (prod (apply #'* probs)) (score0 (/ prod (+ prod (apply #'* (mapcar #'(lambda (x) (- 1 x)) probs))))) (score1s - (condition-case - spam-stat-error-holder + (condition-case nil (spam-stat-score-buffer-user score0) (error nil))) (ans @@ -531,7 +518,7 @@ Add user supplied modifications if supplied." Use this function on `nnmail-split-fancy'. If you are interested in the raw data used for the last run of `spam-stat-score-buffer', check the variable `spam-stat-score-data'." - (condition-case spam-stat-error-holder + (condition-case err (progn (set-buffer spam-stat-buffer) (goto-char (point-min)) @@ -541,7 +528,7 @@ check the variable `spam-stat-score-data'." (push entry nnmail-split-trace)) spam-stat-score-data)) spam-stat-split-fancy-spam-group)) - (error (message "Error in spam-stat-split-fancy: %S" spam-stat-error-holder) + (error (message "Error in spam-stat-split-fancy: %S" err) nil))) ;; Testing @@ -652,19 +639,19 @@ COUNT defaults to 5" "Install the spam-stat function hooks." (interactive) (add-hook 'nnmail-prepare-incoming-message-hook - 'spam-stat-store-current-buffer) + #'spam-stat-store-current-buffer) (add-hook 'gnus-select-article-hook - 'spam-stat-store-gnus-article-buffer)) + #'spam-stat-store-gnus-article-buffer)) (defun spam-stat-unload-hook () "Uninstall the spam-stat function hooks." (interactive) (remove-hook 'nnmail-prepare-incoming-message-hook - 'spam-stat-store-current-buffer) + #'spam-stat-store-current-buffer) (remove-hook 'gnus-select-article-hook - 'spam-stat-store-gnus-article-buffer)) + #'spam-stat-store-gnus-article-buffer)) -(add-hook 'spam-stat-unload-hook 'spam-stat-unload-hook) +(add-hook 'spam-stat-unload-hook #'spam-stat-unload-hook) (provide 'spam-stat) diff --git a/lisp/gnus/spam-wash.el b/lisp/gnus/spam-wash.el index 1d00a39060d..bb2a1b97ada 100644 --- a/lisp/gnus/spam-wash.el +++ b/lisp/gnus/spam-wash.el @@ -1,4 +1,4 @@ -;;; spam-wash.el --- wash spam before analysis +;;; spam-wash.el --- wash spam before analysis -*- lexical-binding: t; -*- ;; Copyright (C) 2004, 2007-2021 Free Software Foundation, Inc. @@ -43,7 +43,7 @@ (handles (or (mm-dissect-buffer nil gnus-article-loose-mime) (and gnus-article-emulate-mime (mm-uu-dissect)))) - handle) + ) ;; handle (when gnus-article-mime-handles (mm-destroy-parts gnus-article-mime-handles) (setq gnus-article-mime-handle-alist nil)) @@ -57,7 +57,7 @@ (defun spam-treat-parts (handle) (if (stringp (car handle)) - (mapcar 'spam-treat-parts (cdr handle)) + (mapcar #'spam-treat-parts (cdr handle)) (if (bufferp (car handle)) (save-restriction (narrow-to-region (point) (point)) @@ -65,7 +65,7 @@ (string-match "text" (car (mm-handle-type handle)))) (mm-insert-part handle)) (goto-char (point-max))) - (mapcar 'spam-treat-parts handle)))) + (mapcar #'spam-treat-parts handle)))) (provide 'spam-wash) diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 22810332b65..f7288c98f6f 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -1,4 +1,4 @@ -;;; spam.el --- Identifying spam +;;; spam.el --- Identifying spam -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. @@ -321,8 +321,8 @@ Default to t if one of the spam-use-* variables is set." :type 'string :group 'spam) -;;; TODO: deprecate this variable, it's confusing since it's a list of strings, -;;; not regular expressions +;; TODO: deprecate this variable, it's confusing since it's a list of strings, +;; not regular expressions (defcustom spam-junk-mailgroups (cons spam-split-group '("mail.junk" "poste.pourriel")) @@ -705,7 +705,7 @@ finds ham or spam.") "Clear the `spam-caches' entry for a check." (remhash symbol spam-caches)) -(define-obsolete-function-alias 'spam-xor 'xor "27.1") +(define-obsolete-function-alias 'spam-xor #'xor "27.1") (defun spam-set-difference (list1 list2) "Return a set difference of LIST1 and LIST2. @@ -727,7 +727,7 @@ When either list is nil, the other is returned." (let* ((marks (spam-group-ham-marks group spam)) (marks (if (symbolp mark) marks - (mapcar 'symbol-value marks)))) + (mapcar #'symbol-value marks)))) (memq mark marks)))) (defun spam-group-spam-mark-p (group mark) @@ -1014,28 +1014,28 @@ backends)." ;;{{{ backend installations (spam-install-checkonly-backend 'spam-use-blackholes - 'spam-check-blackholes) + #'spam-check-blackholes) (spam-install-checkonly-backend 'spam-use-hashcash - 'spam-check-hashcash) + #'spam-check-hashcash) (spam-install-checkonly-backend 'spam-use-spamassassin-headers - 'spam-check-spamassassin-headers) + #'spam-check-spamassassin-headers) (spam-install-checkonly-backend 'spam-use-bogofilter-headers - 'spam-check-bogofilter-headers) + #'spam-check-bogofilter-headers) (spam-install-checkonly-backend 'spam-use-bsfilter-headers - 'spam-check-bsfilter-headers) + #'spam-check-bsfilter-headers) (spam-install-checkonly-backend 'spam-use-gmane-xref - 'spam-check-gmane-xref) + #'spam-check-gmane-xref) (spam-install-checkonly-backend 'spam-use-regex-headers - 'spam-check-regex-headers) + #'spam-check-regex-headers) (spam-install-statistical-checkonly-backend 'spam-use-regex-body - 'spam-check-regex-body) + #'spam-check-regex-body) ;; TODO: NOTE: spam-use-ham-copy is now obsolete, use (ham spam-use-copy) (spam-install-mover-backend 'spam-use-move @@ -1045,94 +1045,94 @@ backends)." nil) (spam-install-nocheck-backend 'spam-use-copy - 'spam-copy-ham-routine - 'spam-copy-spam-routine + #'spam-copy-ham-routine + #'spam-copy-spam-routine nil nil) (spam-install-nocheck-backend 'spam-use-gmane - 'spam-report-gmane-unregister-routine - 'spam-report-gmane-register-routine - 'spam-report-gmane-register-routine - 'spam-report-gmane-unregister-routine) + #'spam-report-gmane-unregister-routine + #'spam-report-gmane-register-routine + #'spam-report-gmane-register-routine + #'spam-report-gmane-unregister-routine) (spam-install-nocheck-backend 'spam-use-resend - 'spam-report-resend-register-ham-routine - 'spam-report-resend-register-routine + #'spam-report-resend-register-ham-routine + #'spam-report-resend-register-routine nil nil) (spam-install-backend 'spam-use-BBDB - 'spam-check-BBDB - 'spam-BBDB-register-routine + #'spam-check-BBDB + #'spam-BBDB-register-routine nil - 'spam-BBDB-unregister-routine + #'spam-BBDB-unregister-routine nil) (spam-install-backend-alias 'spam-use-BBDB 'spam-use-BBDB-exclusive) (spam-install-backend 'spam-use-blacklist - 'spam-check-blacklist + #'spam-check-blacklist nil - 'spam-blacklist-register-routine + #'spam-blacklist-register-routine nil - 'spam-blacklist-unregister-routine) + #'spam-blacklist-unregister-routine) (spam-install-backend 'spam-use-whitelist - 'spam-check-whitelist - 'spam-whitelist-register-routine + #'spam-check-whitelist + #'spam-whitelist-register-routine nil - 'spam-whitelist-unregister-routine + #'spam-whitelist-unregister-routine nil) (spam-install-statistical-backend 'spam-use-ifile - 'spam-check-ifile - 'spam-ifile-register-ham-routine - 'spam-ifile-register-spam-routine - 'spam-ifile-unregister-ham-routine - 'spam-ifile-unregister-spam-routine) + #'spam-check-ifile + #'spam-ifile-register-ham-routine + #'spam-ifile-register-spam-routine + #'spam-ifile-unregister-ham-routine + #'spam-ifile-unregister-spam-routine) (spam-install-statistical-backend 'spam-use-spamoracle - 'spam-check-spamoracle - 'spam-spamoracle-learn-ham - 'spam-spamoracle-learn-spam - 'spam-spamoracle-unlearn-ham - 'spam-spamoracle-unlearn-spam) + #'spam-check-spamoracle + #'spam-spamoracle-learn-ham + #'spam-spamoracle-learn-spam + #'spam-spamoracle-unlearn-ham + #'spam-spamoracle-unlearn-spam) (spam-install-statistical-backend 'spam-use-stat - 'spam-check-stat - 'spam-stat-register-ham-routine - 'spam-stat-register-spam-routine - 'spam-stat-unregister-ham-routine - 'spam-stat-unregister-spam-routine) + #'spam-check-stat + #'spam-stat-register-ham-routine + #'spam-stat-register-spam-routine + #'spam-stat-unregister-ham-routine + #'spam-stat-unregister-spam-routine) (spam-install-statistical-backend 'spam-use-spamassassin - 'spam-check-spamassassin - 'spam-spamassassin-register-ham-routine - 'spam-spamassassin-register-spam-routine - 'spam-spamassassin-unregister-ham-routine - 'spam-spamassassin-unregister-spam-routine) + #'spam-check-spamassassin + #'spam-spamassassin-register-ham-routine + #'spam-spamassassin-register-spam-routine + #'spam-spamassassin-unregister-ham-routine + #'spam-spamassassin-unregister-spam-routine) (spam-install-statistical-backend 'spam-use-bogofilter - 'spam-check-bogofilter - 'spam-bogofilter-register-ham-routine - 'spam-bogofilter-register-spam-routine - 'spam-bogofilter-unregister-ham-routine - 'spam-bogofilter-unregister-spam-routine) + #'spam-check-bogofilter + #'spam-bogofilter-register-ham-routine + #'spam-bogofilter-register-spam-routine + #'spam-bogofilter-unregister-ham-routine + #'spam-bogofilter-unregister-spam-routine) (spam-install-statistical-backend 'spam-use-bsfilter - 'spam-check-bsfilter - 'spam-bsfilter-register-ham-routine - 'spam-bsfilter-register-spam-routine - 'spam-bsfilter-unregister-ham-routine - 'spam-bsfilter-unregister-spam-routine) + #'spam-check-bsfilter + #'spam-bsfilter-register-ham-routine + #'spam-bsfilter-register-spam-routine + #'spam-bsfilter-unregister-ham-routine + #'spam-bsfilter-unregister-spam-routine) (spam-install-statistical-backend 'spam-use-crm114 - 'spam-check-crm114 - 'spam-crm114-register-ham-routine - 'spam-crm114-register-spam-routine - 'spam-crm114-unregister-ham-routine - 'spam-crm114-unregister-spam-routine) + #'spam-check-crm114 + #'spam-crm114-register-ham-routine + #'spam-crm114-register-spam-routine + #'spam-crm114-unregister-ham-routine + #'spam-crm114-unregister-spam-routine) ;;}}} ;;{{{ scoring and summary formatting @@ -1387,7 +1387,7 @@ In the case of mover backends, checks the setting of (gnus-check-backend-function 'request-move-article gnus-newsgroup-name)) (respool-method (gnus-find-method-for-group gnus-newsgroup-name)) - article mark deletep respool valid-move-destinations) + deletep respool valid-move-destinations) ;; article mark (when (member 'respool groups) (setq respool t) ; boolean for later @@ -1709,7 +1709,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (if (or (null first-method) (equal first-method 'default)) (spam-split) - (apply 'spam-split methods)))))) + (apply #'spam-split methods)))))) (if (equal split-return 'spam) (gnus-summary-mark-article article gnus-spam-mark)) @@ -1807,7 +1807,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (log-function (if unregister 'spam-log-undo-registration 'spam-log-processing-to-registry)) - article articles) + articles) ;; article (when run-function ;; make list of articles, using specific-articles if given @@ -1836,7 +1836,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;; return the number of articles processed (length articles)))) -;;; log a ham- or spam-processor invocation to the registry +;; log a ham- or spam-processor invocation to the registry (defun spam-log-processing-to-registry (id type classification backend group) (when spam-log-to-registry (if (and (stringp id) @@ -1855,7 +1855,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." "%s call with bad ID, type, classification, spam-backend, or group" "spam-log-processing-to-registry"))))) -;;; check if a ham- or spam-processor registration has been done +;; check if a ham- or spam-processor registration has been done (defun spam-log-registered-p (id type) (when spam-log-to-registry (if (and (stringp id) @@ -1868,8 +1868,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." "spam-log-registered-p")) nil)))) -;;; check what a ham- or spam-processor registration says -;;; returns nil if conflicting registrations are found +;; check what a ham- or spam-processor registration says +;; returns nil if conflicting registrations are found (defun spam-log-registration-type (id type) (let ((count 0) decision) @@ -1885,7 +1885,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." decision))) -;;; check if a ham- or spam-processor registration needs to be undone +;; check if a ham- or spam-processor registration needs to be undone (defun spam-log-unregistration-needed-p (id type classification backend) (when spam-log-to-registry (if (and (stringp id) @@ -1908,9 +1908,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." nil)))) -;;; undo a ham- or spam-processor registration (the group is not used) +;; undo a ham- or spam-processor registration (the group is not used) (defun spam-log-undo-registration (id type classification backend - &optional group) + &optional _group) (when (and spam-log-to-registry (spam-log-unregistration-needed-p id type classification backend)) (if (and (stringp id) @@ -1918,7 +1918,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (spam-classification-valid-p classification) (spam-backend-valid-p backend)) (let ((cell-list (gnus-registry-get-id-key id type)) - new-cell-list found) + new-cell-list) ;; found (dolist (cell cell-list) (unless (and (eq classification (nth 0 cell)) (eq backend (nth 1 cell))) @@ -1981,7 +1981,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (defun spam-reverse-ip-string (ip) (when (stringp ip) - (mapconcat 'identity + (mapconcat #'identity (nreverse (split-string ip "\\.")) "."))) @@ -2034,94 +2034,83 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;;{{{ BBDB -;;; original idea for spam-check-BBDB from Alexander Kotelnikov -;;; <sacha@giotto.sj.ru> +;; original idea for spam-check-BBDB from Alexander Kotelnikov +;; <sacha@giotto.sj.ru> ;; all this is done inside a condition-case to trap errors ;; Autoloaded in message, which we require. (declare-function gnus-extract-address-components "gnus-util" (from)) -(eval-and-compile - (condition-case nil - (progn - (require 'bbdb) - (require 'bbdb-com)) - (file-error - ;; `bbdb-records' should not be bound as an autoload function - ;; before loading bbdb because of `bbdb-hashtable-size'. - (defalias 'bbdb-buffer 'ignore) - (defalias 'bbdb-create-internal 'ignore) - (defalias 'bbdb-records 'ignore) - (defalias 'spam-BBDB-register-routine 'ignore) - (defalias 'spam-enter-ham-BBDB 'ignore) - (defalias 'spam-exists-in-BBDB-p 'ignore) - (defalias 'bbdb-gethash 'ignore) - nil))) - -(eval-and-compile - (when (featurep 'bbdb-com) - ;; when the BBDB changes, we want to clear out our cache - (defun spam-clear-cache-BBDB (&rest immaterial) - (spam-clear-cache 'spam-use-BBDB)) - - (add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB) - - (defun spam-enter-ham-BBDB (addresses &optional remove) - "Enter an address into the BBDB; implies ham (non-spam) sender" - (dolist (from addresses) - (when (stringp from) - (let* ((parsed-address (gnus-extract-address-components from)) - (name (or (nth 0 parsed-address) "Ham Sender")) - (remove-function (if remove - 'bbdb-delete-record-internal - 'ignore)) - (net-address (nth 1 parsed-address)) - (record (and net-address - (spam-exists-in-BBDB-p net-address)))) - (when net-address - (gnus-message 6 "%s address %s %s BBDB" - (if remove "Deleting" "Adding") - from - (if remove "from" "to")) - (if record - (funcall remove-function record) - (bbdb-create-internal name nil net-address nil nil - "ham sender added by spam.el"))))))) - - (defun spam-BBDB-register-routine (articles &optional unregister) - (let (addresses) - (dolist (article articles) - (when (stringp (spam-fetch-field-from-fast article)) - (push (spam-fetch-field-from-fast article) addresses))) - ;; now do the register/unregister action - (spam-enter-ham-BBDB addresses unregister))) - - (defun spam-BBDB-unregister-routine (articles) - (spam-BBDB-register-routine articles t)) - - (defsubst spam-exists-in-BBDB-p (net) - (when (and (stringp net) (not (zerop (length net)))) - (bbdb-records) - (bbdb-gethash (downcase net)))) - - (defun spam-check-BBDB () - "Mail from people in the BBDB is classified as ham or non-spam" - (let ((net (message-fetch-field "from"))) - (when net - (setq net (nth 1 (gnus-extract-address-components net))) - (if (spam-exists-in-BBDB-p net) - t - (if spam-use-BBDB-exclusive - spam-split-group - nil))))))) +(require 'bbdb nil 'noerror) +(require 'bbdb-com nil 'noerror) + +(declare-function bbdb-records "bbdb" ()) +(declare-function bbdb-gethash "bbdb" (key &optional predicate)) +(declare-function bbdb-create-internal "bbdb-com" (&rest spec)) + +;; when the BBDB changes, we want to clear out our cache +(defun spam-clear-cache-BBDB (&rest _immaterial) + (spam-clear-cache 'spam-use-BBDB)) + +(when (featurep 'bbdb-com) + (add-hook 'bbdb-change-hook #'spam-clear-cache-BBDB)) + +(defun spam-enter-ham-BBDB (addresses &optional remove) + "Enter an address into the BBDB; implies ham (non-spam) sender" + (dolist (from addresses) + (when (stringp from) + (let* ((parsed-address (gnus-extract-address-components from)) + (name (or (nth 0 parsed-address) "Ham Sender")) + (remove-function (if remove + 'bbdb-delete-record-internal + 'ignore)) + (net-address (nth 1 parsed-address)) + (record (and net-address + (spam-exists-in-BBDB-p net-address)))) + (when net-address + (gnus-message 6 "%s address %s %s BBDB" + (if remove "Deleting" "Adding") + from + (if remove "from" "to")) + (if record + (funcall remove-function record) + (bbdb-create-internal name nil net-address nil nil + "ham sender added by spam.el"))))))) + +(defun spam-BBDB-register-routine (articles &optional unregister) + (let (addresses) + (dolist (article articles) + (when (stringp (spam-fetch-field-from-fast article)) + (push (spam-fetch-field-from-fast article) addresses))) + ;; now do the register/unregister action + (spam-enter-ham-BBDB addresses unregister))) + +(defun spam-BBDB-unregister-routine (articles) + (spam-BBDB-register-routine articles t)) + +(defun spam-exists-in-BBDB-p (net) + (when (and (stringp net) (not (zerop (length net)))) + (bbdb-records) + (bbdb-gethash (downcase net)))) + +(defun spam-check-BBDB () + "Mail from people in the BBDB is classified as ham or non-spam" + (let ((net (message-fetch-field "from"))) + (when net + (setq net (nth 1 (gnus-extract-address-components net))) + (if (spam-exists-in-BBDB-p net) + t + (if spam-use-BBDB-exclusive + spam-split-group + nil))))) ;;}}} ;;{{{ ifile -;;; check the ifile backend; return nil if the mail was NOT classified -;;; as spam +;; check the ifile backend; return nil if the mail was NOT classified +;; as spam (defun spam-get-ifile-database-parameter () @@ -2139,7 +2128,7 @@ See `spam-ifile-database'." (let ((temp-buffer-name (buffer-name)) (db-param (spam-get-ifile-database-parameter))) (with-current-buffer article-buffer-name - (apply 'call-process-region + (apply #'call-process-region (point-min) (point-max) spam-ifile-program nil temp-buffer-name nil "-c" (if db-param `(,db-param "-q") '("-q")))) @@ -2161,13 +2150,13 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (let ((category (or category gnus-newsgroup-name)) (add-or-delete-option (if unregister "-d" "-i")) (db (spam-get-ifile-database-parameter)) - parameters) + ) ;; parameters (with-temp-buffer (dolist (article articles) (let ((article-string (spam-get-article-as-string article))) (when (stringp article-string) (insert article-string)))) - (apply 'call-process-region + (apply #'call-process-region (point-min) (point-max) spam-ifile-program nil nil nil add-or-delete-option category @@ -2195,7 +2184,7 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." "Check the spam-stat backend for the classification of this message." (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override (spam-stat-buffer (buffer-name)) ; stat the current buffer - category return) + ) ;; category return (spam-stat-split-fancy))) (defun spam-stat-register-spam-routine (articles &optional unregister) @@ -2240,7 +2229,7 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (let ((kill-whole-line t)) (kill-line))) -;;; address can be a list, too +;; address can be a list, too (defun spam-enter-whitelist (address &optional remove) "Enter ADDRESS (list or single) into the whitelist. With a non-nil REMOVE, remove them." @@ -2249,7 +2238,7 @@ With a non-nil REMOVE, remove them." (setq spam-whitelist-cache nil) (spam-clear-cache 'spam-use-whitelist)) -;;; address can be a list, too +;; address can be a list, too (defun spam-enter-blacklist (address &optional remove) "Enter ADDRESS (list or single) into the blacklist. With a non-nil REMOVE, remove them." @@ -2310,8 +2299,8 @@ With a non-nil REMOVE, remove the ADDRESSES." (cl-return))) found))) -;;; returns t if the sender is in the whitelist, nil or -;;; spam-split-group otherwise +;; returns t if the sender is in the whitelist, nil or +;; spam-split-group otherwise (defun spam-check-whitelist () ;; FIXME! Should it detect when file timestamps change? (unless spam-whitelist-cache @@ -2346,7 +2335,7 @@ With a non-nil REMOVE, remove the ADDRESSES." (defun spam-from-listed-p (type) (let ((from (message-fetch-field "from")) - found) + ) ;; found (spam-filelist-check-cache type from))) (defun spam-filelist-register-routine (articles blacklist &optional unregister) @@ -2356,7 +2345,7 @@ With a non-nil REMOVE, remove the ADDRESSES." (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist)) (remove-function (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist)) - from addresses unregister-list article-unregister-list) + addresses unregister-list article-unregister-list) ;; from (dolist (article articles) (let ((from (spam-fetch-field-from-fast article)) (id (spam-fetch-field-message-id-fast article)) @@ -2406,11 +2395,11 @@ With a non-nil REMOVE, remove the ADDRESSES." ;;{{{ Spam-report glue (gmane and resend reporting) (defun spam-report-gmane-register-routine (articles) (when articles - (apply 'spam-report-gmane-spam articles))) + (apply #'spam-report-gmane-spam articles))) (defun spam-report-gmane-unregister-routine (articles) (when articles - (apply 'spam-report-gmane-ham articles))) + (apply #'spam-report-gmane-ham articles))) (defun spam-report-resend-register-ham-routine (articles) (spam-report-resend-register-routine articles t)) @@ -2474,7 +2463,7 @@ With a non-nil REMOVE, remove the ADDRESSES." (with-temp-buffer (let ((temp-buffer-name (buffer-name))) (with-current-buffer article-buffer-name - (apply 'call-process-region + (apply #'call-process-region (point-min) (point-max) spam-bogofilter-program nil temp-buffer-name nil @@ -2502,7 +2491,7 @@ With a non-nil REMOVE, remove the ADDRESSES." (with-temp-buffer (insert article-string) - (apply 'call-process-region + (apply #'call-process-region (point-min) (point-max) spam-bogofilter-program nil nil nil switch @@ -2532,7 +2521,7 @@ With a non-nil REMOVE, remove the ADDRESSES." (let ((temp-buffer-name (buffer-name))) (with-current-buffer article-buffer-name (let ((status - (apply 'call-process-region + (apply #'call-process-region (point-min) (point-max) spam-spamoracle-binary nil temp-buffer-name nil @@ -2559,7 +2548,7 @@ With a non-nil REMOVE, remove the ADDRESSES." "-spam" "-good")) (status - (apply 'call-process-region + (apply #'call-process-region (point-min) (point-max) spam-spamoracle-binary nil temp-buffer-name nil @@ -2573,13 +2562,13 @@ With a non-nil REMOVE, remove the ADDRESSES." (defun spam-spamoracle-learn-ham (articles &optional unregister) (spam-spamoracle-learn articles nil unregister)) -(defun spam-spamoracle-unlearn-ham (articles &optional unregister) +(defun spam-spamoracle-unlearn-ham (articles &optional _unregister) (spam-spamoracle-learn-ham articles t)) (defun spam-spamoracle-learn-spam (articles &optional unregister) (spam-spamoracle-learn articles t unregister)) -(defun spam-spamoracle-unlearn-spam (articles &optional unregister) +(defun spam-spamoracle-unlearn-spam (articles &optional _unregister) (spam-spamoracle-learn-spam articles t)) ;;}}} @@ -2607,7 +2596,7 @@ With a non-nil REMOVE, remove the ADDRESSES." (with-temp-buffer (let ((temp-buffer-name (buffer-name))) (with-current-buffer article-buffer-name - (apply 'call-process-region + (apply #'call-process-region (point-min) (point-max) spam-assassin-program nil temp-buffer-name nil spam-spamassassin-arguments)) ;; check the return now (we're back in the temp buffer) @@ -2648,7 +2637,7 @@ With a non-nil REMOVE, remove the ADDRESSES." (insert article-string) (insert "\n")))) ;; call sa-learn on all messages at the same time - (apply 'call-process-region + (apply #'call-process-region (point-min) (point-max) spam-sa-learn-program nil nil nil "--mbox" @@ -2703,7 +2692,7 @@ With a non-nil REMOVE, remove the ADDRESSES." (with-temp-buffer (let ((temp-buffer-name (buffer-name))) (with-current-buffer article-buffer-name - (apply 'call-process-region + (apply #'call-process-region (point-min) (point-max) spam-bsfilter-program nil temp-buffer-name nil @@ -2731,7 +2720,7 @@ With a non-nil REMOVE, remove the ADDRESSES." (when (stringp article-string) (with-temp-buffer (insert article-string) - (apply 'call-process-region + (apply #'call-process-region (point-min) (point-max) spam-bsfilter-program nil nil nil switch @@ -2788,7 +2777,7 @@ With a non-nil REMOVE, remove the ADDRESSES." (with-temp-buffer (let ((temp-buffer-name (buffer-name))) (with-current-buffer article-buffer-name - (apply 'call-process-region + (apply #'call-process-region (point-min) (point-max) spam-crm114-program nil temp-buffer-name nil @@ -2814,7 +2803,7 @@ With a non-nil REMOVE, remove the ADDRESSES." (with-temp-buffer (insert article-string) - (apply 'call-process-region + (apply #'call-process-region (point-min) (point-max) spam-crm114-program nil nil nil @@ -2859,13 +2848,13 @@ installed through `spam-necessary-extra-headers'." (push '((eq mark gnus-spam-mark) . spam) gnus-summary-highlight) ;; Add hooks for loading and saving the spam stats - (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) - (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) - (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load) - (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) - (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) - (add-hook 'gnus-get-new-news-hook 'spam-setup-widening) - (add-hook 'gnus-summary-prepared-hook 'spam-find-spam) + (add-hook 'gnus-save-newsrc-hook #'spam-maybe-spam-stat-save) + (add-hook 'gnus-get-top-new-news-hook #'spam-maybe-spam-stat-load) + (add-hook 'gnus-startup-hook #'spam-maybe-spam-stat-load) + (add-hook 'gnus-summary-prepare-exit-hook #'spam-summary-prepare-exit) + (add-hook 'gnus-summary-prepare-hook #'spam-summary-prepare) + (add-hook 'gnus-get-new-news-hook #'spam-setup-widening) + (add-hook 'gnus-summary-prepared-hook #'spam-find-spam) ;; Don't install things more than once. (setq spam-install-hooks nil))) @@ -2873,15 +2862,15 @@ installed through `spam-necessary-extra-headers'." "Uninstall the spam.el hooks." (interactive) (spam-teardown-widening) - (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save) - (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load) - (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load) - (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit) - (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare) - (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening) - (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam)) - -(add-hook 'spam-unload-hook 'spam-unload-hook) + (remove-hook 'gnus-save-newsrc-hook #'spam-maybe-spam-stat-save) + (remove-hook 'gnus-get-top-new-news-hook #'spam-maybe-spam-stat-load) + (remove-hook 'gnus-startup-hook #'spam-maybe-spam-stat-load) + (remove-hook 'gnus-summary-prepare-exit-hook #'spam-summary-prepare-exit) + (remove-hook 'gnus-summary-prepare-hook #'spam-summary-prepare) + (remove-hook 'gnus-get-new-news-hook #'spam-setup-widening) + (remove-hook 'gnus-summary-prepare-hook #'spam-find-spam)) + +(add-hook 'spam-unload-hook #'spam-unload-hook) ;;}}} diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 879653057d0..ddbd11f8fd3 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -533,7 +533,7 @@ suitable file is found, return nil." (format "\nMacro: %s" (help--docstring-quote (format-kbd-macro real-def)))) - (t "[Missing arglist. Please make a bug report.]"))) + (t "[Missing arglist.]"))) ;; Insert "`X", not "(\` X)", when documenting `X. (use1 (replace-regexp-in-string "\\`(\\\\=\\\\\\\\=` \\([^\n ]*\\))\\'" @@ -841,7 +841,7 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." (t ""))) (if (and aliased (not (fboundp real-def))) - (princ ",\nwhich is not defined. Please make a bug report.") + (princ ",\nwhich is not defined.") (with-current-buffer standard-output (save-excursion (save-match-data diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 7043f12c9a3..79710a18073 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -62,33 +62,29 @@ ["Move to Next Button" forward-button :help "Move to the Next Button in the help buffer"])) -(defvar help-xref-stack nil +(defvar-local help-xref-stack nil "A stack of ways by which to return to help buffers after following xrefs. Used by `help-follow' and `help-xref-go-back'. An element looks like (POSITION FUNCTION ARGS...). To use the element, do (apply FUNCTION ARGS) then goto the point.") (put 'help-xref-stack 'permanent-local t) -(make-variable-buffer-local 'help-xref-stack) -(defvar help-xref-forward-stack nil +(defvar-local help-xref-forward-stack nil "A stack used to navigate help forwards after using the back button. Used by `help-follow' and `help-xref-go-forward'. An element looks like (POSITION FUNCTION ARGS...). To use the element, do (apply FUNCTION ARGS) then goto the point.") (put 'help-xref-forward-stack 'permanent-local t) -(make-variable-buffer-local 'help-xref-forward-stack) -(defvar help-xref-stack-item nil +(defvar-local help-xref-stack-item nil "An item for `help-follow' in this buffer to push onto `help-xref-stack'. The format is (FUNCTION ARGS...).") (put 'help-xref-stack-item 'permanent-local t) -(make-variable-buffer-local 'help-xref-stack-item) -(defvar help-xref-stack-forward-item nil +(defvar-local help-xref-stack-forward-item nil "An item for `help-go-back' to push onto `help-xref-forward-stack'. The format is (FUNCTION ARGS...).") (put 'help-xref-stack-forward-item 'permanent-local t) -(make-variable-buffer-local 'help-xref-stack-forward-item) (setq-default help-xref-stack nil help-xref-stack-item nil) (setq-default help-xref-forward-stack nil help-xref-forward-stack-item nil) diff --git a/lisp/hexl.el b/lisp/hexl.el index 8d3cfe6de4f..85c3a53413d 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -209,12 +209,10 @@ as that will override any bit grouping options set here." (defvar hl-line-face) ;; Variables where the original values are stored to. -(defvar hexl-mode--old-var-vals ()) -(make-variable-buffer-local 'hexl-mode--old-var-vals) +(defvar-local hexl-mode--old-var-vals ()) -(defvar hexl-ascii-overlay nil +(defvar-local hexl-ascii-overlay nil "Overlay used to highlight ASCII element corresponding to current point.") -(make-variable-buffer-local 'hexl-ascii-overlay) (defvar hexl-font-lock-keywords '(("^\\([0-9a-f]+:\\)\\( \\).\\{39\\}\\( \\)\\(.+$\\)" diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index e214ab640de..0ad499b4dbf 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -381,13 +381,7 @@ Hi-lock: end is found. A mode is excluded if it's in the list (warn "%s" "Possible archaic use of (hi-lock-mode). Use (global-hi-lock-mode 1) in .emacs to enable hi-lock for all buffers, -use (hi-lock-mode 1) for individual buffers. For compatibility with Emacs -versions before 22 use the following in your init file: - - (if (functionp 'global-hi-lock-mode) - (global-hi-lock-mode 1) - (hi-lock-mode 1)) -"))) +use (hi-lock-mode 1) for individual buffers."))) (if hi-lock-mode ;; Turned on. (progn diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el index fb33cd92e35..89a1a9108c4 100644 --- a/lisp/hilit-chg.el +++ b/lisp/hilit-chg.el @@ -296,9 +296,7 @@ remove it from existing buffers." ;; These are for internal use. (defvar hilit-chg-list nil) -(defvar hilit-chg-string " ??") - -(make-variable-buffer-local 'hilit-chg-string) +(defvar-local hilit-chg-string " ??") diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 84c53b16acf..6dc1c7ebc2b 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -303,7 +303,7 @@ This variable takes precedence over filtering, and even in completion lists of the `ibuffer-jump-to-buffer' command." :type 'boolean) -(defcustom ibuffer-use-header-line (boundp 'header-line-format) +(defcustom ibuffer-use-header-line t "If non-nil, display a header line containing current filters." :type 'boolean) @@ -2129,16 +2129,13 @@ the value of point at the beginning of the line for that buffer." (and ibuffer-buf (not (eq ibuffer-buf buf)))))) -;; This function is a special case; it's not defined by -;; `define-ibuffer-sorter'. -(defun ibuffer-do-sort-by-recency () - "Sort the buffers by last view time." - (interactive) - (setq ibuffer-sorting-mode 'recency) - (when (eq ibuffer-last-sorting-mode 'recency) - (setq ibuffer-sorting-reversep (not ibuffer-sorting-reversep))) - (ibuffer-update nil t) - (setq ibuffer-last-sorting-mode 'recency)) +(define-ibuffer-sorter recency + "Sort the buffers by how recently they've been used." + (:description "recency") + (time-less-p (with-current-buffer (car b) + (or buffer-display-time 0)) + (with-current-buffer (car a) + (or buffer-display-time 0)))) (defun ibuffer-update-format () (when (null ibuffer-current-format) diff --git a/lisp/ido.el b/lisp/ido.el index 89b6a62f5a8..3ed0d952f36 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1037,10 +1037,9 @@ Should never be set permanently.") (defvar ido-completion-map nil "Currently active keymap for Ido commands.") -(defvar ido-eoinput 1 +(defvar-local ido-eoinput 1 "Point where minibuffer input ends and completion info begins. Copied from `icomplete-eoinput'.") -(make-variable-buffer-local 'ido-eoinput) (defvar ido-common-match-string nil "Stores the string that is common to all matching files.") diff --git a/lisp/imenu.el b/lisp/imenu.el index b5cd18a689d..7fc57c10526 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -36,14 +36,6 @@ ;; A mode-specific function is called to generate the index. It is ;; then presented to the user, who can choose from this index. -;; -;; The package comes with a set of example functions for how to -;; utilize this package. - -;; There are *examples* for index gathering functions/regular -;; expressions for C/C++ and Lisp/Emacs Lisp but it is easy to -;; customize for other modes. A function for jumping to the chosen -;; index position is also supplied. ;;; History: ;; Thanks go to @@ -81,25 +73,20 @@ Setting this to nil makes Imenu work a little faster but editing the buffer will make the generated index positions wrong. This might not yet be honored by all index-building functions." - :type 'boolean - :group 'imenu) - + :type 'boolean) (defcustom imenu-max-item-length 60 "If a number, truncate Imenu entries to that length." :type '(choice integer - (const :tag "Unlimited")) - :group 'imenu) + (const :tag "Unlimited"))) (defcustom imenu-auto-rescan nil "Non-nil means Imenu should always rescan the buffers." - :type 'boolean - :group 'imenu) + :type 'boolean) (defcustom imenu-auto-rescan-maxout 600000 "Imenu auto-rescan is disabled in buffers larger than this size (in bytes)." :type 'integer - :group 'imenu :version "26.2") (defcustom imenu-use-popup-menu 'on-mouse @@ -109,13 +96,11 @@ If t, always use a popup menu, If `on-mouse' use a popup menu when `imenu' was invoked with the mouse." :type '(choice (const :tag "On Mouse" on-mouse) (const :tag "Never" nil) - (other :tag "Always" t)) - :group 'imenu) + (other :tag "Always" t))) (defcustom imenu-eager-completion-buffer t "If non-nil, eagerly popup the completion buffer." :type 'boolean - :group 'imenu :version "22.1") (defcustom imenu-after-jump-hook nil @@ -123,8 +108,7 @@ If `on-mouse' use a popup menu when `imenu' was invoked with the mouse." Useful things to use here include `reposition-window', `recenter', and \(lambda () (recenter 0)) to show at top of screen." - :type 'hook - :group 'imenu) + :type 'hook) ;;;###autoload (defcustom imenu-sort-function nil @@ -143,39 +127,23 @@ element should come before the second. The arguments are cons cells; \(NAME . POSITION). Look at `imenu--sort-by-name' for an example." :type '(choice (const :tag "No sorting" nil) (const :tag "Sort by name" imenu--sort-by-name) - (function :tag "Another function")) - :group 'imenu) + (function :tag "Another function"))) (defcustom imenu-max-items 25 "Maximum number of elements in a mouse menu for Imenu." - :type 'integer - :group 'imenu) - -;; No longer used. KFS 2004-10-27 -;; (defcustom imenu-scanning-message "Scanning buffer for index (%3d%%)" -;; "Progress message during the index scanning of the buffer. -;; If non-nil, user gets a message during the scanning of the buffer. -;; -;; Relevant only if the mode-specific function that creates the buffer -;; index use `imenu-progress-message', and not useful if that is fast, in -;; which case you might as well set this to nil." -;; :type '(choice string -;; (const :tag "None" nil)) -;; :group 'imenu) + :type 'integer) (defcustom imenu-space-replacement "." "The replacement string for spaces in index names. Used when presenting the index in a completion buffer to make the names work as tokens." - :type '(choice string (const nil)) - :group 'imenu) + :type '(choice string (const nil))) (defcustom imenu-level-separator ":" "The separator between index names of different levels. Used for making mouse-menu titles and for flattening nested indexes with name concatenation." - :type 'string - :group 'imenu) + :type 'string) (defcustom imenu-generic-skip-comments-and-strings t "When non-nil, ignore text inside comments and strings. @@ -183,11 +151,10 @@ Only affects `imenu-default-create-index-function' (and any alternative implementation of `imenu-create-index-function' that uses `imenu--generic-function')." :type 'boolean - :group 'imenu :version "24.4") ;;;###autoload -(defvar imenu-generic-expression nil +(defvar-local imenu-generic-expression nil "List of definition matchers for creating an Imenu index. Each element of this list should have the form @@ -223,13 +190,10 @@ characters which normally have \"symbol\" syntax are considered to have \"word\" syntax during matching.") ;;;###autoload(put 'imenu-generic-expression 'risky-local-variable t) -;;;###autoload -(make-variable-buffer-local 'imenu-generic-expression) - ;;;; Hooks ;;;###autoload -(defvar imenu-create-index-function 'imenu-default-create-index-function +(defvar-local imenu-create-index-function 'imenu-default-create-index-function "The function to use for creating an index alist of the current buffer. It should be a function that takes no arguments and returns @@ -237,11 +201,9 @@ an index alist of the current buffer. The function is called within a `save-excursion'. See `imenu--index-alist' for the format of the buffer index alist.") -;;;###autoload -(make-variable-buffer-local 'imenu-create-index-function) ;;;###autoload -(defvar imenu-prev-index-position-function 'beginning-of-defun +(defvar-local imenu-prev-index-position-function 'beginning-of-defun "Function for finding the next index position. If `imenu-create-index-function' is set to @@ -251,21 +213,17 @@ file. The function should leave point at the place to be connected to the index and it should return nil when it doesn't find another index.") -;;;###autoload -(make-variable-buffer-local 'imenu-prev-index-position-function) ;;;###autoload -(defvar imenu-extract-index-name-function nil +(defvar-local imenu-extract-index-name-function nil "Function for extracting the index item name, given a position. This function is called after `imenu-prev-index-position-function' finds a position for an index item, with point at that position. It should return the name for that index item.") -;;;###autoload -(make-variable-buffer-local 'imenu-extract-index-name-function) ;;;###autoload -(defvar imenu-name-lookup-function nil +(defvar-local imenu-name-lookup-function nil "Function to compare string with index item. This function will be called with two strings, and should return @@ -275,15 +233,11 @@ If nil, comparison is done with `string='. Set this to some other function for more advanced comparisons, such as \"begins with\" or \"name matches and number of arguments match\".") -;;;###autoload -(make-variable-buffer-local 'imenu-name-lookup-function) ;;;###autoload -(defvar imenu-default-goto-function 'imenu-default-goto-function +(defvar-local imenu-default-goto-function 'imenu-default-goto-function "The default function called when selecting an Imenu item. The function in this variable is called when selecting a normal index-item.") -;;;###autoload -(make-variable-buffer-local 'imenu-default-goto-function) (defun imenu--subalist-p (item) @@ -293,26 +247,11 @@ The function in this variable is called when selecting a normal index-item.") (not (functionp (cadr item))))) (defmacro imenu-progress-message (_prevpos &optional _relpos _reverse) - "Macro to display a progress message. -RELPOS is the relative position to display. -If RELPOS is nil, then the relative position in the buffer -is calculated. -PREVPOS is the variable in which we store the last position displayed." - + "This macro is obsolete and does nothing." + (declare (obsolete nil "28.1")) ;; Made obsolete/empty, as computers are now faster than the eye, and ;; it had problems updating the messages correctly, and could shadow ;; more important messages/prompts in the minibuffer. KFS 2004-10-27. - -;; `(and -;; imenu-scanning-message -;; (let ((pos ,(if relpos -;; relpos -;; `(imenu--relative-position ,reverse)))) -;; (if ,(if relpos t -;; `(> pos (+ 5 ,prevpos))) -;; (progn -;; (message imenu-scanning-message pos) -;; (setq ,prevpos pos))))) ) @@ -554,7 +493,8 @@ Non-nil arguments are in recursive calls." (setq alist nil res elt)))) res)) -(defvar imenu-syntax-alist nil +;;;###autoload +(defvar-local imenu-syntax-alist nil "Alist of syntax table modifiers to use while in `imenu--generic-function'. The car of the assocs may be either a character or a string and the @@ -564,8 +504,6 @@ a string, all the characters in the string get the specified syntax. This is typically used to give word syntax to characters which normally have symbol syntax to simplify `imenu-expression' and speed-up matching.") -;;;###autoload -(make-variable-buffer-local 'imenu-syntax-alist) (defun imenu-default-create-index-function () "Default function to create an index alist of the current buffer. @@ -607,14 +545,13 @@ The alternate method, which is the one most often used, is to call ;;; Generic index gathering function. ;;; -(defvar imenu-case-fold-search t +;;;###autoload +(defvar-local imenu-case-fold-search t "Defines whether `imenu--generic-function' should fold case when matching. This variable should be set (only) by initialization code for modes which use `imenu--generic-function'. If it is not set, but `font-lock-defaults' is set, then font-lock's setting is used.") -;;;###autoload -(make-variable-buffer-local 'imenu-case-fold-search) ;; This function can be called with quitting disabled, ;; so it needs to be careful never to loop! diff --git a/lisp/indent.el b/lisp/indent.el index 5c5270b07c4..285b8e2038f 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -83,22 +83,23 @@ This variable has no effect unless `tab-always-indent' is `complete'." (const :tag "Unless at a word, parenthesis, or punctuation." 'word-or-paren-or-punct)) :version "27.1") +(defvar indent-line-ignored-functions '(indent-relative + indent-relative-maybe + indent-relative-first-indent-point) + "Values that are ignored by `indent-according-to-mode'.") (defun indent-according-to-mode () "Indent line in proper way for current major mode. Normally, this is done by calling the function specified by the variable `indent-line-function'. However, if the value of that -variable is `indent-relative' or `indent-relative-first-indent-point', +variable is present in the `indent-line-ignored-functions' variable, handle it specially (since those functions are used for tabbing); in that case, indent by aligning to the previous non-blank line." (interactive) (save-restriction (widen) (syntax-propertize (line-end-position)) - (if (memq indent-line-function - '(indent-relative - indent-relative-maybe - indent-relative-first-indent-point)) + (if (memq indent-line-function indent-line-ignored-functions) ;; These functions are used for tabbing, but can't be used for ;; indenting. Replace with something ad-hoc. (let ((column (save-excursion @@ -249,7 +250,8 @@ It is activated by calling `indent-rigidly' interactively.") If called interactively with no prefix argument, activate a transient mode in which the indentation can be adjusted interactively by typing \\<indent-rigidly-map>\\[indent-rigidly-left], \\[indent-rigidly-right], \\[indent-rigidly-left-to-tab-stop], or \\[indent-rigidly-right-to-tab-stop]. -Typing any other key exits this mode. If `transient-mark-mode' is enabled, +Typing any other key exits this mode, and this key is then +acted upon as normally. If `transient-mark-mode' is enabled, exiting also deactivates the mark. If called from a program, or interactively with prefix ARG, @@ -523,7 +525,7 @@ From the beginning of the line, moves past the left-margin indentation, the fill-prefix, and any indentation used for centering or right-justifying the line, but does not move past any whitespace that was explicitly inserted \(such as a tab used to indent the first line of a paragraph)." - (interactive "p") + (interactive "^p") (beginning-of-line n) (skip-chars-forward " \t") ;; Skip over fill-prefix. diff --git a/lisp/info.el b/lisp/info.el index dec93928b38..7f169f4b556 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1260,9 +1260,9 @@ is non-nil)." (if Info-history (let ((hist (car Info-history))) (setq Info-history (cdr Info-history)) - (Info-find-node (nth 0 hist) (nth 1 hist) t) + (Info-find-node (nth 0 hist) (nth 1 hist) t t) (goto-char (nth 2 hist))) - (Info-find-node Info-current-file "Top" t))))) + (Info-find-node Info-current-file "Top" t t))))) ;; Cache the contents of the (virtual) dir file, once we have merged ;; it for the first time, so we can save time subsequently. diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 9bce419b489..c643f66cbb0 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -265,7 +265,7 @@ with L, LRE, or LRO Unicode bidi character type.") (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2121 #x227E) (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2621 #x277E) (map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2830 #x287E) -(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2930 #x297E) +(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2930 #x2975) (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2330 #x2339) (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2341 #x235A) (map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2361 #x237A) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 8202c3ee27a..e4bdf50f526 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1315,15 +1315,13 @@ Each function is called with one arg, LEIM directory name.") (dolist (function update-leim-list-functions) (apply function dirs))) -(defvar current-input-method nil +(defvar-local current-input-method nil "The current input method for multilingual text. If nil, that means no input method is activated now.") -(make-variable-buffer-local 'current-input-method) (put 'current-input-method 'permanent-local t) -(defvar current-input-method-title nil +(defvar-local current-input-method-title nil "Title string of the current input method shown in mode line.") -(make-variable-buffer-local 'current-input-method-title) (put 'current-input-method-title 'permanent-local t) (define-widget 'mule-input-method-string 'string @@ -1355,45 +1353,40 @@ This is the input method activated by the command :set-after '(current-language-environment) :version "28.1") -(defvar current-transient-input-method nil +(defvar-local current-transient-input-method nil "Current input method temporarily enabled by `activate-transient-input-method'. If nil, that means no transient input method is active now.") -(make-variable-buffer-local 'current-transient-input-method) (put 'current-transient-input-method 'permanent-local t) -(defvar previous-transient-input-method nil +(defvar-local previous-transient-input-method nil "The input method that was active before enabling the transient input method. If nil, that means no previous input method was active.") -(make-variable-buffer-local 'previous-transient-input-method) (put 'previous-transient-input-method 'permanent-local t) (put 'input-method-function 'permanent-local t) -(defvar input-method-history nil +(defvar-local input-method-history nil "History list of input methods read from the minibuffer. Maximum length of the history list is determined by the value of `history-length', which see.") -(make-variable-buffer-local 'input-method-history) (put 'input-method-history 'permanent-local t) (define-obsolete-variable-alias 'inactivate-current-input-method-function 'deactivate-current-input-method-function "24.3") -(defvar deactivate-current-input-method-function nil +(defvar-local deactivate-current-input-method-function nil "Function to call for deactivating the current input method. Every input method should set this to an appropriate value when activated. This function is called with no argument. This function should never change the value of `current-input-method'. It is set to nil by the function `deactivate-input-method'.") -(make-variable-buffer-local 'deactivate-current-input-method-function) (put 'deactivate-current-input-method-function 'permanent-local t) -(defvar describe-current-input-method-function nil +(defvar-local describe-current-input-method-function nil "Function to call for describing the current input method. This function is called with no argument.") -(make-variable-buffer-local 'describe-current-input-method-function) (put 'describe-current-input-method-function 'permanent-local t) (defvar input-method-alist nil @@ -3084,12 +3077,47 @@ on encoding." (puthash "BELL (BEL)" ?\a names) (setq ucs-names names)))) +(defun mule--ucs-names-sort-by-code (names) + (let ((codes-and-names + (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names))) + (mapcar #'cdr (sort codes-and-names #'car-less-than-car)))) + (defun mule--ucs-names-affixation (names) (mapcar (lambda (name) (let ((char (gethash name ucs-names))) - (list name (concat (if char (format "%c" char) " ") "\t") ""))) + (list name (concat (if char (list char) " ") "\t") ""))) names)) +(defun mule--ucs-names-group (names) + (let* ((codes-and-names + (mapcar (lambda (name) (cons (gethash name ucs-names) name)) names)) + (grouped + (seq-group-by + (lambda (code-name) + (let ((script (aref char-script-table (car code-name)))) + (if script (symbol-name script) "ungrouped"))) + codes-and-names)) + names-with-header header) + (dolist (group (sort grouped (lambda (a b) (string< (car a) (car b))))) + (setq header t) + (dolist (code-name (cdr group)) + (push (list + (cdr code-name) + (concat + (if header + (progn + (setq header nil) + (concat "\n" (propertize + (format "* %s\n" (car group)) + 'face 'header-line))) + "") + ;; prefix + (if (car code-name) (format "%c" (car code-name)) " ") "\t") + ;; suffix + "") + names-with-header))) + (nreverse names-with-header))) + (defun char-from-name (string &optional ignore-case) "Return a character as a number from its Unicode name STRING. If optional IGNORE-CASE is non-nil, ignore case in STRING. @@ -3111,6 +3139,23 @@ Return nil if STRING does not name a character." ignore-case)) code))))))) +(defcustom read-char-by-name-sort nil + "How to sort characters for `read-char-by-name' completion. +Defines the sorting order either by character names or their codepoints." + :type '(choice + (const :tag "Sort by character names" nil) + (const :tag "Sort by character codepoints" code)) + :group 'mule + :version "28.1") + +(defcustom read-char-by-name-group nil + "How to group characters for `read-char-by-name' completion. +When t, split characters to sections of Unicode blocks +sorted alphabetically." + :type 'boolean + :group 'mule + :version "28.1") + (defun read-char-by-name (prompt) "Read a character by its Unicode name or hex number string. Display PROMPT and read a string that represents a character by its @@ -3124,6 +3169,9 @@ preceded by an asterisk `*' and use completion, it will show all the characters whose names include that substring, not necessarily at the beginning of the name. +The options `read-char-by-name-sort' and `read-char-by-name-group' +define the sorting order of completion characters and how to group them. + Accept a name like \"CIRCULATION FUNCTION\", a hexadecimal number like \"2A10\", or a number in hash notation (e.g., \"#x2a10\" for hex, \"10r10768\" for decimal, or \"#o25020\" for @@ -3137,8 +3185,14 @@ as names, not numbers." prompt (lambda (string pred action) (if (eq action 'metadata) - '(metadata - (affixation-function . mule--ucs-names-affixation) + `(metadata + (display-sort-function + . ,(when (eq read-char-by-name-sort 'code) + #'mule--ucs-names-sort-by-code)) + (affixation-function + . ,(if read-char-by-name-group + #'mule--ucs-names-group + #'mule--ucs-names-affixation)) (category . unicode-name)) (complete-with-action action (ucs-names) string pred))))) (char diff --git a/lisp/international/mule.el b/lisp/international/mule.el index dd4448d5604..91d18c34295 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -1192,12 +1192,11 @@ FORM is a form to evaluate to define the coding-system." ;; `last-coding-system-used'. (It used to set it unconditionally, but ;; that seems unnecessary; see Bug#4533.) -(defvar buffer-file-coding-system-explicit nil +(defvar-local buffer-file-coding-system-explicit nil "The file coding system explicitly specified for the current buffer. The value is a cons of coding systems for reading (decoding) and writing (encoding). Internal use only.") -(make-variable-buffer-local 'buffer-file-coding-system-explicit) (put 'buffer-file-coding-system-explicit 'permanent-local t) (defun read-buffer-file-coding-system () diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 0901115cffe..67ea00665fc 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -61,15 +61,14 @@ ;; Buffer local variables -(defvar quail-current-package nil +(defvar-local quail-current-package nil "The current Quail package, which depends on the current input method. See the documentation of `quail-package-alist' for the format.") -(make-variable-buffer-local 'quail-current-package) (put 'quail-current-package 'permanent-local t) ;; Quail uses the following variables to assist users. ;; A string containing available key sequences or translation list. -(defvar quail-guidance-str nil) +(defvar-local quail-guidance-str nil) ;; A buffer to show completion list of the current key sequence. (defvar quail-completion-buf nil) ;; We may display the guidance string in a buffer on a one-line frame. @@ -78,41 +77,34 @@ See the documentation of `quail-package-alist' for the format.") ;; Each buffer in which Quail is activated should use different ;; guidance string. -(make-variable-buffer-local 'quail-guidance-str) (put 'quail-guidance-str 'permanent-local t) -(defvar quail-overlay nil +(defvar-local quail-overlay nil "Overlay which covers the current translation region of Quail.") -(make-variable-buffer-local 'quail-overlay) -(defvar quail-conv-overlay nil +(defvar-local quail-conv-overlay nil "Overlay which covers the text to be converted in Quail mode.") -(make-variable-buffer-local 'quail-conv-overlay) -(defvar quail-current-key nil +(defvar-local quail-current-key nil "Current key for translation in Quail mode.") -(make-variable-buffer-local 'quail-current-key) -(defvar quail-current-str nil +(defvar-local quail-current-str nil "Currently selected translation of the current key.") -(make-variable-buffer-local 'quail-current-str) -(defvar quail-current-translations nil +(defvar-local quail-current-translations nil "Cons of indices and vector of possible translations of the current key. Indices is a list of (CURRENT START END BLOCK BLOCKS), where CURRENT is an index of the current translation, START and END are indices of the start and end of the current block, BLOCK is the current block index, BLOCKS is a number of blocks of translation.") -(make-variable-buffer-local 'quail-current-translations) -(defvar quail-current-data nil +(defvar-local quail-current-data nil "Any Lisp object holding information of current translation status. When a key sequence is mapped to TRANS and TRANS is a cons of actual translation and some Lisp object to be referred for translating the longer key sequence, this variable is set to that Lisp object.") -(make-variable-buffer-local 'quail-current-data) ;; Quail package handlers. @@ -2027,10 +2019,15 @@ minibuffer and the selected frame has no other windows)." (bury-buffer quail-completion-buf) ;; Then, show the guidance. - (when (and (quail-require-guidance-buf) - (not input-method-use-echo-area) - (null unread-command-events) - (null unread-post-input-method-events)) + (when (and + ;; Don't try to display guidance on an expired minibuffer. This + ;; would go into an infinite wait rather than executing the user's + ;; command. Bug #45792. + (not (eq major-mode 'minibuffer-inactive-mode)) + (quail-require-guidance-buf) + (not input-method-use-echo-area) + (null unread-command-events) + (null unread-post-input-method-events)) (if (minibufferp) (if (eq (minibuffer-window) (frame-root-window)) ;; Use another frame. It is sure that we are using some diff --git a/lisp/international/robin.el b/lisp/international/robin.el index 55390df315f..e4a11801c38 100644 --- a/lisp/international/robin.el +++ b/lisp/international/robin.el @@ -371,14 +371,12 @@ Internal use only." ;;; Interactive use -(defvar robin-mode nil +(defvar-local robin-mode nil "If non-nil, `robin-input-method' is active.") -(make-variable-buffer-local 'robin-mode) -(defvar robin-current-package-name nil +(defvar-local robin-current-package-name nil "String representing the name of the current robin package. A nil value means no package is selected.") -(make-variable-buffer-local 'robin-current-package-name) ;;;###autoload (defun robin-use-package (name) diff --git a/lisp/isearch.el b/lisp/isearch.el index a1e3fe2c3f0..b58ca8a6f70 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -320,7 +320,8 @@ matching the current search string is highlighted lazily When multiple windows display the current buffer, the highlighting is displayed only on the selected window, unless this variable is set to the symbol `all-windows'." - :type '(choice boolean + :type '(choice (const :tag "Off" nil) + (const :tag "On, and applied to current window" t) (const :tag "On, and applied to all windows" all-windows)) :group 'lazy-highlight :group 'isearch) @@ -352,10 +353,20 @@ If this is nil, extra highlighting can be \"manually\" removed with :group 'lazy-highlight) (defcustom lazy-highlight-initial-delay 0.25 - "Seconds to wait before beginning to lazily highlight all matches." + "Seconds to wait before beginning to lazily highlight all matches. +This setting only has effect when the search string is less than +`lazy-highlight-no-delay-length' characters long." :type 'number :group 'lazy-highlight) +(defcustom lazy-highlight-no-delay-length 3 + "For search strings at least this long, lazy highlight starts immediately. +For shorter search strings, `lazy-highlight-initial-delay' +applies." + :type 'integer + :group 'lazy-highlight + :version "28.1") + (defcustom lazy-highlight-interval 0 ; 0.0625 "Seconds between lazily highlighting successive matches." :type 'number @@ -3356,7 +3367,7 @@ isearch-message-suffix prompt. Otherwise, for isearch-message-prefix." (not isearch-error) (not isearch-suspended)) (format format-string - (if isearch-forward + (if isearch-lazy-highlight-forward isearch-lazy-count-current (if (eq isearch-lazy-count-current 0) 0 @@ -3916,7 +3927,8 @@ by other Emacs features." (clrhash isearch-lazy-count-hash) (setq isearch-lazy-count-current nil isearch-lazy-count-total nil) - (isearch-message))) + ;; Delay updating the message if possible, to avoid flicker + (when (string-equal isearch-string "") (isearch-message)))) (setq isearch-lazy-highlight-window-start-changed nil) (setq isearch-lazy-highlight-window-end-changed nil) (setq isearch-lazy-highlight-error isearch-error) @@ -3961,7 +3973,11 @@ by other Emacs features." (point-min)))) (unless (equal isearch-string "") (setq isearch-lazy-highlight-timer - (run-with-idle-timer lazy-highlight-initial-delay nil + (run-with-idle-timer (if (>= (length isearch-string) + lazy-highlight-no-delay-length) + 0 + lazy-highlight-initial-delay) + nil 'isearch-lazy-highlight-start)))) ;; Update the current match number only in isearch-mode and ;; unless isearch-mode is used specially with isearch-message-function diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index 877f2eb825a..8aebcd0ec4d 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -101,11 +101,10 @@ NOTE: Not used in MS-DOS and Windows systems." (defvar jka-compr-use-shell (not (memq system-type '(ms-dos windows-nt)))) -(defvar jka-compr-really-do-compress nil +(defvar-local jka-compr-really-do-compress nil "Non-nil in a buffer whose visited file was uncompressed on visiting it. This means compress the data on writing the file, even if the data appears to be compressed already.") -(make-variable-buffer-local 'jka-compr-really-do-compress) (put 'jka-compr-really-do-compress 'permanent-local t) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 7f5aa8295fe..f1fb6c1ddaf 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -10,18 +10,20 @@ ;; This is a GNU ELPA :core package. Avoid functionality that is not ;; compatible with the version of Emacs recorded above. -;; This program is free software; you can redistribute it and/or modify +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el index 9b5fdf24d2b..fa31cd5f9f8 100644 --- a/lisp/language/ethio-util.el +++ b/lisp/language/ethio-util.el @@ -972,8 +972,7 @@ Otherwise, [0-9A-F]." ;; Ethiopic word separator vs. ASCII space ;; -(defvar ethio-prefer-ascii-space t) -(make-variable-buffer-local 'ethio-prefer-ascii-space) +(defvar-local ethio-prefer-ascii-space t) (defun ethio-toggle-space nil "Toggle ASCII space and Ethiopic separator for keyboard input." diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el index c99ff3c3f2d..b999eff662f 100644 --- a/lisp/language/korea-util.el +++ b/lisp/language/korea-util.el @@ -32,13 +32,15 @@ (purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" "")) - "The kind of Korean keyboard for Korean input method. -\"\" for 2, \"3\" for 3.") + "The kind of Korean keyboard for Korean (Hangul) input method. +\"\" for 2, \"3\" for 3, and \"3f\" for 3f.") ;; functions useful for Korean text input (defun toggle-korean-input-method () - "Turn on or off a Korean text input method for the current buffer." + "Turn on or off a Korean text input method for the current buffer. +The keyboard layout variation used is determined by +`default-korean-keyboard'." (interactive) (if current-input-method (deactivate-input-method) @@ -46,7 +48,9 @@ (concat "korean-hangul" default-korean-keyboard)))) (defun quail-hangul-switch-symbol-ksc (&rest _ignore) - "Switch to/from Korean symbol package." + "Switch to/from Korean symbol package. +The keyboard layout variation used is determined by +`default-korean-keyboard'." (interactive "i") (and current-input-method (if (string-equal current-input-method "korean-symbol") @@ -55,7 +59,9 @@ (activate-input-method "korean-symbol")))) (defun quail-hangul-switch-hanja (&rest _ignore) - "Switch to/from Korean hanja package." + "Switch to/from Korean hanja package. +The keyboard layout variation used is determined by +`default-korean-keyboard'." (interactive "i") (and current-input-method (if (string-match "korean-hanja" current-input-method) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index c6fa497c213..9924d62774e 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -8415,9 +8415,6 @@ strings when pressed twice. See `double-map' for details. (autoload 'dunnet "dunnet" "\ Switch to *dungeon* buffer and start game." t nil) -(autoload 'dun-batch "dunnet" "\ -Start `dunnet' in batch mode." nil nil) - (register-definition-prefixes "dunnet" '("dun" "obj-special")) ;;;*** @@ -12945,7 +12942,7 @@ lines. ;;;### (autoloads nil "flymake" "progmodes/flymake.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/flymake.el -(push (purecopy '(flymake 1 0 9)) package--builtin-versions) +(push (purecopy '(flymake 1 1 1)) package--builtin-versions) (autoload 'flymake-log "flymake" "\ Log, at level LEVEL, the message MSG formatted with ARGS. @@ -15889,7 +15886,7 @@ Produce a texinfo buffer with sorted doc-strings from the DOC file. \(fn FILE)" t nil) -(register-definition-prefixes "help-fns" '("describe-" "help-")) +(register-definition-prefixes "help-fns" '("describe-" "help-" "keymap-name-history")) ;;;*** @@ -16672,9 +16669,7 @@ non-selected window. Hl-Line mode uses the function `hl-line-highlight' on `post-command-hook' in this case. When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the -line about point in the selected window only. In this case, it -uses the function `hl-line-maybe-unhighlight' in -addition to `hl-line-highlight' on `post-command-hook'. +line about point in the selected window only. \(fn &optional ARG)" t nil) @@ -16706,8 +16701,8 @@ If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode highlights the line about the current buffer's point in all live windows. -Global-Hl-Line mode uses the functions `global-hl-line-highlight' -and `global-hl-line-maybe-unhighlight' on `post-command-hook'. +Global-Hl-Line mode uses the function `global-hl-line-highlight' +on `post-command-hook'. \(fn &optional ARG)" t nil) @@ -18387,7 +18382,9 @@ the environment variable INFOPATH is set. Although this is a customizable variable, that is mainly for technical reasons. Normally, you should either set INFOPATH or customize -`Info-additional-directory-list', rather than changing this variable." :initialize 'custom-initialize-delay :type '(repeat directory)) +`Info-additional-directory-list', rather than changing this variable." :initialize #'custom-initialize-delay :type '(repeat directory)) + +(custom-autoload 'Info-default-directory-list "info" t) (autoload 'info-other-window "info" "\ Like `info' but show the Info buffer in another window. @@ -19539,7 +19536,7 @@ Create lambda form for macro bound to symbol or key. \(fn MAC &optional COUNTER FORMAT)" nil nil) -(register-definition-prefixes "kmacro" '("kmacro-")) +(register-definition-prefixes "kmacro" '("kdb-macro-redisplay" "kmacro-")) ;;;*** @@ -19548,8 +19545,8 @@ Create lambda form for macro bound to symbol or key. ;;; Generated autoloads from language/korea-util.el (defvar default-korean-keyboard (purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" "")) "\ -The kind of Korean keyboard for Korean input method. -\"\" for 2, \"3\" for 3.") +The kind of Korean keyboard for Korean (Hangul) input method. +\"\" for 2, \"3\" for 3, and \"3f\" for 3f.") (autoload 'setup-korean-environment-internal "korea-util" nil nil nil) @@ -21586,8 +21583,10 @@ Major mode for the mixal asm language. ;;;### (autoloads nil "mm-encode" "gnus/mm-encode.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mm-encode.el -(autoload 'mm-default-file-encoding "mm-encode" "\ -Return a default encoding for FILE. +(define-obsolete-function-alias 'mm-default-file-encoding #'mm-default-file-type "future") + +(autoload 'mm-default-file-type "mm-encode" "\ +Return a default content type for FILE. \(fn FILE)" nil nil) @@ -22746,7 +22745,7 @@ Generate NOV databases in all nnml directories. ;;;### (autoloads nil "nnoo" "gnus/nnoo.el" (0 0 0 0)) ;;; Generated autoloads from gnus/nnoo.el -(register-definition-prefixes "nnoo" '("deffoo" "defvoo" "nnoo-")) +(register-definition-prefixes "nnoo" '("deffoo" "defvoo" "nnoo-" "noo--defalias")) ;;;*** @@ -24246,10 +24245,27 @@ with \"-q\"). Even if the value is nil, you can type \\[package-initialize] to make installed packages available at any time, or you can -call (package-initialize) in your init-file.") +call (package-activate-all) in your init-file.") (custom-autoload 'package-enable-at-startup "package" t) +(defcustom package-user-dir (locate-user-emacs-file "elpa") "\ +Directory containing the user's Emacs Lisp packages. +The directory name should be absolute. +Apart from this directory, Emacs also looks for system-wide +packages in `package-directory-list'." :type 'directory :initialize #'custom-initialize-delay :risky t :version "24.1") + +(custom-autoload 'package-user-dir "package" t) + +(defcustom package-directory-list (let (result) (dolist (f load-path) (and (stringp f) (equal (file-name-nondirectory f) "site-lisp") (push (expand-file-name "elpa" f) result))) (nreverse result)) "\ +List of additional directories containing Emacs Lisp packages. +Each directory name should be absolute. + +These directories contain packages intended for system-wide; in +contrast, `package-user-dir' contains packages for personal use." :type '(repeat directory) :initialize #'custom-initialize-delay :risky t :version "24.1") + +(custom-autoload 'package-directory-list "package" t) + (defvar package--activated nil "\ Non-nil if `package-activate-all' has been run.") @@ -24271,9 +24287,9 @@ that code in the early init-file. \(fn &optional NO-ACTIVATE)" t nil) -(autoload 'package-activate-all "package" "\ +(defun package-activate-all nil "\ Activate all installed packages. -The variable `package-load-list' controls which packages to load." nil nil) +The variable `package-load-list' controls which packages to load." (setq package--activated t) (let* ((elc (concat package-quickstart-file "c")) (qs (if (file-readable-p elc) elc (if (file-readable-p package-quickstart-file) package-quickstart-file)))) (if qs (let ((load-source-file-function nil)) (unless (boundp 'package-activated-list) (setq package-activated-list nil)) (load qs nil 'nomessage)) (require 'package) (package--activate-all)))) (autoload 'package-import-keyring "package" "\ Import keys from FILE. @@ -24370,6 +24386,11 @@ The return value is a string (or nil in case we can't find it)." nil nil) (function-put 'package-get-version 'pure 't) +(defcustom package-quickstart-file (locate-user-emacs-file "package-quickstart.el") "\ +Location of the file used to speed up activation of packages at startup." :type 'file :initialize #'custom-initialize-delay :version "27.1") + +(custom-autoload 'package-quickstart-file "package" t) + (register-definition-prefixes "package" '("bad-signature" "define-package" "describe-package-1" "package-")) ;;;*** @@ -24561,6 +24582,7 @@ PATTERN matches. PATTERN can take one of the forms: If a SYMBOL is used twice in the same pattern the second occurrence becomes an `eq'uality test. (pred FUN) matches if FUN called on EXPVAL returns non-nil. + (pred (not FUN)) matches if FUN called on EXPVAL returns nil. (app FUN PAT) matches if FUN called on EXPVAL matches PAT. (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. (let PAT EXPR) matches if EXPR matches PAT. @@ -25851,7 +25873,7 @@ Open profile FILENAME. ;;;### (autoloads nil "project" "progmodes/project.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/project.el -(push (purecopy '(project 0 5 3)) package--builtin-versions) +(push (purecopy '(project 0 5 4)) package--builtin-versions) (autoload 'project-current "project" "\ Return the project instance in DIRECTORY, defaulting to `default-directory'. @@ -25956,9 +25978,13 @@ if one already exists." t nil) (autoload 'project-async-shell-command "project" "\ Run `async-shell-command' in the current project's root directory." t nil) +(function-put 'project-async-shell-command 'interactive-only 'async-shell-command) + (autoload 'project-shell-command "project" "\ Run `shell-command' in the current project's root directory." t nil) +(function-put 'project-shell-command 'interactive-only 'shell-command) + (autoload 'project-search "project" "\ Search for REGEXP in all the files of the project. Stops when a match is found. @@ -25976,10 +26002,9 @@ loop using the command \\[fileloop-continue]. \(fn FROM TO)" t nil) (autoload 'project-compile "project" "\ -Run `compile' in the project root. -Arguments the same as in `compile'. +Run `compile' in the project root." t nil) -\(fn COMMAND &optional COMINT)" t nil) +(function-put 'project-compile 'interactive-only 'compile) (autoload 'project-switch-to-buffer "project" "\ Display buffer BUFFER-OR-NAME in the selected window. @@ -26967,6 +26992,13 @@ When Recentf mode is enabled, a \"Open Recent\" submenu is displayed in the \"File\" menu, containing a list of files that were operated on recently, in the most-recently-used order. +By default, only operations like opening a file, writing a buffer +to a file, and killing a buffer is counted as \"operating\" on +the file. If instead you want to prioritize files that appear in +buffers you switch to a lot, you can say something like the following: + + (add-hook 'buffer-list-update-hook 'recentf-track-opened-file) + \(fn &optional ARG)" t nil) (register-definition-prefixes "recentf" '("recentf-")) @@ -27347,7 +27379,7 @@ Remember the contents of the current clipboard. Most useful for remembering things from other applications." t nil) (autoload 'remember-diary-extract-entries "remember" "\ -Extract diary entries from the region." nil nil) +Extract diary entries from the region based on `remember-diary-regexp'." nil nil) (autoload 'remember-notes "remember" "\ Return the notes buffer, creating it if needed, and maybe switch to it. @@ -27637,14 +27669,11 @@ Name of user's primary mail file.") (custom-autoload 'rmail-file-name "rmail" t) -(put 'rmail-spool-directory 'standard-value '((cond ((file-exists-p "/var/mail") "/var/mail/") ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq system-type '(hpux usg-unix-v)) "/usr/mail/") (t "/usr/spool/mail/")))) - -(defvar rmail-spool-directory (purecopy (cond ((file-exists-p "/var/mail") "/var/mail/") ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq system-type '(hpux usg-unix-v)) "/usr/mail/") (t "/usr/spool/mail/"))) "\ +(defcustom rmail-spool-directory (purecopy (cond ((file-exists-p "/var/mail") "/var/mail/") ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq system-type '(hpux usg-unix-v)) "/usr/mail/") (t "/usr/spool/mail/"))) "\ Name of directory used by system mailer for delivering new mail. -Its name should end with a slash.") +Its name should end with a slash." :initialize #'custom-initialize-delay :type 'directory :group 'rmail) (custom-autoload 'rmail-spool-directory "rmail" t) -(custom-initialize-delay 'rmail-spool-directory nil) (autoload 'rmail-movemail-variant-p "rmail" "\ Return t if the current movemail variant is any of VARIANTS. @@ -29076,7 +29105,9 @@ variable `feedmail-deduce-envelope-from'.") (defvar mail-self-blind nil "\ Non-nil means insert Bcc to self in messages to be sent. This is done when the message is initialized, -so you can remove or alter the Bcc field to override the default.") +so you can remove or alter the Bcc field to override the default. +If you are using `message-mode' to compose messages, customize the +variable `message-default-mail-headers' instead.") (custom-autoload 'mail-self-blind "sendmail" t) @@ -29104,14 +29135,18 @@ Line used to separate headers from text in messages being composed.") (defvar mail-archive-file-name nil "\ Name of file to write all outgoing messages in, or nil for none. This is normally an mbox file, but for backwards compatibility may also -be a Babyl file.") +be a Babyl file. +If you are using `message-mode' to compose messages, customize the +variable `message-default-mail-headers' instead.") (custom-autoload 'mail-archive-file-name "sendmail" t) (defvar mail-default-reply-to nil "\ Address to insert as default Reply-To field of outgoing messages. If nil, it will be initialized from the REPLYTO environment variable -when you first send mail.") +when you first send mail. +If you are using `message-mode' to compose messages, customize the +variable `message-default-mail-headers' instead.") (custom-autoload 'mail-default-reply-to "sendmail" t) @@ -29198,7 +29233,9 @@ in `message-auto-save-directory'.") (defvar mail-default-headers nil "\ A string containing header lines, to be inserted in outgoing messages. It can contain newlines, and should end in one. It is inserted -before you edit the message, so you can edit or delete the lines.") +before you edit the message, so you can edit or delete the lines. +If you are using `message-mode' to compose messages, customize the +variable `message-default-mail-headers' instead.") (custom-autoload 'mail-default-headers "sendmail" t) @@ -29887,10 +29924,6 @@ DOM should be a parse tree as generated by (autoload 'sieve-mode "sieve-mode" "\ Major mode for editing Sieve code. -This is much like C mode except for the syntax of comments. Its keymap -inherits from C mode's and it has the same variables for customizing -indentation. It has its own abbrev table and its own syntax table. - Turning on Sieve mode runs `sieve-mode-hook'. \(fn)" t nil) @@ -31532,7 +31565,7 @@ Truncate STRING to LENGTH, replacing initial surplus with \"...\". \(fn STRING LENGTH)" nil nil) -(register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let*" "internal--" "replace-region-contents" "string-" "thread-" "when-let*")) +(register-definition-prefixes "subr-x" '("and-let*" "hash-table-" "if-let*" "internal--" "named-let" "replace-region-contents" "string-" "thread-" "when-let*")) ;;;*** @@ -34174,7 +34207,7 @@ Add archive file name handler to `file-name-handler-alist'." (when tramp-archive ;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0)) ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 5 0)) package--builtin-versions) +(push (purecopy '(tramp 2 5 1 -1)) package--builtin-versions) (register-definition-prefixes "trampver" '("tramp-")) @@ -34542,9 +34575,9 @@ The variable `unrmail-mbox-format' controls which mbox format to use. (autoload 'unsafep "unsafep" "\ Return nil if evaluating FORM couldn't possibly do any harm. Otherwise result is a reason why FORM is unsafe. -UNSAFEP-VARS is a list of symbols with local bindings. +VARS is a list of symbols with local bindings like `unsafep-vars'. -\(fn FORM &optional UNSAFEP-VARS)" nil nil) +\(fn FORM &optional VARS)" nil nil) (register-definition-prefixes "unsafep" '("safe-functions" "unsafep-")) @@ -38493,43 +38526,43 @@ Zone out, completely." t nil) ;;;;;; "leim/quail/Punct-b5.el" "leim/quail/Punct.el" "leim/quail/QJ-b5.el" ;;;;;; "leim/quail/QJ.el" "leim/quail/SW.el" "leim/quail/TONEPY.el" ;;;;;; "leim/quail/ZIRANMA.el" "leim/quail/ZOZY.el" "leim/quail/arabic.el" -;;;;;; "leim/quail/compose.el" "leim/quail/croatian.el" "leim/quail/cyril-jis.el" -;;;;;; "leim/quail/cyrillic.el" "leim/quail/czech.el" "leim/quail/georgian.el" -;;;;;; "leim/quail/greek.el" "leim/quail/hanja-jis.el" "leim/quail/hanja.el" -;;;;;; "leim/quail/hanja3.el" "leim/quail/hebrew.el" "leim/quail/ipa-praat.el" -;;;;;; "leim/quail/latin-alt.el" "leim/quail/latin-ltx.el" "leim/quail/latin-post.el" -;;;;;; "leim/quail/latin-pre.el" "leim/quail/persian.el" "leim/quail/programmer-dvorak.el" -;;;;;; "leim/quail/py-punct.el" "leim/quail/pypunct-b5.el" "leim/quail/quick-b5.el" -;;;;;; "leim/quail/quick-cns.el" "leim/quail/rfc1345.el" "leim/quail/sami.el" -;;;;;; "leim/quail/sgml-input.el" "leim/quail/slovak.el" "leim/quail/symbol-ksc.el" -;;;;;; "leim/quail/tamil-dvorak.el" "leim/quail/tsang-b5.el" "leim/quail/tsang-cns.el" -;;;;;; "leim/quail/vntelex.el" "leim/quail/vnvni.el" "leim/quail/welsh.el" -;;;;;; "loadup.el" "mail/blessmail.el" "mail/rmailedit.el" "mail/rmailkwd.el" -;;;;;; "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el" -;;;;;; "mail/rmailsum.el" "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el" -;;;;;; "mh-e/mh-loaddefs.el" "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el" -;;;;;; "newcomment.el" "obarray.el" "org/ob-core.el" "org/ob-lob.el" -;;;;;; "org/ob-matlab.el" "org/ob-tangle.el" "org/ob.el" "org/ol-bbdb.el" -;;;;;; "org/ol-irc.el" "org/ol.el" "org/org-archive.el" "org/org-attach.el" -;;;;;; "org/org-clock.el" "org/org-colview.el" "org/org-compat.el" -;;;;;; "org/org-datetree.el" "org/org-duration.el" "org/org-element.el" -;;;;;; "org/org-feed.el" "org/org-footnote.el" "org/org-goto.el" -;;;;;; "org/org-id.el" "org/org-indent.el" "org/org-install.el" -;;;;;; "org/org-keys.el" "org/org-lint.el" "org/org-list.el" "org/org-macs.el" -;;;;;; "org/org-mobile.el" "org/org-num.el" "org/org-plot.el" "org/org-refile.el" -;;;;;; "org/org-table.el" "org/org-timer.el" "org/ox-ascii.el" "org/ox-beamer.el" -;;;;;; "org/ox-html.el" "org/ox-icalendar.el" "org/ox-latex.el" -;;;;;; "org/ox-md.el" "org/ox-odt.el" "org/ox-org.el" "org/ox-publish.el" -;;;;;; "org/ox-texinfo.el" "org/ox.el" "progmodes/elisp-mode.el" -;;;;;; "progmodes/prog-mode.el" "ps-mule.el" "register.el" "replace.el" -;;;;;; "rfn-eshadow.el" "select.el" "simple.el" "startup.el" "subdirs.el" -;;;;;; "subr.el" "tab-bar.el" "textmodes/fill.el" "textmodes/page.el" -;;;;;; "textmodes/paragraphs.el" "textmodes/reftex-auc.el" "textmodes/reftex-cite.el" -;;;;;; "textmodes/reftex-dcr.el" "textmodes/reftex-global.el" "textmodes/reftex-index.el" -;;;;;; "textmodes/reftex-parse.el" "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" -;;;;;; "textmodes/reftex-toc.el" "textmodes/text-mode.el" "uniquify.el" -;;;;;; "vc/ediff-hook.el" "vc/vc-hooks.el" "version.el" "widget.el" -;;;;;; "window.el") (0 0 0 0)) +;;;;;; "leim/quail/cham.el" "leim/quail/compose.el" "leim/quail/croatian.el" +;;;;;; "leim/quail/cyril-jis.el" "leim/quail/cyrillic.el" "leim/quail/czech.el" +;;;;;; "leim/quail/georgian.el" "leim/quail/greek.el" "leim/quail/hanja-jis.el" +;;;;;; "leim/quail/hanja.el" "leim/quail/hanja3.el" "leim/quail/hebrew.el" +;;;;;; "leim/quail/ipa-praat.el" "leim/quail/latin-alt.el" "leim/quail/latin-ltx.el" +;;;;;; "leim/quail/latin-post.el" "leim/quail/latin-pre.el" "leim/quail/persian.el" +;;;;;; "leim/quail/programmer-dvorak.el" "leim/quail/py-punct.el" +;;;;;; "leim/quail/pypunct-b5.el" "leim/quail/quick-b5.el" "leim/quail/quick-cns.el" +;;;;;; "leim/quail/rfc1345.el" "leim/quail/sami.el" "leim/quail/sgml-input.el" +;;;;;; "leim/quail/slovak.el" "leim/quail/symbol-ksc.el" "leim/quail/tamil-dvorak.el" +;;;;;; "leim/quail/tsang-b5.el" "leim/quail/tsang-cns.el" "leim/quail/vntelex.el" +;;;;;; "leim/quail/vnvni.el" "leim/quail/welsh.el" "loadup.el" "mail/blessmail.el" +;;;;;; "mail/rmailedit.el" "mail/rmailkwd.el" "mail/rmailmm.el" +;;;;;; "mail/rmailmsc.el" "mail/rmailsort.el" "mail/rmailsum.el" +;;;;;; "mail/undigest.el" "menu-bar.el" "mh-e/mh-gnus.el" "mh-e/mh-loaddefs.el" +;;;;;; "minibuffer.el" "mouse.el" "net/tramp-loaddefs.el" "newcomment.el" +;;;;;; "obarray.el" "org/ob-core.el" "org/ob-lob.el" "org/ob-matlab.el" +;;;;;; "org/ob-tangle.el" "org/ob.el" "org/ol-bbdb.el" "org/ol-irc.el" +;;;;;; "org/ol.el" "org/org-archive.el" "org/org-attach.el" "org/org-clock.el" +;;;;;; "org/org-colview.el" "org/org-compat.el" "org/org-datetree.el" +;;;;;; "org/org-duration.el" "org/org-element.el" "org/org-feed.el" +;;;;;; "org/org-footnote.el" "org/org-goto.el" "org/org-id.el" "org/org-indent.el" +;;;;;; "org/org-install.el" "org/org-keys.el" "org/org-lint.el" +;;;;;; "org/org-list.el" "org/org-macs.el" "org/org-mobile.el" "org/org-num.el" +;;;;;; "org/org-plot.el" "org/org-refile.el" "org/org-table.el" +;;;;;; "org/org-timer.el" "org/ox-ascii.el" "org/ox-beamer.el" "org/ox-html.el" +;;;;;; "org/ox-icalendar.el" "org/ox-latex.el" "org/ox-md.el" "org/ox-odt.el" +;;;;;; "org/ox-org.el" "org/ox-publish.el" "org/ox-texinfo.el" "org/ox.el" +;;;;;; "progmodes/elisp-mode.el" "progmodes/prog-mode.el" "ps-mule.el" +;;;;;; "register.el" "replace.el" "rfn-eshadow.el" "select.el" "simple.el" +;;;;;; "startup.el" "subdirs.el" "subr.el" "tab-bar.el" "textmodes/fill.el" +;;;;;; "textmodes/page.el" "textmodes/paragraphs.el" "textmodes/reftex-auc.el" +;;;;;; "textmodes/reftex-cite.el" "textmodes/reftex-dcr.el" "textmodes/reftex-global.el" +;;;;;; "textmodes/reftex-index.el" "textmodes/reftex-parse.el" "textmodes/reftex-ref.el" +;;;;;; "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" "textmodes/text-mode.el" +;;;;;; "uniquify.el" "vc/ediff-hook.el" "vc/vc-hooks.el" "version.el" +;;;;;; "widget.el" "window.el") (0 0 0 0)) ;;;*** diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el index 20762d36f07..ca1aae77be3 100644 --- a/lisp/leim/quail/hangul.el +++ b/lisp/leim/quail/hangul.el @@ -511,8 +511,7 @@ When a Korean input method is off, convert the following hangul character." ;; Text shown by describe-input-method. Set to a proper text by ;; hangul-input-method-activate. -(defvar hangul-input-method-help-text nil) -(make-variable-buffer-local 'hangul-input-method-help-text) +(defvar-local hangul-input-method-help-text nil) ;;;###autoload (defun hangul-input-method-activate (input-method func help-text &rest args) diff --git a/lisp/leim/quail/japanese.el b/lisp/leim/quail/japanese.el index d7249d286fb..a4ea550c265 100644 --- a/lisp/leim/quail/japanese.el +++ b/lisp/leim/quail/japanese.el @@ -113,8 +113,7 @@ (?h . "japanese") (?q . ("japanese-ascii")))) -(defvar quail-japanese-package-saved nil) -(make-variable-buffer-local 'quail-japanese-package-saved) +(defvar-local quail-japanese-package-saved nil) (put 'quail-japanese-package-saved 'permanent-local t) (defun quail-japanese-switch-package (key idx) diff --git a/lisp/linum.el b/lisp/linum.el index 824f016271d..f9761d22c6e 100644 --- a/lisp/linum.el +++ b/lisp/linum.el @@ -34,13 +34,11 @@ (defconst linum-version "0.9x") (make-obsolete-variable 'linum-version nil "28.1") -(defvar linum-overlays nil "Overlays used in this buffer.") -(defvar linum-available nil "Overlays available for reuse.") +(defvar-local linum-overlays nil "Overlays used in this buffer.") +(defvar-local linum-available nil "Overlays available for reuse.") (defvar linum-before-numbering-hook nil "Functions run in each buffer before line numbering starts.") -(mapc #'make-variable-buffer-local '(linum-overlays linum-available)) - (defgroup linum nil "Show line numbers in the left margin." :group 'convenience) diff --git a/lisp/loadup.el b/lisp/loadup.el index aefe91405cf..cafde7ce943 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -253,8 +253,6 @@ (load "startup") (load "term/tty-colors") (load "font-core") -;; facemenu must be loaded before font-lock, because `facemenu-keymap' -;; needs to be defined when font-lock is loaded. (load "facemenu") (load "emacs-lisp/syntax") (load "font-lock") @@ -505,6 +503,30 @@ lost after dumping"))) ;; Make sure we will attempt bidi reordering henceforth. (setq redisplay--inhibit-bidi nil) + +;; Experimental feature removal. +(define-key global-map "\M-o" #'removed-facemenu-command) + +(defun removed-facemenu-command () + "Transition command during test period for facemenu removal." + (interactive) + (switch-to-buffer "*Facemenu Removal*") + (let ((inhibit-read-only t)) + (erase-buffer) + (insert-file-contents + (expand-file-name "facemenu-removal.txt" data-directory))) + (goto-char (point-min)) + (special-mode)) + +(defun facemenu-keymap-restore () + "Restore the facemenu keymap." + ;; Global bindings: + (define-key global-map [C-down-mouse-2] 'facemenu-menu) + (define-key global-map "\M-o" 'facemenu-keymap) + (define-key facemenu-keymap "\eS" 'center-paragraph) + (define-key facemenu-keymap "\es" 'center-line)) + + (if dump-mode (let ((output (cond ((equal dump-mode "pdump") "emacs.pdmp") ((equal dump-mode "dump") "emacs") diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index fa9e89e6fe0..4d88da58a1d 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -58,13 +58,11 @@ (defvar report-emacs-bug-orig-text nil "The automatically-created initial text of the bug report.") -(defvar report-emacs-bug-send-command nil +(defvar-local report-emacs-bug-send-command nil "Name of the command to send the bug report, as a string.") -(make-variable-buffer-local 'report-emacs-bug-send-command) -(defvar report-emacs-bug-send-hook nil +(defvar-local report-emacs-bug-send-hook nil "Hook run before sending the bug report.") -(make-variable-buffer-local 'report-emacs-bug-send-hook) (declare-function x-server-vendor "xfns.c" (&optional terminal)) (declare-function x-server-version "xfns.c" (&optional terminal)) diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el index ad2dee59c7c..83125a0d200 100644 --- a/lisp/mail/mail-utils.el +++ b/lisp/mail/mail-utils.el @@ -1,4 +1,4 @@ -;;; mail-utils.el --- utility functions used both by rmail and rnews +;;; mail-utils.el --- utility functions used both by rmail and rnews -*- lexical-binding: t -*- ;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc. @@ -46,6 +46,7 @@ also the To field, unless this would leave an empty To field." :type '(choice regexp (const :tag "Your Name" nil)) :group 'mail) +(defvar epa-inhibit) ;; Returns t if file FILE is an Rmail file. ;;;###autoload (defun mail-file-babyl-p (file) @@ -58,6 +59,7 @@ also the To field, unless this would leave an empty To field." (defun mail-string-delete (string start end) "Return a string containing all of STRING except the part from START (inclusive) to END (exclusive)." + ;; FIXME: This is not used anywhere. Make obsolete? (if (null end) (substring string 0 start) (concat (substring string 0 start) (substring string end nil)))) diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el index 2e583a470d6..4b70582a261 100644 --- a/lisp/mail/reporter.el +++ b/lisp/mail/reporter.el @@ -100,9 +100,8 @@ This is necessary to properly support the printing of buffer-local variables. Current buffer will always be the mail buffer being composed.") -(defvar reporter-initial-text nil +(defvar-local reporter-initial-text nil "The automatically created initial text of a bug report.") -(make-variable-buffer-local 'reporter-initial-text) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 9f95b62d870..8ccf1bffdd6 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -620,14 +620,12 @@ Element N specifies the summary line for message N+1.") ;; Rmail buffer swapping variables. -(defvar rmail-buffer-swapped nil +(defvar-local rmail-buffer-swapped nil "If non-nil, `rmail-buffer' is swapped with `rmail-view-buffer'.") -(make-variable-buffer-local 'rmail-buffer-swapped) (put 'rmail-buffer-swapped 'permanent-local t) -(defvar rmail-view-buffer nil +(defvar-local rmail-view-buffer nil "Buffer which holds RMAIL message for MIME displaying.") -(make-variable-buffer-local 'rmail-view-buffer) (put 'rmail-view-buffer 'permanent-local t) ;; `Sticky' default variables. diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 7f99ecdcf2c..f53e6e768f8 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -930,10 +930,11 @@ a negative argument means to delete and move backward." (unless (numberp count) (setq count 1)) (let (del-msg (backward (< count 0))) - (while (and (/= count 0) - ;; Don't waste time if we are at the beginning - ;; and trying to go backward. - (not (and backward (bobp)))) + (while (/= count 0) + ;; Don't waste time counting down without doing anything if we + ;; are at the beginning and trying to go backward. + (if (and backward (bobp)) + (setq count -1)) (rmail-summary-goto-msg) (with-current-buffer rmail-buffer (setq del-msg rmail-current-message) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index d2601c35e8d..cd071667562 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -1800,14 +1800,14 @@ If the current line has `mail-yank-prefix', insert it on the new line." (declare-function mml-attach-file "mml" (file &optional type description disposition)) -(declare-function mm-default-file-encoding "mm-encode" (file)) (defun mail-add-attachment (file) "Add FILE as a MIME attachment to the end of the mail message being composed." (interactive "fAttach file: ") (mml-attach-file file - (or (mm-default-file-encoding file) - "application/octet-stream") nil) + (or (mm-default-file-type file) + "application/octet-stream") + nil) (setq mail-encode-mml t)) diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index 5766c791878..99ac41dd9ba 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -509,9 +509,9 @@ string." ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ;; end user configuration variables -(defvar sc-mail-info nil +(defvar-local sc-mail-info nil "Alist of mail header information gleaned from reply buffer.") -(defvar sc-attributions nil +(defvar-local sc-attributions nil "Alist of attributions for use when citing.") (defvar sc-tmp-nested-regexp nil @@ -521,9 +521,6 @@ string." (defvar sc-tmp-dumb-regexp nil "Temp regexp describing non-nested citation cited with a nesting citer.") -(make-variable-buffer-local 'sc-mail-info) -(make-variable-buffer-local 'sc-attributions) - ;; ====================================================================== ;; supercite keymaps diff --git a/lisp/man.el b/lisp/man.el index ca50b3a2fa3..1fded38e72d 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -97,8 +97,6 @@ :group 'external :group 'help) -(defvar Man-notify) - (defcustom Man-filter-list nil "Manpage cleaning filter command phrases. This variable contains a list of the following form: @@ -149,8 +147,7 @@ the manpage buffer." (ansi-color-make-color-map)) "The value used here for `ansi-color-map'.") -;; Use the value of the obsolete user option Man-notify, if set. -(defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly) +(defcustom Man-notify-method 'friendly "Selects the behavior when manpage is ready. This variable may have one of the following values, where (sf) means that the frames are switched, so the manpage is displayed in the frame @@ -399,22 +396,15 @@ Otherwise, the value is whatever the function ;; other variables and keymap initializations -(defvar Man-original-frame) -(make-variable-buffer-local 'Man-original-frame) -(defvar Man-arguments) -(make-variable-buffer-local 'Man-arguments) +(defvar-local Man-original-frame nil) +(defvar-local Man-arguments nil) (put 'Man-arguments 'permanent-local t) -(defvar Man--sections nil) -(make-variable-buffer-local 'Man--sections) -(defvar Man--refpages nil) -(make-variable-buffer-local 'Man--refpages) -(defvar Man-page-list nil) -(make-variable-buffer-local 'Man-page-list) -(defvar Man-current-page 0) -(make-variable-buffer-local 'Man-current-page) -(defvar Man-page-mode-string "1 of 1") -(make-variable-buffer-local 'Man-page-mode-string) +(defvar-local Man--sections nil) +(defvar-local Man--refpages nil) +(defvar-local Man-page-list nil) +(defvar-local Man-current-page 0) +(defvar-local Man-page-mode-string "1 of 1") (defconst Man-sysv-sed-script "\ /\b/ { s/_\b//g diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 526491f0272..133df65cbcb 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -636,9 +636,9 @@ Do the same for the keys of the same name." :help "Customize value of specific option")) (bindings--define-key menu [separator-2] menu-bar-separator) - (bindings--define-key menu [customize-changed-options] - '(menu-item "New Options..." customize-changed-options - :help "Options added or changed in recent Emacs versions")) + (bindings--define-key menu [customize-changed] + '(menu-item "New Options..." customize-changed + :help "Options and faces added or changed in recent Emacs versions")) (bindings--define-key menu [customize-saved] '(menu-item "Saved Options" customize-saved :help "Customize previously saved options")) @@ -2240,9 +2240,8 @@ Buffers menu is regenerated." :type 'boolean :group 'menu) -(defvar list-buffers-directory nil +(defvar-local list-buffers-directory nil "String to display in buffer listings for buffers not visiting a file.") -(make-variable-buffer-local 'list-buffers-directory) (defun menu-bar-select-buffer () (interactive) diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 9185c2a0645..2eb7fbaa20c 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -3412,6 +3412,7 @@ sequence." ;;; Faces (:group 'mh-faces + group where faces described) (if (boundp 'facemenu-unlisted-faces) + ;; This variable was removed in Emacs 22.1. (add-to-list 'facemenu-unlisted-faces "^mh-")) ;; To add a new face: diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 7bdf743fc42..70df9e6b0f2 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -1725,14 +1725,14 @@ a type (see `mailcap-mime-types'). Optional argument DEFAULT is returned if a type isn't entered." (mailcap-parse-mimetypes) (let* ((default (or default - (mm-default-file-encoding filename) + (mm-default-file-type filename) "application/octet-stream")) (probed-type (mh-file-mime-type filename)) (type (or (and (not (equal probed-type "application/octet-stream")) probed-type) (completing-read (format "Content type (default %s): " default) - (mapcar 'list (mailcap-mime-types)))))) + (mapcar #'list (mailcap-mime-types)))))) (if (not (equal type "")) type default))) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 315f2d369af..a899a943d4c 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -122,7 +122,8 @@ This metadata is an alist. Currently understood keys are: returns a string to append to STRING. - `affixation-function': function to prepend/append a prefix/suffix to entries. Takes one argument (COMPLETIONS) and should return a list - of completions with a list of three elements: completion, its prefix + of completions with a list of either two elements: completion + and suffix, or three elements: completion, its prefix and suffix. This function takes priority over `annotation-function' when both are provided, so only this function is used. - `display-sort-function': function to sort entries in *Completions*. @@ -1785,22 +1786,17 @@ It also eliminates runs of equal strings." (when prefix (let ((beg (point)) (end (progn (insert prefix) (point)))) - (put-text-property beg end 'mouse-face nil) - ;; When both prefix and suffix are added - ;; by the caller via affixation-function, - ;; then allow the caller to decide - ;; what faces to put on prefix and suffix. - (unless prefix - (font-lock-prepend-text-property - beg end 'face 'completions-annotations)))) + (put-text-property beg end 'mouse-face nil))) (put-text-property (point) (progn (insert (car str)) (point)) 'mouse-face 'highlight) (let ((beg (point)) (end (progn (insert suffix) (point)))) (put-text-property beg end 'mouse-face nil) ;; Put the predefined face only when suffix - ;; is added via annotation-function. - (unless prefix + ;; is added via annotation-function without prefix, + ;; and when the caller doesn't use own face. + (unless (or prefix (text-property-not-all + 0 (length suffix) 'face nil suffix)) (font-lock-prepend-text-property beg end 'face 'completions-annotations))))) (cond @@ -1927,6 +1923,7 @@ These include: `:affixation-function': Function to prepend/append a prefix/suffix to completions. The function must accept one argument, a list of completions, and return a list where each element is a list of + either two elements: a completion, and a suffix, or three elements: a completion, a prefix and a suffix. This function takes priority over `:annotation-function' when both are provided, so only this function is used. @@ -2119,13 +2116,15 @@ variables.") (defun exit-minibuffer () "Terminate this minibuffer argument." (interactive) + (when (or + (innermost-minibuffer-p) + (not (minibufferp))) ;; If the command that uses this has made modifications in the minibuffer, ;; we don't want them to cause deactivation of the mark in the original ;; buffer. ;; A better solution would be to make deactivate-mark buffer-local ;; (or to turn it into a list of buffers, ...), but in the mean time, ;; this should do the trick in most cases. - (when (innermost-minibuffer-p) (setq deactivate-mark nil) (throw 'exit nil)) (error "%s" "Not in most nested minibuffer")) diff --git a/lisp/mouse-copy.el b/lisp/mouse-copy.el index e48722ef944..8155c9dff30 100644 --- a/lisp/mouse-copy.el +++ b/lisp/mouse-copy.el @@ -55,9 +55,6 @@ ;; <twurgler@goodyear.com> is similar to mouse-drag-throw, but ;; doesn't pass clicks through. ;; -;; These functions have been tested in emacs version 19.30, -;; and this package has run in the past on 19.25-19.29. -;; ;; Originally mouse-copy was part of a larger package. ;; As of 11 July 96 the scrolling functions were split out ;; in preparation for incorporation into (the future) emacs-19.32. diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el index 907ef061594..b2960a4ccd3 100644 --- a/lisp/mouse-drag.el +++ b/lisp/mouse-drag.el @@ -70,9 +70,6 @@ ;; <twurgler@goodyear.com> is similar to mouse-drag-throw, but ;; doesn't pass clicks through. ;; -;; These functions have been tested in emacs version 19.30, -;; and this package has run in the past on 19.25-19.29. -;; ;; Originally mouse-drag was part of a larger package. ;; As of 11 July 96 the scrolling functions were split out ;; in preparation for incorporation into (the future) emacs-19.32. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 7b72a713623..58f01d5bf98 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -481,8 +481,7 @@ Used by the `browse-url-of-file' command." "Hook run after `browse-url-of-file' has asked a browser to load a file." :type 'hook) -(defvar browse-url-temp-file-name nil) -(make-variable-buffer-local 'browse-url-temp-file-name) +(defvar-local browse-url-temp-file-name nil) (defcustom browse-url-xterm-program "xterm" "The name of the terminal emulator used by `browse-url-text-xterm'. diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 195ddc6bbac..a9de35c814f 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -2171,6 +2171,23 @@ has been handled by this function." (when eobp (goto-char (point-max)))))) +;;;###autoload +(defun dbus-monitor (&optional bus) + "Invoke `dbus-register-monitor' interactively, and switch to the buffer. +BUS is either a Lisp keyword, `:system' or `:session', or a +string denoting the bus address. The value nil defaults to `:session'." + (interactive + (list + (let ((input + (completing-read + (format-prompt "Enter bus symbol or name" :session) + '(:system :session) nil nil nil nil :session))) + (if (and (stringp input) + (string-match-p "^\\(:session\\|:system\\)$" input)) + (intern input) input)))) + (dbus-register-monitor (or bus :session)) + (switch-to-buffer (get-buffer-create "*D-Bus Monitor*"))) + (defun dbus-handle-bus-disconnect () "React to a bus disconnection. BUS is the bus that disconnected. This routine unregisters all diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index d88c0b48f93..8ad4fe4e637 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -1,34 +1,36 @@ ;;; dictionary-connection.el --- TCP-based client connection for dictionary -*- lexical-binding:t -*- +;; Copyright (C) 2021 Free Software Foundation, Inc. + ;; Author: Torsten Hilbrich <torsten.hilbrich@gmx.net> ;; Keywords: network -;; This file is free software; you can redistribute it and/or modify +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. -;; This file is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: ;; dictionary-connection allows to handle TCP-based connections in -;; client mode where text-based information are exchanged. There is +;; client mode where text-based information are exchanged. There is ;; special support for handling CR LF (and the usual CR LF . CR LF ;; terminater). ;;; Code: (defsubst dictionary-connection-p (connection) - "Returns non-nil if CONNECTION is a connection object." + "Return non-nil if CONNECTION is a connection object." (get connection 'connection)) (defsubst dictionary-connection-read-point (connection) @@ -147,8 +149,7 @@ nil: argument is no connection object (defun dictionary-connection-read-to-point (connection) "Read from CONNECTION until an end of entry is encountered. -End of entry is a decimal point found on a line by itself. -" +End of entry is a decimal point found on a line by itself." (dictionary-connection-read connection "\015?\012[.]\015?\012")) (provide 'dictionary-connection) diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index f8733429e94..6f086053b6a 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -1,22 +1,24 @@ ;;; dictionary.el --- Client for rfc2229 dictionary servers -*- lexical-binding:t -*- +;; Copyright (C) 2021 Free Software Foundation, Inc. + ;; Author: Torsten Hilbrich <torsten.hilbrich@gmx.net> ;; Keywords: interface, dictionary -;; This file is free software; you can redistribute it and/or modify +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. -;; This file is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -46,7 +48,7 @@ (defun dictionary-set-server-var (name value) "Customize helper for setting variable NAME to VALUE. The helper is used by customize to check for an active connection -when setting a variable. The user has then the choice to close +when setting a variable. The user has then the choice to close the existing connection." (if (and (boundp 'dictionary-connection) dictionary-connection @@ -73,8 +75,7 @@ You can specify here: - Automatic: First try localhost, then dict.org after confirmation - localhost: Only use localhost - dict.org: Only use dict.org -- User-defined: You can specify your own server here -" +- User-defined: You can specify your own server here" :group 'dictionary :set 'dictionary-set-server-var :type '(choice (const :tag "Automatic" nil) @@ -86,7 +87,7 @@ You can specify here: (defcustom dictionary-port 2628 "The port of the dictionary server. - This port is propably always 2628 so there should be no need to modify it." +This port is propably always 2628 so there should be no need to modify it." :group 'dictionary :set 'dictionary-set-server-var :type 'number @@ -102,8 +103,8 @@ You can specify here: (defcustom dictionary-default-dictionary "*" "The dictionary which is used for searching definitions and matching. - * and ! have a special meaning, * search all dictionaries, ! search until - one dictionary yields matches." +* and ! have a special meaning, * search all dictionaries, ! search until +one dictionary yields matches." :group 'dictionary :type 'string :version "28.1") @@ -144,8 +145,7 @@ by the choice value: - User choice Here you can enter any matching algorithm supported by your - dictionary server. -" + dictionary server." :group 'dictionary :type '(choice (const :tag "Exact match" "exact") (const :tag "Similiar sounding" "soundex") @@ -160,6 +160,18 @@ by the choice value: :type 'boolean :version "28.1") +(defcustom dictionary-link-dictionary + "*" + "The dictionary which is used in links. +* means to create links that search all dictionaries, +nil means to create links that search only in the same dictionary +where the current word was found." + :group 'dictionary + :type '(choice (const :tag "Link to all dictionaries" "*") + (const :tag "Link only to the same dictionary" nil) + (string :tag "User choice")) + :version "28.1") + (defcustom dictionary-mode-hook nil "Hook run in dictionary mode buffers." @@ -167,6 +179,13 @@ by the choice value: :type 'hook :version "28.1") +(defcustom dictionary-post-buffer-hook + nil + "Hook run at the end of every update of the dictionary buffer." + :group 'dictionary + :type 'hook + :version "28.1") + (defcustom dictionary-use-http-proxy nil "Connects via a HTTP proxy using the CONNECT command when not nil." @@ -177,7 +196,7 @@ by the choice value: (defcustom dictionary-proxy-server "proxy" - "The name of the HTTP proxy to use when dictionary-use-http-proxy is set." + "The name of the HTTP proxy to use when `dictionary-use-http-proxy' is set." :group 'dictionary-proxy :set 'dictionary-set-server-var :type 'string @@ -185,7 +204,7 @@ by the choice value: (defcustom dictionary-proxy-port 3128 - "The port of the proxy server, used only when dictionary-use-http-proxy is set." + "The port of the proxy server, used only when `dictionary-use-http-proxy' is set." :group 'dictionary-proxy :set 'dictionary-set-server-var :type 'number @@ -200,14 +219,14 @@ by the choice value: (defcustom dictionary-description-open-delimiter "" - "The delimiter to display in front of the dictionaries description" + "The delimiter to display in front of the dictionaries description." :group 'dictionary :type 'string :version "28.1") (defcustom dictionary-description-close-delimiter "" - "The delimiter to display after of the dictionaries description" + "The delimiter to display after of the dictionaries description." :group 'dictionary :type 'string :version "28.1") @@ -283,27 +302,27 @@ is utf-8" (defvar dictionary-window-configuration nil - "The window configuration to be restored upon closing the buffer") + "The window configuration to be restored upon closing the buffer.") (defvar dictionary-selected-window nil - "The currently selected window") + "The currently selected window.") (defvar dictionary-position-stack nil - "The history buffer for point and window position") + "The history buffer for point and window position.") (defvar dictionary-data-stack nil - "The history buffer for functions and arguments") + "The history buffer for functions and arguments.") (defvar dictionary-positions nil - "The current positions") + "The current positions.") (defvar dictionary-current-data nil - "The item that will be placed on stack next time") + "The item that will be placed on stack next time.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Global variables @@ -323,18 +342,19 @@ is utf-8" (define-key map "l" 'dictionary-previous) (define-key map "n" 'forward-button) (define-key map "p" 'backward-button) - (define-key map " " 'scroll-up) - (define-key map (read-kbd-macro "M-SPC") 'scroll-down) + (define-key map " " 'scroll-up-command) + (define-key map [?\S-\ ] 'scroll-down-command) + (define-key map (read-kbd-macro "M-SPC") 'scroll-down-command) map) "Keymap for the dictionary mode.") (defvar dictionary-connection nil - "The current network connection") + "The current network connection.") (defvar dictionary-instances 0 - "The number of open dictionary buffers") + "The number of open dictionary buffers.") (defvar dictionary-marker nil @@ -344,11 +364,11 @@ is utf-8" (condition-case nil (x-display-color-p) (error nil)) - "Determines if the Emacs has support to display color") + "Determines if the Emacs has support to display color.") (defvar dictionary-word-history '() - "History list of searched word") + "History list of searched word.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Basic function providing startup actions @@ -356,25 +376,25 @@ is utf-8" ;;;###autoload (defun dictionary-mode () + ;; FIXME: Use define-derived-mode. "Mode for searching a dictionary. This is a mode for searching a dictionary server implementing the protocol defined in RFC 2229. This is a quick reference to this mode describing the default key bindings: +\\<dictionary-mode-map> +* \\[dictionary-close] close the dictionary buffer +* \\[dictionary-help] display this help information +* \\[dictionary-search] ask for a new word to search +* \\[dictionary-lookup-definition] search the word at point +* \\[forward-button] or TAB place point to the next link +* \\[backward-button] or S-TAB place point to the prev link -* q close the dictionary buffer -* h display this help information -* s ask for a new word to search -* d search the word at point -* n or Tab place point to the next link -* p or S-Tab place point to the prev link - -* m ask for a pattern and list all matching words. -* D select the default dictionary -* M select the default search strategy +* \\[dictionary-match-words] ask for a pattern and list all matching words. +* \\[dictionary-select-dictionary] select the default dictionary +* \\[dictionary-select-strategy] select the default search strategy -* Return or Button2 visit that link -" +* RET or <mouse-2> visit that link" (unless (eq major-mode 'dictionary-mode) (cl-incf dictionary-instances)) @@ -399,7 +419,7 @@ This is a quick reference to this mode describing the default key bindings: ;;;###autoload (defun dictionary () - "Create a new dictonary buffer and install dictionary-mode." + "Create a new dictonary buffer and install `dictionary-mode'." (interactive) (let ((buffer (or (and dictionary-use-single-buffer (get-buffer "*Dictionary*")) @@ -498,13 +518,13 @@ The connection takes the proxy setting in customization group (dictionary-open-server server) (error (if (y-or-n-p - (format "Failed to open server %s, continue with dict.org?" + (format "Failed to open server %s, continue with dict.org? " server)) (dictionary-open-server "dict.org") (error "Failed automatic server selection, please customize dictionary-server")))))))) (defun dictionary-mode-p () - "Return non-nil if current buffer has dictionary-mode." + "Return non-nil if current buffer has `dictionary-mode'." (eq major-mode 'dictionary-mode)) (defun dictionary-ensure-buffer () @@ -535,7 +555,7 @@ The connection takes the proxy setting in customization group ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun dictionary-send-command (string) - "Send the command `string' to the network connection." + "Send the command STRING to the network connection." (dictionary-check-connection) ;;;; ##### (dictionary-connection-send-crlf dictionary-connection string)) @@ -566,7 +586,7 @@ This function knows about the special meaning of quotes (\")" (nreverse list))) (defun dictionary-read-reply-and-split () - "Reads the reply, splits it into words and returns it." + "Read the reply, split it into words and return it." (let ((answer (make-symbol "reply-data")) (reply (dictionary-read-reply))) (let ((reply-list (dictionary-split-string reply))) @@ -589,7 +609,7 @@ The answer is delimited by a decimal point (.) on a line by itself." answer)) (defun dictionary-check-reply (reply code) - "Extract the reply code from REPLY and checks against CODE." + "Extract the reply code from REPLY and check against CODE." (let ((number (dictionary-reply-code reply))) (and (numberp number) (= number code)))) @@ -623,7 +643,7 @@ The answer is delimited by a decimal point (.) on a line by itself." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun dictionary-check-initial-reply () - "Reads the first reply from server and checks it." + "Read the first reply from server and check it." (let ((reply (dictionary-read-reply-and-split))) (unless (dictionary-check-reply reply 220) (dictionary-connection-close dictionary-connection) @@ -631,9 +651,9 @@ The answer is delimited by a decimal point (.) on a line by itself." ;; Store the current state (defun dictionary-store-state (function data) - "Stores the current state of operation for later restore. -The current state consist of a tuple of FUNCTION and DATA. This -is basically an implementation of a history to return to a + "Store the current state of operation for later restore. +The current state consist of a tuple of FUNCTION and DATA. +This is basically an implementation of a history to return to a previous state." (if dictionary-current-data (progn @@ -645,7 +665,7 @@ previous state." (cons function data))) (defun dictionary-store-positions () - "Stores the current positions for later restore." + "Store the current positions for later restore." (setq dictionary-positions (cons (point) (window-start)))) @@ -664,7 +684,7 @@ previous state." ;; The normal search (defun dictionary-new-search (args &optional all) - "Saves the current state and starts a new search based on ARGS. + "Save the current state and start a new search based on ARGS. The parameter ARGS is a cons cell where car is the word to search and cdr is the dictionary where to search the word in." (interactive) @@ -680,15 +700,14 @@ and cdr is the dictionary where to search the word in." (list word dictionary 'dictionary-display-search-result)))) (defun dictionary-new-search-internal (word dictionary function) - "Starts a new search for WORD in DICTIONARY after preparing the buffer. -FUNCTION is the callback which is called for each search result. -" + "Start a new search for WORD in DICTIONARY after preparing the buffer. +FUNCTION is the callback which is called for each search result." (dictionary-pre-buffer) (dictionary-do-search word dictionary function)) (defun dictionary-do-search (word dictionary function &optional nomatching) - "Searches WORD in DICTIONARY and calls FUNCTION for each result. -The parameter NOMATCHING controls whether to suppress the display + "Search for WORD in DICTIONARY and call FUNCTION for each result. +Optional argument NOMATCHING controls whether to suppress the display of matching words." (message "Searching for %s in %s" word dictionary) @@ -712,7 +731,7 @@ of matching words." 'dictionary-display-only-match-result) (dictionary-post-buffer))) (if (dictionary-check-reply reply 550) - (error "Dictionary \"%s\" is unknown, please select an existing one." + (error "Dictionary \"%s\" is unknown, please select an existing one" dictionary) (unless (dictionary-check-reply reply 150) (error "Unknown server answer: %s" (dictionary-reply reply))) @@ -773,10 +792,11 @@ of matching words." (goto-char dictionary-marker) (set-buffer-modified-p nil) - (setq buffer-read-only t)) + (setq buffer-read-only t) + (run-hooks 'dictionary-post-buffer-hook)) (defun dictionary-display-search-result (reply) - "This function starts displaying the result in REPLY." + "Start displaying the result in REPLY." (let ((number (nth 1 (dictionary-reply-list reply)))) (insert number (if (equal number "1") @@ -810,8 +830,7 @@ The DICTIONARY is only used for decoding the bytes to display the DESCRIPTION." (defun dictionary-display-word-definition (reply word dictionary) "Insert the definition in REPLY for the current WORD from DICTIONARY. It will replace links which are found in the REPLY and replace -them with buttons to perform a a new search. -" +them with buttons to perform a a new search." (let ((start (point))) (insert (dictionary-decode-charset reply dictionary)) (insert "\n\n") @@ -844,6 +863,8 @@ The word is taken from the buffer, the DICTIONARY is given as argument." (setq word (replace-match " " t t word))) (while (string-match "[*\"]" word) (setq word (replace-match "" t t word))) + (when dictionary-link-dictionary + (setq dictionary dictionary-link-dictionary)) (unless (equal word displayed-word) (make-button start end :type 'dictionary-link @@ -931,7 +952,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (message "Dictionary %s has been selected" dictionary)))) (defun dictionary-special-dictionary (name) - "Checks whether the special * or ! dictionary are seen in NAME." + "Check whether the special * or ! dictionary are seen in NAME." (or (equal name "*") (equal name "!"))) @@ -1011,7 +1032,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." (insert "\n"))))) (defun dictionary-set-strategy (strategy &rest ignored) - "Select this STRATEGY as new default" + "Select this STRATEGY as new default." (setq dictionary-default-strategy strategy) (dictionary-restore-state) (message "Strategy %s has been selected" strategy)) @@ -1119,9 +1140,11 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." ;; - if region is active returns its contents ;; - otherwise return the word near the point (defun dictionary-search-default () - (if (use-region-p) - (buffer-substring-no-properties (region-beginning) (region-end)) - (current-word t))) + (cond + ((use-region-p) + (buffer-substring-no-properties (region-beginning) (region-end))) + ((car (get-char-property (point) 'data))) + (t (current-word t)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User callable commands @@ -1234,7 +1257,7 @@ allows editing it." (defcustom dictionary-tooltip-dictionary nil - "This dictionary to lookup words for tooltips" + "This dictionary to lookup words for tooltips." :group 'dictionary :type '(choice (const :tag "None" nil) string) :version "28.1") @@ -1296,8 +1319,7 @@ It is normally internally called with 1 to enable support for the tooltip mode. The hook function will check the value of the variable dictionary-tooltip-mode to decide if some action must be taken. When disabling the tooltip mode the value of this variable -will be set to nil. -" +will be set to nil." (interactive) (tooltip-mode on) (if on @@ -1309,10 +1331,8 @@ will be set to nil. "Display tooltips for the current word. This function can be used to enable or disable the tooltip mode -for the current buffer (based on ARG). If global-tooltip-mode is -active it will overwrite that mode for the current buffer. -" - +for the current buffer (based on ARG). If global-tooltip-mode is +active it will overwrite that mode for the current buffer." (interactive "P") (require 'tooltip) (let ((on (if arg @@ -1335,8 +1355,7 @@ Internally it provides a default for the dictionary-tooltip-mode. It can be overwritten for each buffer using dictionary-tooltip-mode. Note: (global-dictionary-tooltip-mode 0) will not disable the mode -any buffer where (dictionary-tooltip-mode 1) has been called. -" +any buffer where (dictionary-tooltip-mode 1) has been called." (interactive "P") (require 'tooltip) (let ((on (if arg (> (prefix-numeric-value arg) 0) diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 0476835ebd9..7997bf3c90b 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -1,4 +1,4 @@ -;;; ldap.el --- client interface to LDAP for Emacs +;;; ldap.el --- client interface to LDAP for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2021 Free Software Foundation, Inc. @@ -418,12 +418,12 @@ RFC2798 Section 9.1.1") (encode-coding-string str ldap-coding-system)) (defun ldap-decode-address (str) - (mapconcat 'ldap-decode-string + (mapconcat #'ldap-decode-string (split-string str "\\$") "\n")) (defun ldap-encode-address (str) - (mapconcat 'ldap-encode-string + (mapconcat #'ldap-encode-string (split-string str "\n") "$")) @@ -601,7 +601,7 @@ an alist of attribute/value pairs." (sizelimit (plist-get search-plist 'sizelimit)) (withdn (plist-get search-plist 'withdn)) (numres 0) - arglist dn name value record result proc) + arglist dn name value record result) (if (or (null filter) (equal "" filter)) (error "No search filter")) @@ -671,7 +671,7 @@ an alist of attribute/value pairs." " bind distinguished name (binddn)")) (error "Failed ldapsearch invocation: %s \"%s\"" ldap-ldapsearch-prog - (mapconcat 'identity proc-args "\" \"")))))) + (mapconcat #'identity proc-args "\" \"")))))) (apply #'call-process ldap-ldapsearch-prog ;; Ignore stderr, which can corrupt results nil (list buf nil) nil diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 455673b5e9f..b95cd0febcd 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -842,11 +842,11 @@ If NO-DECODE is non-nil, don't decode STRING." ;; ~/.mailcap file, then we filter out the system entries ;; and see whether we have anything left. (when mailcap-prefer-mailcap-viewers - (when-let ((user-entry - (seq-find (lambda (elem) - (eq (cdr (assq 'source elem)) 'user)) - passed))) - (setq passed (list user-entry)))) + (when-let ((user-entries + (seq-filter (lambda (elem) + (eq (cdr (assq 'source elem)) 'user)) + passed))) + (setq passed user-entries))) (setq viewer (car passed)))) (when (and (stringp (cdr (assq 'viewer viewer))) passed) diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el index 08edb44275c..024d118f2de 100644 --- a/lisp/net/mairix.el +++ b/lisp/net/mairix.el @@ -1,4 +1,4 @@ -;;; mairix.el --- Mairix interface for Emacs +;;; mairix.el --- Mairix interface for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. @@ -83,55 +83,46 @@ (defcustom mairix-file-path "~/" "Path where output files produced by Mairix should be stored." - :type 'directory - :group 'mairix) + :type 'directory) (defcustom mairix-search-file "mairixsearch.mbox" "Name of the default file for storing the searches. Note that this will be prefixed by `mairix-file-path'." - :type 'string - :group 'mairix) + :type 'string) (defcustom mairix-command "mairix" "Command for calling mairix. You can add further options here if you want to, but better use `mairix-update-options' instead." - :type 'string - :group 'mairix) + :type 'string) (defcustom mairix-output-buffer "*mairix output*" "Name of the buffer for the output of the mairix binary." - :type 'string - :group 'mairix) + :type 'string) (defcustom mairix-customize-query-buffer "*mairix query*" "Name of the buffer for customizing a search query." - :type 'string - :group 'mairix) + :type 'string) (defcustom mairix-saved-searches-buffer "*mairix searches*" "Name of the buffer for displaying saved searches." - :type 'string - :group 'mairix) + :type 'string) (defcustom mairix-update-options '("-F" "-Q") "Options when calling mairix for updating the database. The default is \"-F\" and \"-Q\" for making updates faster. You should call mairix without these options from time to time (e.g. via cron job)." - :type '(repeat string) - :group 'mairix) + :type '(repeat string)) (defcustom mairix-search-options '("-Q") "Options when calling mairix for searching. The default is \"-Q\" for making searching faster." - :type '(repeat string) - :group 'mairix) + :type '(repeat string)) (defcustom mairix-synchronous-update nil "Defines if Emacs should wait for the mairix database update." - :type 'boolean - :group 'mairix) + :type 'boolean) (defcustom mairix-saved-searches nil "Saved mairix searches. @@ -144,8 +135,7 @@ threads (nil or t). Note that the file will be prefixed by (choice :tag "File" (const :tag "default") file) - (boolean :tag "Threads"))) - :group 'mairix) + (boolean :tag "Threads")))) (defcustom mairix-mail-program 'rmail "Mail program used to display search results. @@ -153,8 +143,7 @@ Currently RMail, Gnus (mbox), and VM are supported. If you use Gnus with maildir, use nnmairix.el instead." :type '(choice (const :tag "RMail" rmail) (const :tag "Gnus mbox" gnus) - (const :tag "VM" vm)) - :group 'mairix) + (const :tag "VM" vm))) (defcustom mairix-display-functions '((rmail mairix-rmail-display) @@ -166,8 +155,7 @@ This is an alist where each entry consists of a symbol from displaying the search results. The function will be called with the mailbox file produced by mairix as the single argument." :type '(repeat (list (symbol :tag "Mail program") - (function))) - :group 'mairix) + (function)))) (defcustom mairix-get-mail-header-functions '((rmail mairix-rmail-fetch-field) @@ -184,15 +172,13 @@ won't work." :type '(repeat (list (symbol :tag "Mail program") (choice :tag "Header function" (const :tag "none") - function))) - :group 'mairix) + function)))) (defcustom mairix-widget-select-window-function (lambda () (select-window (get-largest-window))) "Function for selecting the window for customizing the mairix query. The default chooses the largest window in the current frame." - :type 'function - :group 'mairix) + :type 'function) ;; Other variables @@ -466,18 +452,18 @@ MVALUES may contain values from current article." ;; generate Buttons (widget-create 'push-button :notify - (lambda (&rest ignore) + (lambda (&rest _) (mairix-widget-send-query mairix-widgets)) "Send Query") (widget-insert " ") (widget-create 'push-button :notify - (lambda (&rest ignore) + (lambda (&rest _) (mairix-widget-save-search mairix-widgets)) "Save search") (widget-insert " ") (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (&rest _) (kill-buffer mairix-customize-query-buffer)) "Cancel") (use-local-map widget-keymap) @@ -502,7 +488,7 @@ Mairix will be called asynchronously unless (cdr commandsplit) mairix-update-options)) (setq args (append args mairix-update-options))) - (apply 'call-process args)) + (apply #'call-process args)) (progn (message "Updating mairix database...") (setq args (append (list "mairixupdate" (get-buffer-create mairix-output-buffer) @@ -511,8 +497,8 @@ Mairix will be called asynchronously unless (setq args (append args (cdr commandsplit) mairix-update-options)) (setq args (append args mairix-update-options))) (set-process-sentinel - (apply 'start-process args) - 'mairix-sentinel-mairix-update-finished))))) + (apply #'start-process args) + #'mairix-sentinel-mairix-update-finished))))) ;;;; Helper functions @@ -557,7 +543,7 @@ whole threads. Function returns t if messages were found." mairix-file-path)) file)) (setq rval - (apply 'call-process + (apply #'call-process (append args (list "-o" file) query))) (if (zerop rval) (with-current-buffer mairix-output-buffer @@ -582,7 +568,7 @@ whole threads. Function returns t if messages were found." (setq header (replace-match "," t t header))) header)) -(defun mairix-sentinel-mairix-update-finished (proc status) +(defun mairix-sentinel-mairix-update-finished (_proc status) "Sentinel for mairix update process PROC with STATUS." (if (equal status "finished\n") (message "Updating mairix database... done") @@ -642,51 +628,50 @@ See %s for details" mairix-output-buffer))) (when (not (zerop (length flag))) (push (concat "F:" flag) query))) ;; return query string - (mapconcat 'identity query " "))) + (mapconcat #'identity query " "))) (defun mairix-widget-create-query (&optional values) "Create widgets for creating mairix queries. Fill in VALUES if based on an article." - (let (allwidgets) - (when (get-buffer mairix-customize-query-buffer) - (kill-buffer mairix-customize-query-buffer)) - (switch-to-buffer mairix-customize-query-buffer) - (kill-all-local-variables) - (erase-buffer) - (widget-insert - "Specify your query for Mairix using check boxes for activating fields.\n\n") - (widget-insert - (concat "Use ~word to match messages " - (propertize "not" 'face 'italic) - " containing the word)\n" - " substring= to match words containing the substring\n" - " substring=N to match words containing the substring, allowing\n" - " up to N errors(missing/extra/different letters)\n" - " ^substring= to match the substring at the beginning of a word.\n")) - (widget-insert - (format-message - "Whitespace will be converted to `,' (i.e. AND). Use `/' for OR.\n\n")) - (setq mairix-widgets (mairix-widget-build-editable-fields values)) - (when (member 'flags mairix-widget-other) - (widget-insert "\nFlags:\n Seen: ") - (mairix-widget-add "seen" - 'menu-choice - :value "ignore" - '(item "yes") '(item "no") '(item "ignore")) - (widget-insert " Replied: ") - (mairix-widget-add "replied" - 'menu-choice - :value "ignore" - '(item "yes") '(item "no") '(item "ignore")) - (widget-insert " Ticked: ") - (mairix-widget-add "flagged" - 'menu-choice - :value "ignore" - '(item "yes") '(item "no") '(item "ignore"))) - (when (member 'threads mairix-widget-other) - (widget-insert "\n") - (mairix-widget-add "Threads" 'checkbox nil)) - (widget-insert " Show full threads\n\n"))) + (when (get-buffer mairix-customize-query-buffer) + (kill-buffer mairix-customize-query-buffer)) + (switch-to-buffer mairix-customize-query-buffer) + (kill-all-local-variables) + (erase-buffer) + (widget-insert + "Specify your query for Mairix using check boxes for activating fields.\n\n") + (widget-insert + (concat "Use ~word to match messages " + (propertize "not" 'face 'italic) + " containing the word)\n" + " substring= to match words containing the substring\n" + " substring=N to match words containing the substring, allowing\n" + " up to N errors(missing/extra/different letters)\n" + " ^substring= to match the substring at the beginning of a word.\n")) + (widget-insert + (format-message + "Whitespace will be converted to `,' (i.e. AND). Use `/' for OR.\n\n")) + (setq mairix-widgets (mairix-widget-build-editable-fields values)) + (when (member 'flags mairix-widget-other) + (widget-insert "\nFlags:\n Seen: ") + (mairix-widget-add "seen" + 'menu-choice + :value "ignore" + '(item "yes") '(item "no") '(item "ignore")) + (widget-insert " Replied: ") + (mairix-widget-add "replied" + 'menu-choice + :value "ignore" + '(item "yes") '(item "no") '(item "ignore")) + (widget-insert " Ticked: ") + (mairix-widget-add "flagged" + 'menu-choice + :value "ignore" + '(item "yes") '(item "no") '(item "ignore"))) + (when (member 'threads mairix-widget-other) + (widget-insert "\n") + (mairix-widget-add "Threads" 'checkbox nil)) + (widget-insert " Show full threads\n\n")) (defun mairix-widget-build-editable-fields (values) "Build editable field widgets in `nnmairix-widget-fields-list'. @@ -703,7 +688,7 @@ VALUES may contain values for editable fields from current article." (concat "c" field) (widget-create 'checkbox :tag field - :notify (lambda (widget &rest ignore) + :notify (lambda (widget &rest _ignore) (mairix-widget-toggle-activate widget)) nil))) (list @@ -727,7 +712,7 @@ VALUES may contain values for editable fields from current article." "Add a widget NAME with optional ARGS." (push (list name - (apply 'widget-create args)) + (apply #'widget-create args)) mairix-widgets)) (defun mairix-widget-toggle-activate (widget) diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 3b120be61f5..ea96012af20 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -34,7 +34,6 @@ ;; ====================================================================== ;;; Code: -(require 'derived) (require 'xml) (require 'url-parse) (require 'iso8601) diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el index 44d2fd666ad..21d47b838f5 100644 --- a/lisp/net/newst-plainview.el +++ b/lisp/net/newst-plainview.el @@ -34,7 +34,6 @@ (require 'newst-ticker) (require 'newst-reader) -(require 'derived) (require 'xml) ;; Silence warnings diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 22348a1725c..58cc8b1be55 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -178,13 +178,11 @@ If nil, no maximum is applied." :type '(choice (const :tag "No maximum" nil) (integer :tag "Number of characters"))) -(defvar rcirc-ignore-buffer-activity-flag nil +(defvar-local rcirc-ignore-buffer-activity-flag nil "If non-nil, ignore activity in this buffer.") -(make-variable-buffer-local 'rcirc-ignore-buffer-activity-flag) -(defvar rcirc-low-priority-flag nil +(defvar-local rcirc-low-priority-flag nil "If non-nil, activity in this buffer is considered low priority.") -(make-variable-buffer-local 'rcirc-low-priority-flag) (defcustom rcirc-omit-responses '("JOIN" "PART" "QUIT" "NICK") @@ -1328,8 +1326,7 @@ Create the buffer if it doesn't exist." (rcirc-send-string process (concat command " :" args))))))) -(defvar rcirc-parent-buffer nil) -(make-variable-buffer-local 'rcirc-parent-buffer) +(defvar-local rcirc-parent-buffer nil) (put 'rcirc-parent-buffer 'permanent-local t) (defvar rcirc-window-configuration nil) (defun rcirc-edit-multiline () @@ -1501,10 +1498,8 @@ is found by looking up RESPONSE in `rcirc-response-formats'." ((or (rcirc-get-buffer process target) (rcirc-any-buffer process)))))) -(defvar rcirc-activity-types nil) -(make-variable-buffer-local 'rcirc-activity-types) -(defvar rcirc-last-sender nil) -(make-variable-buffer-local 'rcirc-last-sender) +(defvar-local rcirc-activity-types nil) +(defvar-local rcirc-last-sender nil) (defcustom rcirc-omit-threshold 100 "Lines since last activity from a nick before `rcirc-omit-responses' are omitted." diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el index 983e6d92ee0..ae878ef3a51 100644 --- a/lisp/net/snmp-mode.el +++ b/lisp/net/snmp-mode.el @@ -1,4 +1,4 @@ -;;; snmp-mode.el --- SNMP & SNMPv2 MIB major mode +;;; snmp-mode.el --- SNMP & SNMPv2 MIB major mode -*- lexical-binding: t -*- ;; Copyright (C) 1995, 1998, 2001-2021 Free Software Foundation, Inc. @@ -69,16 +69,6 @@ ;; Once the template is done, you can use C-cC-f and C-cC-b to move back ;; and forth between the Tempo sequence points to fill in the rest of ;; the information. -;; -;; Font Lock -;; ------------ -;; -;; If you want font-lock in your MIB buffers, add this: -;; -;; (add-hook 'snmp-common-mode-hook 'turn-on-font-lock) -;; -;; Enabling global-font-lock-mode is also sufficient. -;; ;;; Code: @@ -101,42 +91,35 @@ (defcustom snmp-special-indent t "If non-nil, use a simple heuristic to try to guess the right indentation. If nil, then no special indentation is attempted." - :type 'boolean - :group 'snmp) + :type 'boolean) (defcustom snmp-indent-level 4 "Indentation level for SNMP MIBs." - :type 'integer - :group 'snmp) + :type 'integer) (defcustom snmp-tab-always-indent nil "Non-nil means TAB should always reindent the current line. A value of nil means reindent if point is within the initial line indentation; otherwise insert a TAB." - :type 'boolean - :group 'snmp) + :type 'boolean) (defcustom snmp-completion-ignore-case t "Non-nil means that case differences are ignored during completion. A value of nil means that case is significant. This is used during Tempo template completion." - :type 'boolean - :group 'snmp) + :type 'boolean) (defcustom snmp-common-mode-hook nil "Hook(s) evaluated when a buffer enters either SNMP or SNMPv2 mode." - :type 'hook - :group 'snmp) + :type 'hook) (defcustom snmp-mode-hook nil "Hook(s) evaluated when a buffer enters SNMP mode." - :type 'hook - :group 'snmp) + :type 'hook) (defcustom snmpv2-mode-hook nil "Hook(s) evaluated when a buffer enters SNMPv2 mode." - :type 'hook - :group 'snmp) + :type 'hook) (defvar snmp-tempo-tags nil "Tempo tags for SNMP mode.") @@ -291,7 +274,7 @@ This is used during Tempo template completion." ;; Set up the stuff that's common between snmp-mode and snmpv2-mode ;; -(defun snmp-common-mode (name mode abbrev font-keywords imenu-index tempo-tags) +(defun snmp-common-mode (name mode abbrev font-keywords imenu-index mode-tempo-tags) (kill-all-local-variables) ;; Become the current major mode @@ -326,7 +309,7 @@ This is used during Tempo template completion." (setq-local imenu-create-index-function imenu-index) ;; Tempo - (tempo-use-tag-list tempo-tags) + (tempo-use-tag-list mode-tempo-tags) (setq-local tempo-match-finder "\\b\\(.+\\)\\=") (setq-local tempo-interactive t) @@ -338,6 +321,7 @@ This is used during Tempo template completion." ;; ;;;###autoload (defun snmp-mode () + ;; FIXME: Use define-derived-mode. "Major mode for editing SNMP MIBs. Expression and list commands understand all C brackets. Tab indents for C code. @@ -370,6 +354,7 @@ Turning on snmp-mode runs the hooks in `snmp-common-mode-hook', then ;;;###autoload (defun snmpv2-mode () + ;; FIXME: Use define-derived-mode. "Major mode for editing SNMPv2 MIBs. Expression and list commands understand all C brackets. Tab indents for C code. @@ -474,13 +459,11 @@ lines for the purposes of this function." (index-table-alist '()) (index-trap-alist '()) (case-fold-search nil) ; keywords must be uppercase - prev-pos token end) + token end) (goto-char (point-min)) - (imenu-progress-message prev-pos 0) ;; Search for a useful MIB item (that's not in a comment) (save-match-data (while (re-search-forward snmp-clause-regexp nil t) - (imenu-progress-message prev-pos) (setq end (match-end 0) token (cons (match-string 1) @@ -498,7 +481,6 @@ lines for the purposes of this function." (push token index-tc-alist))) (goto-char end))) ;; Create the menu - (imenu-progress-message prev-pos 100) (setq index-alist (nreverse index-alist)) (and index-tc-alist (push (cons "Textual Conventions" (nreverse index-tc-alist)) diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el index 604e35c07cf..9d4e440719d 100644 --- a/lisp/net/soap-inspect.el +++ b/lisp/net/soap-inspect.el @@ -206,17 +206,13 @@ This is a specialization of `soap-sample-value' for ;;; soap-inspect -(defvar soap-inspect-previous-items nil +(defvar-local soap-inspect-previous-items nil "A stack of previously inspected items in the *soap-inspect* buffer. Used to implement the BACK button.") -(defvar soap-inspect-current-item nil +(defvar-local soap-inspect-current-item nil "The current item being inspected in the *soap-inspect* buffer.") -(progn - (make-variable-buffer-local 'soap-inspect-previous-items) - (make-variable-buffer-local 'soap-inspect-current-item)) - (defun soap-inspect (element) "Inspect a SOAP ELEMENT in the *soap-inspect* buffer. The buffer is populated with information about ELEMENT with links diff --git a/lisp/net/telnet.el b/lisp/net/telnet.el index 67f844428a7..44f535f01c9 100644 --- a/lisp/net/telnet.el +++ b/lisp/net/telnet.el @@ -72,15 +72,12 @@ LOGIN-NAME, which is optional, says what to log in as on that machine.") (defvar telnet-prompt-pattern "^[^#$%>\n]*[#$%>] *") (defvar telnet-replace-c-g nil) -(make-variable-buffer-local - (defvar telnet-remote-echoes t - "True if the telnet process will echo input.")) -(make-variable-buffer-local - (defvar telnet-interrupt-string "\C-c" "String sent by C-c.")) +(defvar-local telnet-remote-echoes t + "True if the telnet process will echo input.") +(defvar-local telnet-interrupt-string "\C-c" "String sent by C-c.") -(defvar telnet-count 0 +(defvar-local telnet-count 0 "Number of output strings from telnet process while looking for password.") -(make-variable-buffer-local 'telnet-count) (defvar telnet-program "telnet" "Program to run to open a telnet connection.") diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 73dffe1d64f..6ec4d1fed38 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -197,13 +197,13 @@ It is used for TCP/IP devices." tramp-adb-method))) ;;;###tramp-autoload -(defun tramp-adb-file-name-handler (operation &rest arguments) +(defun tramp-adb-file-name-handler (operation &rest args) "Invoke the ADB handler for OPERATION. First arg specifies the OPERATION, second arg is a list of -ARGUMENTS to pass to the OPERATION." +arguments to pass to the OPERATION." (if-let ((fn (assoc operation tramp-adb-file-name-handler-alist))) - (save-match-data (apply (cdr fn) arguments)) - (tramp-run-real-handler operation arguments))) + (save-match-data (apply (cdr fn) args)) + (tramp-run-real-handler operation args))) ;;;###tramp-autoload (tramp--with-startup @@ -305,9 +305,7 @@ ARGUMENTS to pass to the OPERATION." (directory &optional full match nosort id-format count) "Like `directory-files-and-attributes' for Tramp files." (unless (file-exists-p directory) - (tramp-error - (tramp-dissect-file-name directory) tramp-file-missing - "No such file or directory" directory)) + (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) (when (file-directory-p directory) (with-parsed-tramp-file-name (expand-file-name directory) nil (copy-tree @@ -435,7 +433,7 @@ Emacs dired can't find files." (setq dir (expand-file-name dir)) (with-parsed-tramp-file-name dir nil (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists "Directory already exists %s" dir)) + (tramp-error v 'file-already-exists dir)) (when parents (let ((par (expand-file-name ".." dir))) (unless (file-directory-p par) @@ -498,9 +496,7 @@ Emacs dired can't find files." "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name filename nil (unless (file-exists-p (file-truename filename)) - (tramp-error - v tramp-file-missing - "Cannot make local copy of non-existing file `%s'" filename)) + (tramp-compat-file-missing v filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) (with-tramp-progress-reporter v 3 (format "Fetching %s to tmp file %s" filename tmpfile) @@ -642,9 +638,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (jka-compr-inhibit t)) (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "Copying file" "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) @@ -726,9 +720,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (jka-compr-inhibit t)) (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "Renaming file" "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 87e5378e807..27461e6917c 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -41,6 +41,7 @@ (require 'shell) (require 'subr-x) +(declare-function tramp-error "tramp") ;; `temporary-file-directory' as function is introduced with Emacs 26.1. (declare-function tramp-handle-temporary-file-directory "tramp") (declare-function tramp-tramp-file-p "tramp") @@ -178,6 +179,12 @@ This is a string of ten letters or dashes as in ls -l." (if (get 'file-missing 'error-conditions) 'file-missing 'file-error) "The error symbol for the `file-missing' error.") +(defsubst tramp-compat-file-missing (vec file) + "Emit the `file-missing' error." + (if (get 'file-missing 'error-conditions) + (tramp-error vec tramp-file-missing file) + (tramp-error vec tramp-file-missing "No such file or directory: %s" file))) + ;; `file-local-name', `file-name-quoted-p', `file-name-quote' and ;; `file-name-unquote' are introduced in Emacs 26.1. (defalias 'tramp-compat-file-local-name diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index dfe54623dbc..f8de7085e25 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -249,7 +249,7 @@ arguments to pass to the OPERATION." ;;;###tramp-autoload (defun tramp-crypt-file-name-handler (operation &rest args) "Invoke the crypted remote file related OPERATION. -First arg specifies the OPERATION, second arg ARGS is a list of +First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." (if-let ((filename (apply #'tramp-crypt-file-name-for-operation operation args)) @@ -568,9 +568,7 @@ absolute file names." (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "%s file" msg-operation "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) @@ -672,9 +670,7 @@ absolute file names." (directory &optional full match nosort count) "Like `directory-files' for Tramp files." (unless (file-exists-p directory) - (tramp-error - (tramp-dissect-file-name directory) tramp-file-missing - "No such file or directory" directory)) + (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) (when (file-directory-p directory) (setq directory (file-name-as-directory (expand-file-name directory))) (let* (tramp-crypt-enabled @@ -781,7 +777,7 @@ WILDCARD is not supported." "Like `make-directory' for Tramp files." (with-parsed-tramp-file-name (expand-file-name dir) nil (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists "Directory already exists %s" dir)) + (tramp-error v 'file-already-exists dir)) (let (tramp-crypt-enabled) (make-directory (tramp-crypt-encrypt-file-name dir) parents)) ;; When PARENTS is non-nil, DIR could be a chain of non-existent diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index f882636a8fc..e946d73e66c 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -841,8 +841,8 @@ Operations not mentioned here will be handled by the default Emacs primitives.") ;;;###tramp-autoload (defun tramp-gvfs-file-name-handler (operation &rest args) "Invoke the GVFS related OPERATION and ARGS. -First arg specifies the OPERATION, second arg is a list of arguments to -pass to the OPERATION." +First arg specifies the OPERATION, second arg is a list of +arguments to pass to the OPERATION." (unless tramp-gvfs-enabled (tramp-user-error nil "Package `tramp-gvfs' not supported")) (if-let ((fn (assoc operation tramp-gvfs-file-name-handler-alist))) @@ -945,7 +945,7 @@ is no information where to trace the message.") "Called when a D-Bus error message arrives, see `dbus-event-error-functions'." (when tramp-gvfs-dbus-event-vector (tramp-message tramp-gvfs-dbus-event-vector 6 "%S" event) - (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err)))) + (tramp-error tramp-gvfs-dbus-event-vector 'file-error (cadr err)))) (add-hook 'dbus-event-error-functions #'tramp-gvfs-dbus-event-error) (add-hook 'tramp-gvfs-unload-hook @@ -985,83 +985,97 @@ file names." (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) (equal-remote (tramp-equal-remote filename newname)) + (volatile + (and (eq op 'rename) (tramp-gvfs-file-name-p filename) + (equal + (cdr + (assoc + "standard::is-volatile" + (tramp-gvfs-get-file-attributes filename))) + "TRUE"))) ;; "gvfs-rename" is not trustworthy. (gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move")) (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "%s file" msg-operation "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) - (if (or (and equal-remote - (tramp-get-connection-property v "direct-copy-failed" nil)) - (and t1 (not (tramp-gvfs-file-name-p filename))) - (and t2 (not (tramp-gvfs-file-name-p newname)))) - - ;; We cannot copy or rename directly. - (let ((tmpfile (tramp-compat-make-temp-file filename))) - (if (eq op 'copy) - (copy-file - filename tmpfile t keep-date preserve-uid-gid - preserve-extended-attributes) - (rename-file filename tmpfile t)) - (rename-file tmpfile newname ok-if-already-exists)) - - ;; Direct action. - (with-tramp-progress-reporter - v 0 (format "%s %s to %s" msg-operation filename newname) - (unless - (and (apply - #'tramp-gvfs-send-command v gvfs-operation - (append - (and (eq op 'copy) (or keep-date preserve-uid-gid) - '("--preserve")) - (list - (tramp-gvfs-url-file-name filename) - (tramp-gvfs-url-file-name newname)))) - ;; Some backends do not return a proper error - ;; code in case of direct copy/move. Apply sanity checks. - (or (not equal-remote) - (tramp-gvfs-send-command - v "gvfs-info" (tramp-gvfs-url-file-name newname)) - (eq op 'copy) - (not (tramp-gvfs-send-command - v "gvfs-info" - (tramp-gvfs-url-file-name filename))))) - - (if (or (not equal-remote) - (and equal-remote - (tramp-get-connection-property - v "direct-copy-failed" nil))) - ;; Propagate the error. - (with-current-buffer (tramp-get-connection-buffer v) - (goto-char (point-min)) - (tramp-error-with-buffer - nil v 'file-error - "%s failed, see buffer `%s' for details." - msg-operation (buffer-name))) - - ;; Some WebDAV server, like the one from QNAP, do not - ;; support direct copy/move. Try a fallback. - (tramp-set-connection-property v "direct-copy-failed" t) - (tramp-gvfs-do-copy-or-rename-file - op filename newname ok-if-already-exists keep-date - preserve-uid-gid preserve-extended-attributes)))) - - (when (and t1 (eq op 'rename)) - (with-parsed-tramp-file-name filename nil - (tramp-flush-file-properties v localname))) - - (when t2 - (with-parsed-tramp-file-name newname nil - (tramp-flush-file-properties v localname)))))))) + (cond + ;; We cannot rename volatile files, as used by Google-drive. + ((and (not equal-remote) volatile) + (prog1 (copy-file + filename newname ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes) + (delete-file filename))) + + ;; We cannot copy or rename directly. + ((or (and equal-remote + (tramp-get-connection-property v "direct-copy-failed" nil)) + (and t1 (not (tramp-gvfs-file-name-p filename))) + (and t2 (not (tramp-gvfs-file-name-p newname)))) + (let ((tmpfile (tramp-compat-make-temp-file filename))) + (if (eq op 'copy) + (copy-file + filename tmpfile t keep-date preserve-uid-gid + preserve-extended-attributes) + (rename-file filename tmpfile t)) + (rename-file tmpfile newname ok-if-already-exists))) + + ;; Direct action. + (t (with-tramp-progress-reporter + v 0 (format "%s %s to %s" msg-operation filename newname) + (unless + (and (apply + #'tramp-gvfs-send-command v gvfs-operation + (append + (and (eq op 'copy) (or keep-date preserve-uid-gid) + '("--preserve")) + (list + (tramp-gvfs-url-file-name filename) + (tramp-gvfs-url-file-name newname)))) + ;; Some backends do not return a proper error + ;; code in case of direct copy/move. Apply + ;; sanity checks. + (or (not equal-remote) + (tramp-gvfs-send-command + v "gvfs-info" (tramp-gvfs-url-file-name newname)) + (eq op 'copy) + (not (tramp-gvfs-send-command + v "gvfs-info" + (tramp-gvfs-url-file-name filename))))) + + (if (or (not equal-remote) + (and equal-remote + (tramp-get-connection-property + v "direct-copy-failed" nil))) + ;; Propagate the error. + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (tramp-error-with-buffer + nil v 'file-error + "%s failed, see buffer `%s' for details." + msg-operation (buffer-name))) + + ;; Some WebDAV server, like the one from QNAP, do + ;; not support direct copy/move. Try a fallback. + (tramp-set-connection-property v "direct-copy-failed" t) + (tramp-gvfs-do-copy-or-rename-file + op filename newname ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes)))) + + (when (and t1 (eq op 'rename)) + (with-parsed-tramp-file-name filename nil + (tramp-flush-file-properties v localname))) + + (when t2 + (with-parsed-tramp-file-name newname nil + (tramp-flush-file-properties v localname))))))))) (defun tramp-gvfs-handle-copy-file (filename newname &optional ok-if-already-exists keep-date @@ -1545,7 +1559,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (setq dir (directory-file-name (expand-file-name dir))) (with-parsed-tramp-file-name dir nil (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists "Directory already exists %s" dir)) + (tramp-error v 'file-already-exists dir)) (tramp-flush-directory-properties v localname) (save-match-data (let ((ldir (file-name-directory dir))) @@ -1575,20 +1589,31 @@ If FILE-SYSTEM is non-nil, return file system attributes." (tramp-run-real-handler #'rename-file (list filename newname ok-if-already-exists)))) +(defun tramp-gvfs-set-attribute (vec &rest args) + "Call \"gio set ...\" if possible." + (let ((key (concat "gvfs-set-attribute-" (nth 3 args)))) + (when (tramp-get-connection-property vec key t) + (or (apply #'tramp-gvfs-send-command vec "gvfs-set-attribute" args) + (with-current-buffer (tramp-get-connection-buffer vec) + (goto-char (point-min)) + (when (looking-at-p "gio: Operation not supported") + (tramp-set-connection-property vec key nil))) + nil)))) + (defun tramp-gvfs-handle-set-file-modes (filename mode &optional flag) "Like `set-file-modes' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) - (tramp-gvfs-send-command - v "gvfs-set-attribute" (if (eq flag 'nofollow) "-nt" "-t") "uint32" + (tramp-gvfs-set-attribute + v (if (eq flag 'nofollow) "-nt" "-t") "uint32" (tramp-gvfs-url-file-name filename) "unix::mode" (number-to-string mode)))) (defun tramp-gvfs-handle-set-file-times (filename &optional time flag) "Like `set-file-times' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) - (tramp-gvfs-send-command - v "gvfs-set-attribute" (if (eq flag 'nofollow) "-nt" "-t") "uint64" + (tramp-gvfs-set-attribute + v (if (eq flag 'nofollow) "-nt" "-t") "uint64" (tramp-gvfs-url-file-name filename) "time::modified" (format-time-string "%s" (if (or (null time) @@ -1622,12 +1647,12 @@ ID-FORMAT valid values are `string' and `integer'." (with-parsed-tramp-file-name filename nil (tramp-flush-file-properties v localname) (when (natnump uid) - (tramp-gvfs-send-command - v "gvfs-set-attribute" "-t" "uint32" + (tramp-gvfs-set-attribute + v "-t" "uint32" (tramp-gvfs-url-file-name filename) "unix::uid" (number-to-string uid))) (when (natnump gid) - (tramp-gvfs-send-command - v "gvfs-set-attribute" "-t" "uint32" + (tramp-gvfs-set-attribute + v "-t" "uint32" (tramp-gvfs-url-file-name filename) "unix::gid" (number-to-string gid))))) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 8638bb477f8..96f7d9a89b9 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -157,8 +157,8 @@ Operations not mentioned here will be handled by the default Emacs primitives.") ;;;###tramp-autoload (defun tramp-rclone-file-name-handler (operation &rest args) "Invoke the rclone handler for OPERATION and ARGS. -First arg specifies the OPERATION, second arg is a list of arguments to -pass to the OPERATION." +First arg specifies the OPERATION, second arg is a list of +arguments to pass to the OPERATION." (if-let ((fn (assoc operation tramp-rclone-file-name-handler-alist))) (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args))) @@ -215,9 +215,7 @@ file names." (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "%s file" msg-operation "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) @@ -304,9 +302,7 @@ file names." (directory &optional full match nosort count) "Like `directory-files' for Tramp files." (unless (file-exists-p directory) - (tramp-error - (tramp-dissect-file-name directory) tramp-file-missing - "No such file or directory" directory)) + (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) (when (file-directory-p directory) (setq directory (file-name-as-directory (expand-file-name directory))) (with-parsed-tramp-file-name directory nil diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 2274efdf8b5..bcdc014daba 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1094,7 +1094,8 @@ component is used as the target of the symlink." (unless ln (tramp-error v 'file-error - "Making a symbolic link. ln(1) does not exist on the remote host.")) + (concat "Making a symbolic link. " + "ln(1) does not exist on the remote host."))) ;; Do the 'confirm if exists' thing. (when (file-exists-p linkname) @@ -1724,9 +1725,8 @@ ID-FORMAT valid values are `string' and `integer'." "Like `directory-files-and-attributes' for Tramp files." (unless id-format (setq id-format 'integer)) (unless (file-exists-p directory) - (tramp-error - (tramp-dissect-file-name directory) tramp-file-missing - "No such file or directory" directory)) + (tramp-compat-file-missing + (tramp-dissect-file-name directory) directory)) (when (file-directory-p directory) (setq directory (expand-file-name directory)) (let* ((temp @@ -1877,8 +1877,9 @@ ID-FORMAT valid values are `string' and `integer'." ;; side. (unless (looking-at-p "^ok$") (tramp-error - v 'file-error "\ -tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" + v 'file-error + (concat "tramp-sh-handle-file-name-all-completions: " + "internal error accessing `%s': `%s'") (tramp-shell-quote-argument localname) (buffer-string)))) (while (zerop (forward-line -1)) @@ -1944,9 +1945,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (t2 (tramp-tramp-file-p newname))) (with-parsed-tramp-file-name (if t1 dirname newname) nil (unless (file-exists-p dirname) - (tramp-error - v tramp-file-missing - "Copying directory" "No such file or directory" dirname)) + (tramp-compat-file-missing v dirname)) (if (and (not copy-contents) (tramp-get-method-parameter v 'tramp-copy-recursive) ;; When DIRNAME and NEWNAME are remote, they must have @@ -2032,12 +2031,12 @@ file names." (length (tramp-compat-file-attribute-size (file-attributes (file-truename filename)))) (attributes (and preserve-extended-attributes - (apply #'file-extended-attributes (list filename))))) + (apply #'file-extended-attributes (list filename)))) + (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) @@ -2045,9 +2044,7 @@ file names." (tramp-error v 'file-error "File is a directory %s" newname)) (with-tramp-progress-reporter - v 0 (format "%s %s to %s" - (if (eq op 'copy) "Copying" "Renaming") - filename newname) + v 0 (format "%s %s to %s" msg-operation filename newname) (cond ;; Both are Tramp files. @@ -2536,7 +2533,7 @@ The method used must be an out-of-band method." (setq dir (expand-file-name dir)) (with-parsed-tramp-file-name dir nil (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists "Directory already exists %s" dir)) + (tramp-error v 'file-already-exists dir)) ;; When PARENTS is non-nil, DIR could be a chain of non-existent ;; directories a/b/c/... Instead of checking, we simply flush the ;; whole cache. @@ -3278,9 +3275,7 @@ alternative implementation will be used." "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name filename nil (unless (file-exists-p (file-truename filename)) - (tramp-error - v tramp-file-missing - "Cannot make local copy of non-existing file `%s'" filename)) + (tramp-compat-file-missing v filename)) (let* ((size (tramp-compat-file-attribute-size (file-attributes (file-truename filename)))) @@ -3969,7 +3964,7 @@ Fall back to normal file name handler if no Tramp handler exists." "[[:blank:]]+\\([^[:blank:]]+\\)" "\\([[:blank:]]+\\([^\n\r]+\\)\\)?") line) - (tramp-error proc 'file-notify-error "%s" line)) + (tramp-error proc 'file-notify-error line)) (let ((object (list diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index c5a74a5c653..26ec910ecc8 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -342,8 +342,8 @@ This can be used to disable echo etc." ;;;###tramp-autoload (defun tramp-smb-file-name-handler (operation &rest args) "Invoke the SMB related OPERATION and ARGS. -First arg specifies the OPERATION, second arg is a list of arguments to -pass to the OPERATION." +First arg specifies the OPERATION, second arg is a list of +arguments to pass to the OPERATION." (if-let ((fn (assoc operation tramp-smb-file-name-handler-alist))) (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args))) @@ -430,9 +430,7 @@ pass to the OPERATION." (with-tramp-progress-reporter v 0 (format "Copying %s to %s" dirname newname) (unless (file-exists-p dirname) - (tramp-error - v tramp-file-missing - "Copying directory" "No such file or directory" dirname)) + (tramp-compat-file-missing v dirname)) (when (and (file-directory-p newname) (not (directory-name-p newname))) (tramp-error v 'file-already-exists newname)) @@ -588,11 +586,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (copy-directory filename newname keep-date 'parents 'copy-contents) (unless (file-exists-p filename) - (tramp-error + (tramp-compat-file-missing (tramp-dissect-file-name (if (tramp-tramp-file-p filename) filename newname)) - tramp-file-missing - "Copying file" "No such file or directory" filename)) + filename)) (if-let ((tmpfile (file-local-copy filename))) ;; Remote filename. @@ -693,9 +690,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (directory &optional full match nosort count) "Like `directory-files' for Tramp files." (unless (file-exists-p directory) - (tramp-error - (tramp-dissect-file-name directory) tramp-file-missing - "No such file or directory" directory)) + (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) (let ((result (mapcar #'directory-file-name (file-name-all-completions "" directory)))) ;; Discriminate with regexp. @@ -962,9 +957,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name (file-truename filename) nil (unless (file-exists-p (file-truename filename)) - (tramp-error - v tramp-file-missing - "Cannot make local copy of non-existing file `%s'" filename)) + (tramp-compat-file-missing v filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) (with-tramp-progress-reporter v 3 (format "Fetching %s to tmp file %s" filename tmpfile) @@ -1153,12 +1146,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; of `default-directory'. (let ((start (point))) (insert - (format - "%s" - (file-relative-name - (expand-file-name - (nth 0 x) (file-name-directory filename)) - (when full-directory-p (file-name-directory filename))))) + (file-relative-name + (expand-file-name + (nth 0 x) (file-name-directory filename)) + (when full-directory-p (file-name-directory filename)))) (put-text-property start (point) 'dired-filename t)) ;; Insert symlink. @@ -1177,7 +1168,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq dir (expand-file-name dir default-directory))) (with-parsed-tramp-file-name dir nil (when (and (null parents) (file-exists-p dir)) - (tramp-error v 'file-already-exists "Directory already exists %s" dir)) + (tramp-error v 'file-already-exists dir)) (let* ((ldir (file-name-directory dir))) ;; Make missing directory parts. (when (and parents @@ -1386,9 +1377,7 @@ component is used as the target of the symlink." (with-parsed-tramp-file-name (if (tramp-tramp-file-p filename) filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "Renaming file" "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) @@ -2010,10 +1999,8 @@ If ARGUMENT is non-nil, use it as argument for (when port (setq args (append args (list "-p" port)))) (when tramp-smb-conf (setq args (append args (list "-s" tramp-smb-conf)))) - (while options - (setq args - (append args `("--option" ,(format "%s" (car options)))) - options (cdr options))) + (dolist (option options) + (setq args (append args (list "--option" option)))) (when argument (setq args (append args (list argument)))) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 5bb1546d08b..0a60b791822 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -153,8 +153,8 @@ See `tramp-actions-before-shell' for more info.") ;;;###tramp-autoload (defun tramp-sudoedit-file-name-handler (operation &rest args) "Invoke the SUDOEDIT handler for OPERATION and ARGS. -First arg specifies the OPERATION, second arg is a list of arguments to -pass to the OPERATION." +First arg specifies the OPERATION, second arg is a list of +arguments to pass to the OPERATION." (if-let ((fn (assoc operation tramp-sudoedit-file-name-handler-alist))) (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args))) @@ -243,9 +243,7 @@ absolute file names." (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "%s file" msg-operation "No such file or directory" filename)) + (tramp-compat-file-missing v filename)) (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7b34a748822..690dd99ae55 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2001,7 +2001,7 @@ the resulting error message." (unless (eq error-symbol 'void-variable) (tramp-error (car tramp-current-connection) error-symbol - "%s" (mapconcat (lambda (x) (format "%s" x)) data " ")))) + (mapconcat (lambda (x) (format "%s" x)) data " ")))) (put #'tramp-signal-hook-function 'tramp-suppress-trace t) @@ -3058,9 +3058,9 @@ User is always nil." (defun tramp-handle-access-file (filename string) "Like `access-file' for Tramp files." (unless (file-readable-p (file-truename filename)) - (tramp-error - (tramp-dissect-file-name filename) tramp-file-missing - "%s: No such file or directory %s" string filename))) + (tramp-compat-file-missing + (tramp-dissect-file-name filename) + (format "%s: %s" string filename)))) (defun tramp-handle-add-name-to-file (filename newname &optional ok-if-already-exists) @@ -3094,9 +3094,7 @@ User is always nil." ;; `copy-directory' creates NEWNAME before running this check. So ;; we do it ourselves. (unless (file-exists-p directory) - (tramp-error - (tramp-dissect-file-name directory) tramp-file-missing - "No such file or directory" directory)) + (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) ;; We must do it file-wise. (tramp-run-real-handler 'copy-directory @@ -3117,9 +3115,7 @@ User is always nil." (defun tramp-handle-directory-files (directory &optional full match nosort count) "Like `directory-files' for Tramp files." (unless (file-exists-p directory) - (tramp-error - (tramp-dissect-file-name directory) tramp-file-missing - "No such file or directory" directory)) + (tramp-compat-file-missing (tramp-dissect-file-name directory) directory)) (when (file-directory-p directory) (setq directory (file-name-as-directory (expand-file-name directory))) (let ((temp (nreverse (file-name-all-completions "" directory))) @@ -3216,9 +3212,7 @@ User is always nil." "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name filename nil (unless (file-exists-p filename) - (tramp-error - v tramp-file-missing - "Cannot make local copy of non-existing file `%s'" filename)) + (tramp-compat-file-missing v filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) (copy-file filename tmpfile 'ok-if-already-exists 'keep-time) tmpfile))) @@ -3428,8 +3422,10 @@ User is always nil." (if (stringp symlink-target) (if (file-remote-p symlink-target) (tramp-compat-file-name-quote symlink-target 'top) - (expand-file-name - symlink-target (file-name-directory v2-localname))) + (tramp-drop-volume-letter + (expand-file-name + symlink-target + (file-name-directory v2-localname)))) v2-localname) 'nohop))) (when (>= numchase numchase-limit) @@ -3511,9 +3507,7 @@ User is always nil." (with-parsed-tramp-file-name filename nil (unwind-protect (if (not (file-exists-p filename)) - (tramp-error - v tramp-file-missing - "File `%s' not found on remote host" filename) + (tramp-compat-file-missing v filename) (with-tramp-progress-reporter v 3 (format-message "Inserting `%s'" filename) @@ -3636,8 +3630,7 @@ User is always nil." v 'file-error "File `%s' does not include a `.el' or `.elc' suffix" file))) (unless (or noerror (file-exists-p file)) - (tramp-error - v tramp-file-missing "Cannot load nonexistent file `%s'" file)) + (tramp-compat-file-missing v file)) (if (not (file-exists-p file)) nil (let ((signal-hook-function (unless noerror signal-hook-function)) diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el index dcbd7ed1dd7..45a69a73f35 100644 --- a/lisp/nxml/rng-cmpct.el +++ b/lisp/nxml/rng-cmpct.el @@ -123,8 +123,7 @@ Return a pattern." (set-buffer-multibyte t) (set-syntax-table rng-c-syntax-table)) -(defvar rng-c-current-token nil) -(make-variable-buffer-local 'rng-c-current-token) +(defvar-local rng-c-current-token nil) (defun rng-c-advance () (cond ((looking-at rng-c-token-re) @@ -334,11 +333,9 @@ OVERRIDE is either nil, require or t." ;;; Parsing -(defvar rng-c-escape-positions nil) -(make-variable-buffer-local 'rng-c-escape-positions) +(defvar-local rng-c-escape-positions nil) -(defvar rng-c-file-name nil) -(make-variable-buffer-local 'rng-c-file-name) +(defvar-local rng-c-file-name nil) (defvar rng-c-file-index nil) diff --git a/lisp/nxml/rng-pttrn.el b/lisp/nxml/rng-pttrn.el index 12ffa578200..034671feeb0 100644 --- a/lisp/nxml/rng-pttrn.el +++ b/lisp/nxml/rng-pttrn.el @@ -66,9 +66,8 @@ (defvar rng-schema-change-hook nil "Hook to be run after `rng-current-schema' changes.") -(defvar rng-current-schema nil +(defvar-local rng-current-schema nil "Pattern to be used as schema for the current buffer.") -(make-variable-buffer-local 'rng-current-schema) (defun rng-make-ref (name) (list 'ref nil name)) diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el index 6ea893404cb..a5eb893c554 100644 --- a/lisp/nxml/rng-valid.el +++ b/lisp/nxml/rng-valid.el @@ -132,36 +132,30 @@ A quick validation validates at most one chunk." ;; Global variables -(defvar rng-validate-timer nil) -(make-variable-buffer-local 'rng-validate-timer) +(defvar-local rng-validate-timer nil) ;; ensure that we can cancel the timer even after a kill-all-local-variables (put 'rng-validate-timer 'permanent-local t) -(defvar rng-validate-quick-timer nil) -(make-variable-buffer-local 'rng-validate-quick-timer) +(defvar-local rng-validate-quick-timer nil) ;; ensure that we can cancel the timer even after a kill-all-local-variables (put 'rng-validate-quick-timer 'permanent-local t) -(defvar rng-error-count nil +(defvar-local rng-error-count nil "Number of errors in the current buffer. Always equal to number of overlays with category `rng-error'.") -(make-variable-buffer-local 'rng-error-count) -(defvar rng-message-overlay nil +(defvar-local rng-message-overlay nil "Overlay in this buffer whose `help-echo' property was last printed. It is nil if none.") -(make-variable-buffer-local 'rng-message-overlay) -(defvar rng-message-overlay-inhibit-point nil +(defvar-local rng-message-overlay-inhibit-point nil "Position at which message from overlay should be inhibited. If point is equal to this and the error overlay around point is `rng-message-overlay', then the `help-echo' property of the error overlay should not be printed with `message'.") -(make-variable-buffer-local 'rng-message-overlay-inhibit-point) -(defvar rng-message-overlay-current nil +(defvar-local rng-message-overlay-current nil "Non-nil if `rng-message-overlay' is still the current message.") -(make-variable-buffer-local 'rng-message-overlay-current) (defvar rng-open-elements nil "Stack of names of open elements represented as a list. @@ -178,11 +172,10 @@ indicating an unresolvable entity or character reference.") (defvar rng-collecting-text nil) -(defvar rng-validate-up-to-date-end nil +(defvar-local rng-validate-up-to-date-end nil "Last position where validation is known to be up to date.") -(make-variable-buffer-local 'rng-validate-up-to-date-end) -(defvar rng-conditional-up-to-date-start nil +(defvar-local rng-conditional-up-to-date-start nil "Marker for the start of the conditionally up-to-date region. It is nil if there is no conditionally up-to-date region. The conditionally up-to-date region must be such that for any cached @@ -191,20 +184,17 @@ if at some point it is determined that S becomes correct for P, then all states with position >= P in the conditionally up to date region must also then be correct and all errors between P and the end of the region must then be correctly marked.") -(make-variable-buffer-local 'rng-conditional-up-to-date-start) -(defvar rng-conditional-up-to-date-end nil +(defvar-local rng-conditional-up-to-date-end nil "Marker for the end of the conditionally up-to-date region. It is nil if there is no conditionally up-to-date region. See the variable `rng-conditional-up-to-date-start'.") -(make-variable-buffer-local 'rng-conditional-up-to-date-end) (defvar rng-parsing-for-state nil "Non-nil means we are currently parsing just to compute the state. Should be dynamically bound.") -(defvar rng-dtd nil) -(make-variable-buffer-local 'rng-dtd) +(defvar-local rng-dtd nil) ;;;###autoload (define-minor-mode rng-validate-mode diff --git a/lisp/org/ol-w3m.el b/lisp/org/ol-w3m.el index f1f3afd764d..ebb11ce3d54 100644 --- a/lisp/org/ol-w3m.el +++ b/lisp/org/ol-w3m.el @@ -7,13 +7,13 @@ ;; Homepage: https://orgmode.org ;; ;; This file is part of GNU Emacs. -;; -;; This program is free software: you can redistribute it and/or modify + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. diff --git a/lisp/org/org-refile.el b/lisp/org/org-refile.el index 1e0c339f7b2..8b42f817c1a 100644 --- a/lisp/org/org-refile.el +++ b/lisp/org/org-refile.el @@ -7,18 +7,18 @@ ;; ;; This file is part of GNU Emacs. -;; This program is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index ef4672e1b96..1248efabc15 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -2008,7 +2008,7 @@ toggle `org-table-follow-field-mode'." (let ((b (save-excursion (skip-chars-backward "^|") (point))) (e (save-excursion (skip-chars-forward "^|\r\n") (point)))) (remove-text-properties b e '(invisible t intangible t)) - (if (and (boundp 'font-lock-mode) font-lock-mode) + (if font-lock-mode (font-lock-fontify-block)))) (t (let ((pos (point-marker)) diff --git a/lisp/org/org.el b/lisp/org/org.el index 2d21a44fb48..e6a5cca9391 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -5520,7 +5520,7 @@ highlighting was done, nil otherwise." (defun org-restart-font-lock () "Restart `font-lock-mode', to force refontification." - (when (and (boundp 'font-lock-mode) font-lock-mode) + (when font-lock-mode (font-lock-mode -1) (font-lock-mode 1))) diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 0dd99cec66d..b648ecf0986 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -135,11 +135,8 @@ "A regexp of names to be disregarded during directory completion." :type '(choice regexp (const :tag "None" nil))) -(defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin)) - ;; FIXME: the doc mentions file-name completion, but the code - ;; seems to apply it to all completions. - "If non-nil, ignore case when doing filename completion." - :type 'boolean) +(define-obsolete-variable-alias 'pcomplete-ignore-case 'completion-ignore-case + "28.1") (defcustom pcomplete-autolist nil "If non-nil, automatically list possibilities on partial completion. @@ -330,19 +327,12 @@ modified to be an empty string, or the desired separation string." ;;; Internal Variables: ;; for cycling completion support -(defvar pcomplete-current-completions nil) -(defvar pcomplete-last-completion-length) -(defvar pcomplete-last-completion-stub) -(defvar pcomplete-last-completion-raw) -(defvar pcomplete-last-window-config nil) -(defvar pcomplete-window-restore-timer nil) - -(make-variable-buffer-local 'pcomplete-current-completions) -(make-variable-buffer-local 'pcomplete-last-completion-length) -(make-variable-buffer-local 'pcomplete-last-completion-stub) -(make-variable-buffer-local 'pcomplete-last-completion-raw) -(make-variable-buffer-local 'pcomplete-last-window-config) -(make-variable-buffer-local 'pcomplete-window-restore-timer) +(defvar-local pcomplete-current-completions nil) +(defvar-local pcomplete-last-completion-length nil) +(defvar-local pcomplete-last-completion-stub nil) +(defvar-local pcomplete-last-completion-raw nil) +(defvar-local pcomplete-last-window-config nil) +(defvar-local pcomplete-window-restore-timer nil) ;; used for altering pcomplete's behavior. These global variables ;; should always be nil. @@ -479,7 +469,7 @@ Same as `pcomplete' but using the standard completion UI." (not (member (funcall norm-func (directory-file-name f)) seen))))))) - (when pcomplete-ignore-case + (when completion-ignore-case (setq table (completion-table-case-fold table))) (list beg (point) table :predicate pred @@ -872,7 +862,7 @@ this is `comint-dynamic-complete-functions'." (sort comps pcomplete-compare-entry-function))) ,@(cdr (completion-file-name-table s p a))) (let ((completion-ignored-extensions nil) - (completion-ignore-case pcomplete-ignore-case)) + (completion-ignore-case completion-ignore-case)) (completion-table-with-predicate #'comint-completion-file-name-table pred 'strict s p a)))))) @@ -1123,7 +1113,7 @@ Typing SPC flushes the help buffer." "Insert a completion entry at point. Returns non-nil if a space was appended at the end." (let ((here (point))) - (if (not pcomplete-ignore-case) + (if (not completion-ignore-case) (insert-and-inherit (if raw-p (substring entry (length stub)) (comint-quote-filename @@ -1201,7 +1191,7 @@ Returns `partial' if completed as far as possible with the matches. Returns `listed' if a completion listing was shown. See also `pcomplete-filename'." - (let* ((completion-ignore-case pcomplete-ignore-case) + (let* ((completion-ignore-case completion-ignore-case) (completions (all-completions stub candidates)) (entry (try-completion stub candidates)) result) diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index 07ef30c07d1..891a5f6cbaa 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -1,4 +1,4 @@ -;;; 5x5.el --- simple little puzzle game +;;; 5x5.el --- simple little puzzle game -*- lexical-binding: t -*- ;; Copyright (C) 1999-2021 Free Software Foundation, Inc. @@ -84,23 +84,24 @@ (defmacro 5x5-defvar-local (var value doc) "Define VAR to VALUE with documentation DOC and make it buffer local." + (declare (obsolete defvar-local "28.1")) `(progn (defvar ,var ,value ,doc) (make-variable-buffer-local (quote ,var)))) -(5x5-defvar-local 5x5-grid nil +(defvar-local 5x5-grid nil "5x5 grid contents.") -(5x5-defvar-local 5x5-x-pos 2 +(defvar-local 5x5-x-pos 2 "X position of cursor.") -(5x5-defvar-local 5x5-y-pos 2 +(defvar-local 5x5-y-pos 2 "Y position of cursor.") -(5x5-defvar-local 5x5-moves 0 +(defvar-local 5x5-moves 0 "Moves made.") -(5x5-defvar-local 5x5-cracking nil +(defvar-local 5x5-cracking nil "Are we in cracking mode?") (defvar 5x5-buffer-name "*5x5*" @@ -140,7 +141,7 @@ map) "Local keymap for the 5x5 game.") -(5x5-defvar-local 5x5-solver-output nil +(defvar-local 5x5-solver-output nil "List that is the output of an arithmetic solver. This list L is such that @@ -288,7 +289,7 @@ Quit current game \\[5x5-quit-game]" (defun 5x5-draw-grid-end () "Draw the top/bottom of the grid." (insert "+") - (dotimes (x 5x5-grid-size) + (dotimes (_ 5x5-grid-size) (insert "-" (make-string 5x5-x-scale ?-))) (insert "-+ ")) @@ -296,11 +297,11 @@ Quit current game \\[5x5-quit-game]" "Draw the grids GRIDS into the current buffer." (let ((inhibit-read-only t) grid-org) (erase-buffer) - (dolist (grid grids) (5x5-draw-grid-end)) + (dolist (_ grids) (5x5-draw-grid-end)) (insert "\n") (setq grid-org (point)) (dotimes (y 5x5-grid-size) - (dotimes (lines 5x5-y-scale) + (dotimes (_lines 5x5-y-scale) (dolist (grid grids) (dotimes (x 5x5-grid-size) (insert (if (zerop x) "| " " ") @@ -330,7 +331,7 @@ Quit current game \\[5x5-quit-game]" (forward-char (1+ 5x5-x-scale)))) (forward-line 5x5-y-scale)))) (setq 5x5-solver-output nil))) - (dolist (grid grids) (5x5-draw-grid-end)) + (dolist (_grid grids) (5x5-draw-grid-end)) (insert "\n") (insert (format "On: %d Moves: %d" (5x5-grid-value (car grids)) 5x5-moves)))) @@ -474,11 +475,11 @@ position." "Convert a grid matrix GRID-MATRIX in Calc format to a grid in 5x5 format. See function `5x5-grid-to-vec'." (apply - 'vector + #'vector (mapcar (lambda (x) (apply - 'vector + #'vector (mapcar (lambda (y) (/= (cadr y) 0)) (cdr x)))) @@ -502,7 +503,9 @@ position." Log a matrix VALUE of (mod B 2) forms, only B is output and Scilab matrix notation is used. VALUE is returned so that it is easy to log a value with minimal rewrite of code." - (when (buffer-live-p 5x5-log-buffer) + (when (buffer-live-p 5x5-log-buffer) + (defvar calc-matrix-brackets) + (defvar calc-vector-commas) (let* ((unpacked-value (math-map-vec (lambda (row) (math-map-vec 'cadr row)) @@ -514,7 +517,7 @@ easy to log a value with minimal rewrite of code." (insert name ?= value-to-log ?\n)))) value)) (defsubst 5x5-log-init ()) - (defsubst 5x5-log (name value) value))) + (defsubst 5x5-log (_name value) value))) (declare-function math-map-vec "calc-vec" (f a)) (declare-function math-sub "calc" (a b)) @@ -532,6 +535,10 @@ easy to log a value with minimal rewrite of code." (declare-function calcFunc-mcol "calc-vec" (mat n)) (declare-function calcFunc-vconcat "calc-vec" (a b)) (declare-function calcFunc-index "calc-vec" (n &optional start incr)) +(defvar calc-word-size) +(defvar calc-leading-zeros) +(defvar calc-number-radix) +(defvar calc-command-flags) (defun 5x5-solver (grid) "Return a list of solutions for GRID. @@ -670,16 +677,16 @@ Solutions are sorted from least to greatest Hamming weight." (5x5-log "cb" (math-mul inv-base-change targetv))); CB - (row-1 (math-make-intv 3 1 transferm-kernel-size)) ; 1..2 + ;; (row-1 (math-make-intv 3 1 transferm-kernel-size)) ; 1..2 (row-2 (math-make-intv 1 transferm-kernel-size grid-size-squared)); 3..25 (col-1 (math-make-intv 3 1 (- grid-size-squared transferm-kernel-size))); 1..23 - (col-2 (math-make-intv 1 (- grid-size-squared - transferm-kernel-size) - grid-size-squared)); 24..25 - (ctransferm-1-: (calcFunc-mrow ctransferm row-1)) - (ctransferm-1-1 (calcFunc-mcol ctransferm-1-: col-1)) + ;; (col-2 (math-make-intv 1 (- grid-size-squared + ;; transferm-kernel-size) + ;; grid-size-squared)) ; 24..25 + ;; (ctransferm-1-: (calcFunc-mrow ctransferm row-1)) + ;; (ctransferm-1-1 (calcFunc-mcol ctransferm-1-: col-1)) ;; By construction ctransferm-:-2 = 0, so ctransferm-1-2 = 0 ;; and ctransferm-2-2 = 0. @@ -695,8 +702,8 @@ Solutions are sorted from least to greatest Hamming weight." ;; ;;(ctransferm-2-2 (calcFunc-mcol ctransferm-2-: col-2)) - (ctarget-1 (calcFunc-mrow ctarget row-1)) - (ctarget-2 (calcFunc-mrow ctarget row-2)) + ;; (ctarget-1 (calcFunc-mrow ctarget row-1)) + (ctarget-2 (calcFunc-mrow ctarget row-2)) ;; ctarget-1(2x1) = ctransferm-1-1(2x23) *cx-1(23x1) ;; + ctransferm-1-2(2x2) *cx-2(2x1); @@ -769,7 +776,7 @@ Solutions are sorted from least to greatest Hamming weight." (message "5x5 Solution computation done.") solution-list))) -(defun 5x5-solve-suggest (&optional n) +(defun 5x5-solve-suggest (&optional _n) "Suggest to the user where to click. Argument N is ignored." diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el index e3854b55a14..61b0878b1c5 100644 --- a/lisp/play/blackbox.el +++ b/lisp/play/blackbox.el @@ -1,4 +1,4 @@ -;;; blackbox.el --- blackbox game in Emacs Lisp +;;; blackbox.el --- blackbox game in Emacs Lisp -*- lexical-binding: t -*- ;; Copyright (C) 1985-1987, 1992, 2001-2021 Free Software Foundation, ;; Inc. diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index f317ad51cfc..dc93ef90310 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -82,6 +82,10 @@ ;; Careful with that axe, Eugene! Order does matter in the custom ;; section below. +(defgroup bubbles nil + "Bubbles, a puzzle game." + :group 'games) + (defcustom bubbles-game-theme 'easy "Overall game theme. @@ -91,8 +95,7 @@ and a shift mode." (const :tag "Medium" medium) (const :tag "Difficult" difficult) (const :tag "Hard" hard) - (const :tag "User defined" user-defined)) - :group 'bubbles) + (const :tag "User defined" user-defined))) (defun bubbles-set-game-easy () "Set game theme to `easy'." @@ -124,10 +127,6 @@ and a shift mode." (setq bubbles-game-theme 'user-defined) (bubbles)) -(defgroup bubbles nil - "Bubbles, a puzzle game." - :group 'games) - (defcustom bubbles-graphics-theme 'circles "Graphics theme. diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el index 9cecb706f98..be35daf4da8 100644 --- a/lisp/play/cookie1.el +++ b/lisp/play/cookie1.el @@ -1,4 +1,4 @@ -;;; cookie1.el --- retrieve random phrases from fortune cookie files +;;; cookie1.el --- retrieve random phrases from fortune cookie files -*- lexical-binding: t -*- ;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc. @@ -60,7 +60,6 @@ (defcustom cookie-file nil "Default phrase file for cookie functions." :type '(choice (const nil) file) - :group 'cookie :version "24.4") (defconst cookie-delimiter "\n%%\n\\|\n%\n\\|\0" @@ -178,11 +177,12 @@ Argument REQUIRE-MATCH non-nil forces a matching cookie." "Randomly permute the elements of VECTOR (all permutations equally likely)." (let ((len (length vector)) j temp) - (dotimes (i len vector) + (dotimes (i len) (setq j (+ i (random (- len i))) temp (aref vector i)) (aset vector i (aref vector j)) - (aset vector j temp)))) + (aset vector j temp)) + vector)) (define-obsolete-function-alias 'shuffle-vector 'cookie-shuffle-vector "24.4") @@ -205,9 +205,10 @@ If called interactively, or if DISPLAY is non-nil, display a list of matches." (cookie-table-symbol (intern phrase-file cookie-cache)) (string-table (symbol-value cookie-table-symbol)) (matches nil)) - (and (dotimes (i (length string-table) matches) - (and (string-match-p regexp (aref string-table i)) - (setq matches (cons (aref string-table i) matches)))) + (dotimes (i (length string-table)) + (and (string-match-p regexp (aref string-table i)) + (setq matches (cons (aref string-table i) matches)))) + (and matches (setq matches (sort matches 'string-lessp))) (and display (if matches diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index a7a4b89c372..524ca81f30a 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -99,8 +99,7 @@ "Non-nil means to convert ciphertext to uppercase. nil means the case of the ciphertext is preserved. This variable must be set before typing `\\[decipher]'." - :type 'boolean - :group 'decipher) + :type 'boolean) (defcustom decipher-ignore-spaces nil @@ -108,21 +107,18 @@ This variable must be set before typing `\\[decipher]'." You should set this to nil if the cipher message is divided into words, or t if it is not. This variable is buffer-local." - :type 'boolean - :group 'decipher) + :type 'boolean) (make-variable-buffer-local 'decipher-ignore-spaces) (defcustom decipher-undo-limit 5000 "The maximum number of entries in the undo list. When the undo list exceeds this number, 100 entries are deleted from the tail of the list." - :type 'integer - :group 'decipher) + :type 'integer) (defcustom decipher-mode-hook nil "Hook to run upon entry to decipher." - :type 'hook - :group 'decipher) + :type 'hook) ;; End of user modifiable variables ;;-------------------------------------------------------------------- @@ -184,28 +180,24 @@ the tail of the list." (cl-incf c)) (setq decipher-mode-syntax-table table))) -(defvar decipher-alphabet nil) +(defvar-local decipher-alphabet nil) ;; This is an alist containing entries (PLAIN-CHAR . CIPHER-CHAR), ;; where PLAIN-CHAR runs from ?a to ?z and CIPHER-CHAR is an uppercase ;; letter or space (which means no mapping is known for that letter). ;; This *must* contain entries for all lowercase characters. -(make-variable-buffer-local 'decipher-alphabet) -(defvar decipher-stats-buffer nil +(defvar-local decipher-stats-buffer nil "The buffer which displays statistics for this ciphertext. Do not access this variable directly, use the function `decipher-stats-buffer' instead.") -(make-variable-buffer-local 'decipher-stats-buffer) -(defvar decipher-undo-list-size 0 +(defvar-local decipher-undo-list-size 0 "The number of entries in the undo list.") -(make-variable-buffer-local 'decipher-undo-list-size) -(defvar decipher-undo-list nil +(defvar-local decipher-undo-list nil "The undo list for this buffer. Each element is either a cons cell (PLAIN-CHAR . CIPHER-CHAR) or a list of such cons cells.") -(make-variable-buffer-local 'decipher-undo-list) (defvar decipher-pending-undo-list nil) diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el index 028f04c325b..46fd852b4c5 100644 --- a/lisp/play/doctor.el +++ b/lisp/play/doctor.el @@ -1,4 +1,4 @@ -;;; doctor.el --- psychological help for frustrated users +;;; doctor.el --- psychological help for frustrated users -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1994, 1996, 2000-2021 Free Software ;; Foundation, Inc. diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index 3916e35f769..c3be029a658 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -42,8 +42,7 @@ (locate-user-emacs-file "games/"))) "Name of file to store score information for dunnet." :version "26.1" - :type 'file - :group 'dunnet) + :type 'file) ;;;; ;;;; This section defines the globals that are used in dunnet. diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index e540ca723d0..8b64dfdf9b5 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -28,36 +28,35 @@ ;; ;;;;;;;;;;;;; buffer-local variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar gamegrid-use-glyphs t +(defvar-local gamegrid-use-glyphs t "Non-nil means use glyphs when available.") -(defvar gamegrid-use-color t +(defvar-local gamegrid-use-color t "Non-nil means use color when available.") -(defvar gamegrid-font "-*-courier-medium-r-*-*-*-140-100-75-*-*-iso8859-*" +(defvar-local gamegrid-font "-*-courier-medium-r-*-*-*-140-100-75-*-*-iso8859-*" "Name of the font used in X mode.") -(defvar gamegrid-face nil +(defvar-local gamegrid-face nil "Indicates the face to use as a default.") -(make-variable-buffer-local 'gamegrid-face) -(defvar gamegrid-display-options nil) +(defvar-local gamegrid-display-options nil) -(defvar gamegrid-buffer-width 0) -(defvar gamegrid-buffer-height 0) -(defvar gamegrid-blank 0) +(defvar-local gamegrid-buffer-width 0) +(defvar-local gamegrid-buffer-height 0) +(defvar-local gamegrid-blank 0) -(defvar gamegrid-timer nil) +(defvar-local gamegrid-timer nil) -(defvar gamegrid-display-mode nil) +(defvar-local gamegrid-display-mode nil) -(defvar gamegrid-display-table) +(defvar-local gamegrid-display-table nil) -(defvar gamegrid-face-table nil) +(defvar-local gamegrid-face-table nil) -(defvar gamegrid-buffer-start 1) +(defvar-local gamegrid-buffer-start 1) -(defvar gamegrid-score-file-length 50 +(defvar-local gamegrid-score-file-length 50 "Number of high scores to keep.") (defvar gamegrid-user-score-file-directory @@ -66,19 +65,6 @@ If Emacs was built without support for shared game scores, then this directory will be used.") -(make-variable-buffer-local 'gamegrid-use-glyphs) -(make-variable-buffer-local 'gamegrid-use-color) -(make-variable-buffer-local 'gamegrid-font) -(make-variable-buffer-local 'gamegrid-display-options) -(make-variable-buffer-local 'gamegrid-buffer-width) -(make-variable-buffer-local 'gamegrid-buffer-height) -(make-variable-buffer-local 'gamegrid-blank) -(make-variable-buffer-local 'gamegrid-timer) -(make-variable-buffer-local 'gamegrid-display-mode) -(make-variable-buffer-local 'gamegrid-display-table) -(make-variable-buffer-local 'gamegrid-face-table) -(make-variable-buffer-local 'gamegrid-buffer-start) -(make-variable-buffer-local 'gamegrid-score-file-length) ;; ;;;;;;;;;;;;; global variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index 1a1d2d76520..c6aef027e5f 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -1,4 +1,4 @@ -;;; gametree.el --- manage game analysis trees in Emacs +;;; gametree.el --- manage game analysis trees in Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc. @@ -79,7 +79,6 @@ ;;; Code: -(require 'derived) (require 'outline) ;;;; Configuration variables @@ -98,35 +97,30 @@ numbers of moves by Black (if considered in isolation) by the ellipsis conflicts with the use of ellipsis by Outline mode to denote collapsed subtrees. The author uses \":\" because it agrees nicely with a set of LaTeX macros he uses for typesetting annotated games." - :type 'regexp - :group 'gametree) + :type 'regexp) (defcustom gametree-full-ply-regexp (regexp-quote ".") "Matches ends of numbers of moves by the \"first\" player. For instance, it is an almost universal convention in chess to postfix numbers of moves by White (if considered in isolation) by the dot \".\"." - :type 'regexp - :group 'gametree) + :type 'regexp) (defcustom gametree-half-ply-format "%d:" "Output format for move numbers of moves by the \"second\" player. Has to contain \"%d\" to output the actual number." - :type 'string - :group 'gametree) + :type 'string) (defcustom gametree-full-ply-format "%d." "Output format for move numbers of moves by the \"first\" player. Has to contain \"%d\" to output the actual number." - :type 'string - :group 'gametree) + :type 'string) (defcustom gametree-make-heading-function (lambda (level) (insert (make-string level ?*))) "A function of one numeric argument, LEVEL, to insert a heading at point. You should change this if you change `outline-regexp'." - :type 'function - :group 'gametree) + :type 'function) (defvar gametree-local-layout nil "A list encoding the layout (i.e. the show or hide state) of the file. @@ -138,18 +132,15 @@ the file is visited (subject to the usual restriction via (defcustom gametree-score-opener "{score=" "The string which opens a score tag, and precedes the actual score." - :type 'string - :group 'gametree) + :type 'string) (defcustom gametree-score-manual-flag "!" "String marking the line as manually (as opposed to automatically) scored." - :type 'string - :group 'gametree) + :type 'string) (defcustom gametree-score-closer "}" "The string which closes a score tag, and follows the actual score." - :type 'string - :group 'gametree) + :type 'string) (defcustom gametree-score-regexp (concat "[^\n\^M]*\\(" @@ -167,13 +158,11 @@ line as *manually* (as opposed to automatically) scored, which prevents the program from recursively applying the scoring algorithm on the subtree headed by the marked line, and makes it use the manual score instead." - :type 'regexp - :group 'gametree) + :type 'regexp) (defcustom gametree-default-score 0 "Score to assume for branches lacking score tags." - :type 'integer - :group 'gametree) + :type 'integer) ;;;; Helper functions diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el index 1856db8b8bf..8db40d7f94f 100644 --- a/lisp/play/gomoku.el +++ b/lisp/play/gomoku.el @@ -76,8 +76,7 @@ (defcustom gomoku-mode-hook nil "If non-nil, its value is called on entry to Gomoku mode. One useful value to include is `turn-on-font-lock' to highlight the pieces." - :type 'hook - :group 'gomoku) + :type 'hook) ;;; ;;; CONSTANTS FOR BOARD @@ -168,13 +167,11 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces." (defface gomoku-O '((((class color)) (:foreground "red" :weight bold))) - "Face to use for Emacs's O." - :group 'gomoku) + "Face to use for Emacs's O.") (defface gomoku-X '((((class color)) (:foreground "green" :weight bold))) - "Face to use for your X." - :group 'gomoku) + "Face to use for your X.") (defvar gomoku-font-lock-keywords '(("O" . 'gomoku-O) diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el index d762290f0da..ac28fba10a4 100644 --- a/lisp/play/hanoi.el +++ b/lisp/play/hanoi.el @@ -1,4 +1,4 @@ -;;; hanoi.el --- towers of hanoi in Emacs +;;; hanoi.el --- towers of hanoi in Emacs -*- lexical-binding: t -*- ;; Author: Damon Anton Permezel ;; Maintainer: emacs-devel@gnu.org @@ -71,33 +71,33 @@ (defcustom hanoi-horizontal-flag nil "If non-nil, hanoi poles are oriented horizontally." - :group 'hanoi :type 'boolean) + :type 'boolean) (defcustom hanoi-move-period 1.0 "Time, in seconds, for each pole-to-pole move of a ring. If nil, move rings as fast as possible while displaying all intermediate positions." - :group 'hanoi :type '(restricted-sexp :match-alternatives (numberp 'nil))) + :type '(restricted-sexp :match-alternatives (numberp 'nil))) (defcustom hanoi-use-faces nil "If nil, all hanoi-*-face variables are ignored." - :group 'hanoi :type 'boolean) + :type 'boolean) (defcustom hanoi-pole-face 'highlight "Face for poles. Ignored if hanoi-use-faces is nil." - :group 'hanoi :type 'face) + :type 'face) (defcustom hanoi-base-face 'highlight "Face for base. Ignored if hanoi-use-faces is nil." - :group 'hanoi :type 'face) + :type 'face) (defcustom hanoi-even-ring-face 'region "Face for even-numbered rings. Ignored if hanoi-use-faces is nil." - :group 'hanoi :type 'face) + :type 'face) (defcustom hanoi-odd-ring-face 'secondary-selection "Face for odd-numbered rings. Ignored if hanoi-use-faces is nil." - :group 'hanoi :type 'face) + :type 'face) ;;; diff --git a/lisp/play/snake.el b/lisp/play/snake.el index 5584bf88103..bed7cea6ee5 100644 --- a/lisp/play/snake.el +++ b/lisp/play/snake.el @@ -140,14 +140,14 @@ ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar snake-length 0) -(defvar snake-velocity-x 1) -(defvar snake-velocity-y 0) -(defvar snake-positions nil) -(defvar snake-score 0) -(defvar snake-paused nil) -(defvar snake-moved-p nil) -(defvar snake-velocity-queue nil +(defvar-local snake-length 0) +(defvar-local snake-velocity-x 1) +(defvar-local snake-velocity-y 0) +(defvar-local snake-positions nil) +(defvar-local snake-score 0) +(defvar-local snake-paused nil) +(defvar-local snake-moved-p nil) +(defvar-local snake-velocity-queue nil "This queue stores the velocities requested too quickly by user. They will take effect one at a time at each clock-interval. This is necessary for proper behavior. @@ -158,16 +158,6 @@ we implemented all your keystrokes immediately, the snake would effectively never move up. Thus, we need to move it up for one turn and then start moving it leftwards.") - -(make-variable-buffer-local 'snake-length) -(make-variable-buffer-local 'snake-velocity-x) -(make-variable-buffer-local 'snake-velocity-y) -(make-variable-buffer-local 'snake-positions) -(make-variable-buffer-local 'snake-score) -(make-variable-buffer-local 'snake-paused) -(make-variable-buffer-local 'snake-moved-p) -(make-variable-buffer-local 'snake-velocity-queue) - ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar snake-mode-map diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index 8205d3f79c5..05e4ffe0111 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -224,25 +224,15 @@ each one of its four blocks.") ;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar tetris-shape 0) -(defvar tetris-rot 0) -(defvar tetris-next-shape 0) -(defvar tetris-n-shapes 0) -(defvar tetris-n-rows 0) -(defvar tetris-score 0) -(defvar tetris-pos-x 0) -(defvar tetris-pos-y 0) -(defvar tetris-paused nil) - -(make-variable-buffer-local 'tetris-shape) -(make-variable-buffer-local 'tetris-rot) -(make-variable-buffer-local 'tetris-next-shape) -(make-variable-buffer-local 'tetris-n-shapes) -(make-variable-buffer-local 'tetris-n-rows) -(make-variable-buffer-local 'tetris-score) -(make-variable-buffer-local 'tetris-pos-x) -(make-variable-buffer-local 'tetris-pos-y) -(make-variable-buffer-local 'tetris-paused) +(defvar-local tetris-shape 0) +(defvar-local tetris-rot 0) +(defvar-local tetris-next-shape 0) +(defvar-local tetris-n-shapes 0) +(defvar-local tetris-n-rows 0) +(defvar-local tetris-score 0) +(defvar-local tetris-pos-x 0) +(defvar-local tetris-pos-y 0) +(defvar-local tetris-paused nil) ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/play/zone.el b/lisp/play/zone.el index 70b6a01a017..19e4e399ff3 100644 --- a/lisp/play/zone.el +++ b/lisp/play/zone.el @@ -1,4 +1,4 @@ -;;; zone.el --- idle display hacks +;;; zone.el --- idle display hacks -*- lexical-binding: t -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. @@ -128,14 +128,17 @@ If the element is a function or a list of a function and a number, (let ((pgm (elt zone-programs (random (length zone-programs)))) (ct (and f (frame-parameter f 'cursor-type))) (show-trailing-whitespace nil) - (restore (list '(kill-buffer outbuf)))) + restore) (when ct - (modify-frame-parameters f '((cursor-type . (bar . 0)))) - (setq restore (cons '(modify-frame-parameters - f (list (cons 'cursor-type ct))) - restore))) + (modify-frame-parameters f '((cursor-type . (bar . 0))))) ;; Make `restore' a self-disabling one-shot thunk. - (setq restore `(lambda () ,@restore (setq restore nil))) + (setq restore + (lambda () + (when ct + (modify-frame-parameters + f (list (cons 'cursor-type ct)))) + (kill-buffer outbuf) + (setq restore nil))) (condition-case nil (progn (message "Zoning... (%s)" pgm) @@ -419,7 +422,7 @@ If the element is a function or a list of a function and a number, (defsubst zone-replace-char (count del-count char-as-string new-value) (delete-char (or del-count (- count))) (aset char-as-string 0 new-value) - (dotimes (i count) (insert char-as-string))) + (dotimes (_ count) (insert char-as-string))) (defsubst zone-park/sit-for (pos seconds) (let ((p (point))) @@ -460,7 +463,7 @@ If the element is a function or a list of a function and a number, (let ((nl (- height (count-lines (point-min) (point))))) (when (> nl 0) (setq line (concat line "\n")) - (dotimes (i nl) + (dotimes (_ nl) (insert line)))) (goto-char start) (recenter 0) diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 527cb03cfbe..d92c8c35b1b 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -1246,9 +1246,8 @@ IF TOKENREFS-ONLY is non-nil, just return alist with tokenref names." (let ((items nil) (classes nil) (continue t)) - ;; Using `imenu-progress-message' would require imenu for compilation, but - ;; nobody is missing these messages. The generic imenu function searches - ;; backward, which is slower and more likely not to work during editing. + ;; The generic imenu function searches backward, which is slower + ;; and more likely not to work during editing. (antlr-with-syntax-table antlr-action-syntax-table (antlr-invalidate-context-cache) (goto-char (point-min)) @@ -2047,7 +2046,7 @@ Called in PHASE `after-insertion', see `antlr-options-alists'." (let ((new-language (antlr-language-option t))) (or (null new-language) (eq new-language antlr-language) - (let ((font-lock (and (boundp 'font-lock-mode) font-lock-mode))) + (let ((font-lock font-lock-mode)) (if font-lock (font-lock-mode 0)) (antlr-mode) (and font-lock (null font-lock-mode) (font-lock-mode 1))))))) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 3fce7dbafae..484624b8664 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -9021,14 +9021,15 @@ point unchanged and return nil." (c-forward-noise-clause)) ((and (looking-at c-type-decl-prefix-key) (if (and (c-major-mode-is 'c++-mode) - (match-beginning 3)) + (match-beginning 4)) ; Was 3 - 2021-01-01 ;; If the third submatch matches in C++ then ;; we're looking at an identifier that's a ;; prefix only if it specifies a member pointer. (progn (setq id-start (point)) (c-forward-name) - (if (looking-at "\\(::\\)") + (if (save-match-data + (looking-at "\\(::\\)")) ;; We only check for a trailing "::" and ;; let the "*" that should follow be ;; matched in the next round. @@ -9038,13 +9039,15 @@ point unchanged and return nil." (setq got-identifier t) nil)) t)) - (if (looking-at c-type-decl-operator-prefix-key) + (if (save-match-data + (looking-at c-type-decl-operator-prefix-key)) (setq decorated t)) (if (eq (char-after) ?\() (progn (setq paren-depth (1+ paren-depth)) (forward-char)) - (goto-char (match-end 1))) + (goto-char (or (match-end 1) + (match-end 2)))) (c-forward-syntactic-ws) t))) @@ -9721,14 +9724,15 @@ This function might do hidden buffer changes." (setq after-paren-pos (point)))) (while (and (looking-at c-type-decl-prefix-key) (if (and (c-major-mode-is 'c++-mode) - (match-beginning 3)) - ;; If the third submatch matches in C++ then + (match-beginning 4)) + ;; If the fourth submatch matches in C++ then ;; we're looking at an identifier that's a ;; prefix only if it specifies a member pointer. (when (progn (setq pos (point)) (setq got-identifier (c-forward-name))) (setq name-start pos) - (if (looking-at "\\(::\\)") + (if (save-match-data + (looking-at "\\(::\\)")) ;; We only check for a trailing "::" and ;; let the "*" that should follow be ;; matched in the next round. @@ -9749,7 +9753,8 @@ This function might do hidden buffer changes." (when (save-match-data (looking-at c-type-decl-operator-prefix-key)) (setq got-function-name-prefix t)) - (goto-char (match-end 1))) + (goto-char (or (match-end 1) + (match-end 2)))) (c-forward-syntactic-ws))) (setq got-parens (> paren-depth 0)) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index a5a6780a460..1938cc8ff1e 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -3434,41 +3434,47 @@ possible for good performance." t (c-make-bare-char-alt (c-lang-const c-block-prefix-disallowed-chars) t)) (c-lang-defvar c-block-prefix-charset (c-lang-const c-block-prefix-charset)) -(c-lang-defconst c-type-decl-prefix-key - "Regexp matching any declarator operator that might precede the -identifier in a declaration, e.g. the \"*\" in \"char *argv\". This -regexp should match \"(\" if parentheses are valid in declarators. -The end of the first submatch is taken as the end of the operator. -Identifier syntax is in effect when this is matched (see -`c-identifier-syntax-table')." +(c-lang-defconst c-type-decl-prefix-keywords-key + ;; Regexp matching any keyword operator that might precede the identifier in + ;; a declaration, e.g. "const" or nil. It doesn't test there is no "_" + ;; following the keyword. t (if (or (c-lang-const c-type-modifier-kwds) (c-lang-const c-modifier-kwds)) - (concat + (concat (regexp-opt (c--delete-duplicates (append (c-lang-const c-type-modifier-kwds) (c-lang-const c-modifier-kwds)) :test 'string-equal) t) - "\\>") - ;; Default to a regexp that never matches. - regexp-unmatchable) + "\\>"))) + +(c-lang-defconst c-type-decl-prefix-key + "Regexp matching any declarator operator that might precede the +identifier in a declaration, e.g. the \"*\" in \"char *argv\". This +regexp should match \"(\" if parentheses are valid in declarators. +The operator found is either the first submatch (if it is not a +keyword) or the second submatch (if it is)." + t (if (c-lang-const c-type-decl-prefix-keywords-key) + (concat "\\(\\`a\\`\\)\\|" ; 1 - will never match. + (c-lang-const c-type-decl-prefix-keywords-key) ; 2 + "\\([^_]\\|$\\)") ; 3 + "\\`a\\`") ;; Default to a regexp that never matches. ;; Check that there's no "=" afterwards to avoid matching tokens ;; like "*=". - (c objc) (concat "\\(" + (c objc) (concat "\\(" ; 1 "[*(]" - "\\|" - (c-lang-const c-type-decl-prefix-key) - "\\)" - "\\([^=]\\|$\\)") - c++ (concat "\\(" + "\\)\\|" + (c-lang-const c-type-decl-prefix-keywords-key) ; 2 + "\\([^=_]\\|$\\)") ; 3 + c++ (concat "\\(" ; 1 "&&" "\\|" "\\.\\.\\." "\\|" "[*(&~]" + "\\)\\|\\(" ; 2 + (c-lang-const c-type-decl-prefix-keywords-key) ; 3 "\\|" - (c-lang-const c-type-decl-prefix-key) - "\\|" - (concat "\\(" ; 3 + (concat "\\(" ; 4 ;; If this matches there's special treatment in ;; `c-font-lock-declarators' and ;; `c-font-lock-declarations' that check for a @@ -3476,8 +3482,9 @@ Identifier syntax is in effect when this is matched (see (c-lang-const c-identifier-start) "\\)") "\\)" - "\\([^=]\\|$\\)") + "\\([^=_]\\|$\\)") ; 5 pike "\\(\\*\\)\\([^=]\\|$\\)") + (c-lang-defvar c-type-decl-prefix-key (c-lang-const c-type-decl-prefix-key) 'dont-doc) diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el index d3a33bdf870..1a45b1cb838 100644 --- a/lisp/progmodes/cmacexp.el +++ b/lisp/progmodes/cmacexp.el @@ -72,15 +72,6 @@ ;; Please report bugs, suggestions, complaints and so on to ;; bug-gnu-emacs@gnu.org and pot@gnu.org (Francesco Potortì). -;; IMPROVEMENTS OVER emacs 18.xx cmacexp.el ========================== - -;; - A lot of user and programmer visible changes. See above. -;; - #line directives are inserted, so __LINE__ and __FILE__ are -;; correctly expanded. Works even with START inside a string, a -;; comment or a region #ifdef'd away by cpp. cpp is invoked with -C, -;; making comments visible in the expansion. -;; - All work is done in core memory, no need for temporary files. - ;; ACKNOWLEDGMENTS =================================================== ;; A lot of thanks to Don Maszle who did a great work of testing, bug diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 2c1e6ff52ec..48b5ee99736 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -953,13 +953,11 @@ Faces `compilation-error-face', `compilation-warning-face', :type 'boolean :version "23.1") -(defvar compilation-auto-jump-to-next nil +(defvar-local compilation-auto-jump-to-next nil "If non-nil, automatically jump to the next error encountered.") -(make-variable-buffer-local 'compilation-auto-jump-to-next) -;; (defvar compilation-buffer-modtime nil +;; (defvar-local compilation-buffer-modtime nil ;; "The buffer modification time, for buffers not associated with files.") -;; (make-variable-buffer-local 'compilation-buffer-modtime) (defvar compilation-skip-to-next-location t "If non-nil, skip multiple error messages for the same source location.") @@ -1087,13 +1085,12 @@ from a different message." (:conc-name compilation--message->)) loc type end-loc rule) -(defvar compilation--previous-directory-cache nil +(defvar-local compilation--previous-directory-cache nil "A pair (POS . RES) caching the result of previous directory search. Basically, this pair says that calling (previous-single-property-change POS \\='compilation-directory) returned RES, i.e. there is no change of `compilation-directory' between POS and RES.") -(make-variable-buffer-local 'compilation--previous-directory-cache) (defun compilation--flush-directory-cache (start _end) (cond @@ -1600,8 +1597,7 @@ to `compilation-error-regexp-alist' if RULES is nil." (match-beginning mn) (match-end mn) 'font-lock-face (cadr props))))))))) -(defvar compilation--parsed -1) -(make-variable-buffer-local 'compilation--parsed) +(defvar-local compilation--parsed -1) (defun compilation--ensure-parse (limit) "Make sure the text has been parsed up to LIMIT." @@ -2073,6 +2069,10 @@ Returns the compilation buffer created." (define-key map "\M-p" 'compilation-previous-error) (define-key map "\M-{" 'compilation-previous-file) (define-key map "\M-}" 'compilation-next-file) + (define-key map "n" 'next-error-no-select) + (define-key map "p" 'previous-error-no-select) + (define-key map "l" 'recenter-current-error) + (define-key map "g" 'recompile) ; revert ;; Set up the menu-bar (define-key map [menu-bar compilation] @@ -2673,9 +2673,8 @@ This is the value of `next-error-function' in Compilation buffers." (compilation--loc->marker end-loc)) (setf (compilation--loc->visited loc) t))) -(defvar compilation-gcpro nil +(defvar-local compilation-gcpro nil "Internal variable used to keep some values from being GC'd.") -(make-variable-buffer-local 'compilation-gcpro) (defun compilation-fake-loc (marker file &optional line col) "Preassociate MARKER with FILE. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index d401513646f..a70e8e36c0b 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1157,25 +1157,25 @@ versions of Emacs." (get-text-property (point-min) 'in-pod) (< (progn (and cperl-syntaxify-for-menu - (cperl-update-syntaxification (point-max) (point-max))) + (cperl-update-syntaxification (point-max))) (next-single-property-change (point-min) 'in-pod nil (point-max))) (point-max)))] ["Ispell HERE-DOCs" cperl-here-doc-spell (< (progn (and cperl-syntaxify-for-menu - (cperl-update-syntaxification (point-max) (point-max))) + (cperl-update-syntaxification (point-max))) (next-single-property-change (point-min) 'here-doc-group nil (point-max))) (point-max))] ["Narrow to this HERE-DOC" cperl-narrow-to-here-doc (eq 'here-doc (progn (and cperl-syntaxify-for-menu - (cperl-update-syntaxification (point) (point))) + (cperl-update-syntaxification (point))) (get-text-property (point) 'syntax-type)))] ["Select this HERE-DOC or POD section" cperl-select-this-pod-or-here-doc (memq (progn (and cperl-syntaxify-for-menu - (cperl-update-syntaxification (point) (point))) + (cperl-update-syntaxification (point))) (get-text-property (point) 'syntax-type)) '(here-doc pod))] "----" @@ -1659,36 +1659,18 @@ or as help on variables `cperl-tips', `cperl-problems', nil nil ((?_ . "w")))) ;; Reset syntaxification cache. (setq-local cperl-syntax-state nil) - (if cperl-use-syntax-table-text-property - (if (eval-when-compile (fboundp 'syntax-propertize-rules)) - (progn - ;; Reset syntaxification cache. - (setq-local cperl-syntax-done-to nil) - (setq-local syntax-propertize-function - (lambda (start end) - (goto-char start) - ;; Even if cperl-fontify-syntaxically has already gone - ;; beyond `start', syntax-propertize has just removed - ;; syntax-table properties between start and end, so we have - ;; to re-apply them. - (setq cperl-syntax-done-to start) - (cperl-fontify-syntaxically end)))) - ;; Do not introduce variable if not needed, we check it! - (setq-local parse-sexp-lookup-properties t) - ;; Our: just a plug for wrong font-lock - (setq-local font-lock-unfontify-region-function - ;; not present with old Emacs - #'cperl-font-lock-unfontify-region-function) - ;; Reset syntaxification cache. - (setq-local cperl-syntax-done-to nil) - (setq-local font-lock-syntactic-keywords - (if cperl-syntaxify-by-font-lock - '((cperl-fontify-syntaxically)) - ;; unless font-lock-syntactic-keywords, font-lock (pre-22.1) - ;; used to ignore syntax-table text-properties. (t) is a hack - ;; to make font-lock think that font-lock-syntactic-keywords - ;; are defined. - '(t))))) + (when cperl-use-syntax-table-text-property + ;; Reset syntaxification cache. + (setq-local cperl-syntax-done-to nil) + (setq-local syntax-propertize-function + (lambda (start end) + (goto-char start) + ;; Even if cperl-fontify-syntaxically has already gone + ;; beyond `start', syntax-propertize has just removed + ;; syntax-table properties between start and end, so we have + ;; to re-apply them. + (setq cperl-syntax-done-to start) + (cperl-fontify-syntaxically end)))) (setq cperl-font-lock-multiline t) ; Not localized... (setq-local font-lock-multiline t) (setq-local font-lock-fontify-region-function @@ -2405,7 +2387,7 @@ means indent rigidly all the lines of the expression starting after point so that this line becomes properly indented. The relative indentation among the lines of the expression are preserved." (interactive "P") - (cperl-update-syntaxification (point) (point)) + (cperl-update-syntaxification (point)) (if whole-exp ;; If arg, always indent this line as Perl ;; and shift remaining lines of expression the same amount. @@ -2533,7 +2515,7 @@ Will not look before LIM." (defun cperl-sniff-for-indent (&optional parse-data) ; was parse-start ;; the sniffer logic to understand what the current line MEANS. - (cperl-update-syntaxification (point) (point)) + (cperl-update-syntaxification (point)) (let ((res (get-text-property (point) 'syntax-type))) (save-excursion (cond @@ -3025,7 +3007,7 @@ Returns true if comment is found. In POD will not move the point." ;; then looks for literal # or end-of-line. (let (state stop-in cpoint (lim (point-at-eol)) pr e) (or cperl-font-locking - (cperl-update-syntaxification lim lim)) + (cperl-update-syntaxification lim)) (beginning-of-line) (if (setq pr (get-text-property (point) 'syntax-type)) (setq e (next-single-property-change (point) 'syntax-type nil (point-max)))) @@ -4640,7 +4622,7 @@ CHARS is a string that contains good characters to have before us (however, `}' is treated \"smartly\" if it is not in the list)." (let ((lim (or lim (point-min))) stop p) - (cperl-update-syntaxification (point) (point)) + (cperl-update-syntaxification (point)) (save-excursion (while (and (not stop) (> (point) lim)) (skip-chars-backward " \t\n\f" lim) @@ -5027,7 +5009,7 @@ inclusive. If `cperl-indent-region-fix-constructs', will improve spacing on conditional/loop constructs." (interactive "r") - (cperl-update-syntaxification end end) + (cperl-update-syntaxification end) (save-excursion (let (cperl-update-start cperl-update-end (h-a-c after-change-functions)) (let ((indent-info (list nil nil nil) ; Cannot use '(), since will modify @@ -5233,7 +5215,7 @@ indentation and initial hashes. Behaves usually outside of comment." packages ends-ranges p marker is-proto is-pack index index1 name (end-range 0) package) (goto-char (point-min)) - (cperl-update-syntaxification (point-max) (point-max)) + (cperl-update-syntaxification (point-max)) ;; Search for the function (progn ;;save-match-data (while (re-search-forward @@ -8209,7 +8191,7 @@ function returns nil." (or prop (setq prop 'in-pod)) (or s (setq s (point-min))) (or end (setq end (point-max))) - (cperl-update-syntaxification end end) + (cperl-update-syntaxification end) (save-excursion (goto-char (setq pos s)) (while (and cont (< pos end)) @@ -8225,7 +8207,7 @@ function returns nil." Return nil if the point is not in a HERE document region. If POD is non-nil, will return a POD section if point is in a POD section." (or pos (setq pos (point))) - (cperl-update-syntaxification pos pos) + (cperl-update-syntaxification pos) (if (or (eq 'here-doc (get-text-property pos 'syntax-type)) (and pod (eq 'pod (get-text-property pos 'syntax-type)))) @@ -8295,7 +8277,7 @@ start with default arguments, then refine the slowdown regions." (forward-line step) (setq l (+ l step)) (setq c (1+ c)) - (cperl-update-syntaxification (point) (point)) + (cperl-update-syntaxification (point)) (setq delta (- (- tt (setq tt (funcall timems)))) tot (+ tot delta)) (message "to %s:%6s,%7s" l delta tot)) tot)) @@ -8405,19 +8387,12 @@ do extra unwind via `cperl-unwind-to-safe'." (setq end (point))) (font-lock-default-fontify-region beg end loudly)) -(defvar cperl-d-l nil) -(defvar edebug-backtrace-buffer) ;FIXME: Why? (defun cperl-fontify-syntaxically (end) ;; Some vars for debugging only ;; (message "Syntaxifying...") (let ((dbg (point)) (iend end) (idone cperl-syntax-done-to) (istate (car cperl-syntax-state)) - start from-start edebug-backtrace-buffer) - (if (eq cperl-syntaxify-by-font-lock 'backtrace) - (progn - (require 'edebug) - (let ((f 'edebug-backtrace)) - (funcall f)))) ; Avoid compile-time warning + start from-start) (or cperl-syntax-done-to (setq cperl-syntax-done-to (point-min) from-start t)) @@ -8473,16 +8448,9 @@ do extra unwind via `cperl-unwind-to-safe'." (if cperl-syntax-done-to (setq cperl-syntax-done-to (min cperl-syntax-done-to beg)))) -(defun cperl-update-syntaxification (from to) - (cond - ((not cperl-use-syntax-table-text-property) nil) - ((fboundp 'syntax-propertize) (syntax-propertize to)) - ((and cperl-syntaxify-by-font-lock - (or (null cperl-syntax-done-to) - (< cperl-syntax-done-to to))) - (save-excursion - (goto-char from) - (cperl-fontify-syntaxically to))))) +(defun cperl-update-syntaxification (to) + (when cperl-use-syntax-table-text-property + (syntax-propertize to))) (defvar cperl-version (let ((v "Revision: 6.2")) diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index 4ea1674db02..b2c2e8dab57 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -112,9 +112,8 @@ If nil, `cpp-progress-message' prints no progress messages." :group 'cpp :version "26.1") -(defvar cpp-overlay-list nil) -;; List of cpp overlays active in the current buffer. -(make-variable-buffer-local 'cpp-overlay-list) +(defvar-local cpp-overlay-list nil + "List of cpp overlays active in the current buffer.") (defvar cpp-callback-data) (defvar cpp-state-stack) @@ -134,9 +133,8 @@ If nil, `cpp-progress-message' prints no progress messages." (defvar cpp-button-event nil) ;; This will be t in the callback for `cpp-make-button'. -(defvar cpp-edit-buffer nil) -;; Real buffer whose cpp display information we are editing. -(make-variable-buffer-local 'cpp-edit-buffer) +(defvar-local cpp-edit-buffer nil + "Real buffer whose cpp display information we are editing.") (defconst cpp-branch-list ;; Alist of branches. @@ -211,9 +209,8 @@ or a cons cell (background-color . COLOR)." ;;; Parse Buffer: -(defvar cpp-parse-symbols nil +(defvar-local cpp-parse-symbols nil "List of cpp macros used in the local buffer.") -(make-variable-buffer-local 'cpp-parse-symbols) (defconst cpp-parse-regexp ;; Regexp matching all tokens needed to find conditionals. @@ -471,9 +468,8 @@ A prefix arg suppresses display of that buffer." -(defvar cpp-edit-symbols nil) -;; Symbols defined in the edit buffer. -(make-variable-buffer-local 'cpp-edit-symbols) +(defvar-local cpp-edit-symbols nil + "Symbols defined in the edit buffer.") (define-derived-mode cpp-edit-mode fundamental-mode "CPP Edit" "Major mode for editing the criteria for highlighting cpp conditionals. diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el index 3815b176503..8943d8b6d01 100644 --- a/lisp/progmodes/dcl-mode.el +++ b/lisp/progmodes/dcl-mode.el @@ -30,21 +30,14 @@ ;; Type `C-h m' when you are editing a .COM file to get more ;; information about this mode. ;; -;; To use templates you will need a version of tempo.el that is at -;; least later than the buggy 1.1.1, which was included with my versions of -;; Emacs. I used version 1.2.4. -;; The latest tempo.el distribution can be fetched from -;; ftp.lysator.liu.se in the directory /pub/emacs. +;; Support for templates is based on the built-in tempo.el. ;; I recommend setting (setq tempo-interactive t). This will make ;; tempo prompt you for values to put in the blank spots in the templates. ;; -;; There is limited support for imenu. The limitation is that you need -;; a version of imenu.el that uses imenu-generic-expression. I found -;; the version I use in Emacs 19.30. (It was *so* much easier to hook -;; into that version than the one in 19.27...) +;; There is limited support for imenu. ;; ;; Any feedback will be welcomed. If you write functions for -;; dcl-calc-command-indent-function or dcl-calc-cont-indent-function, +;; `dcl-calc-command-indent-function' or `dcl-calc-cont-indent-function', ;; please send them to the maintainer. ;; ;; @@ -349,13 +342,10 @@ See `imenu-generic-expression' for details." '("End of statement" . dcl-forward-command)) (define-key map [menu-bar dcl dcl-backward-command] '("Beginning of statement" . dcl-backward-command)) - ;; imenu is only supported for versions with imenu-generic-expression - (if (boundp 'imenu-generic-expression) - (progn - (define-key map [menu-bar dcl dcl-separator-movement] - '("--")) - (define-key map [menu-bar dcl imenu] - '("Buffer index menu" . imenu)))) + (define-key map [menu-bar dcl dcl-separator-movement] + '("--")) + (define-key map [menu-bar dcl imenu] + '("Buffer index menu" . imenu)) map) "Keymap used in DCL-mode buffers.") @@ -463,8 +453,7 @@ Preloaded with all known option names from dcl-option-alist") ;The default includes SUBROUTINE labels in the main listing and ;sub-listings for other labels, CALL, GOTO and GOSUB statements. -;See `imenu-generic-expression' in a recent (e.g. Emacs 19.30) imenu.el -;for details.") +;See `imenu-generic-expression' for details.") ;;; *** Mode initialization ************************************************* @@ -600,9 +589,8 @@ There is some minimal font-lock support (see vars ;; and something inappropriate might be interpreted as a comment. (setq-local comment-start-skip "\\$[ \t]*![ \t]*") - (if (boundp 'imenu-generic-expression) - (progn (setq imenu-generic-expression dcl-imenu-generic-expression) - (setq imenu-case-fold-search t))) + (setq imenu-generic-expression dcl-imenu-generic-expression) + (setq imenu-case-fold-search t) (setq imenu-create-index-function 'dcl-imenu-create-index-function) (make-local-variable 'dcl-comment-line-regexp) diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index 6f9509d152b..b376423c185 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -2941,16 +2941,11 @@ See `ebnf-style-database' documentation." (defvar ebnf-eps-executing nil) (defvar ebnf-eps-header-comment nil) (defvar ebnf-eps-footer-comment nil) -(defvar ebnf-eps-upper-x 0.0) -(make-variable-buffer-local 'ebnf-eps-upper-x) -(defvar ebnf-eps-upper-y 0.0) -(make-variable-buffer-local 'ebnf-eps-upper-y) -(defvar ebnf-eps-prod-width 0.0) -(make-variable-buffer-local 'ebnf-eps-prod-width) -(defvar ebnf-eps-max-height 0.0) -(make-variable-buffer-local 'ebnf-eps-max-height) -(defvar ebnf-eps-max-width 0.0) -(make-variable-buffer-local 'ebnf-eps-max-width) +(defvar-local ebnf-eps-upper-x 0.0) +(defvar-local ebnf-eps-upper-y 0.0) +(defvar-local ebnf-eps-prod-width 0.0) +(defvar-local ebnf-eps-max-height 0.0) +(defvar-local ebnf-eps-max-width 0.0) (defvar ebnf-eps-context nil diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 017e8c5b415..431daec4ddb 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1284,7 +1284,8 @@ If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." (interactive "P") (if (null eval-expression-debug-on-error) - (elisp--eval-last-sexp eval-last-sexp-arg-internal) + (values--store-value + (elisp--eval-last-sexp eval-last-sexp-arg-internal)) (let ((value (let ((debug-on-error elisp--eval-last-sexp-fake-value)) (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal) @@ -1353,7 +1354,8 @@ Return the result of evaluation." ;; printing, not while evaluating. (let ((debug-on-error eval-expression-debug-on-error) (print-length eval-expression-print-length) - (print-level eval-expression-print-level)) + (print-level eval-expression-print-level) + elisp--eval-defun-result) (save-excursion ;; Arrange for eval-region to "read" the (possibly) altered form. ;; eval-region handles recording which file defines a function or @@ -1369,17 +1371,18 @@ Return the result of evaluation." (setq end (point))) ;; Alter the form if necessary. (let ((form (eval-sexp-add-defvars - (elisp--eval-defun-1 (macroexpand form))))) + (elisp--eval-defun-1 + (macroexpand + `(setq elisp--eval-defun-result ,form)))))) (eval-region beg end standard-output (lambda (_ignore) ;; Skipping to the end of the specified region ;; will make eval-region return. (goto-char end) - form)))))) - (let ((str (eval-expression-print-format (car values)))) - (if str (princ str))) - ;; The result of evaluation has been put onto VALUES. So return it. - (car values)) + form))))) + (let ((str (eval-expression-print-format elisp--eval-defun-result))) + (if str (princ str))) + elisp--eval-defun-result)) (defun eval-defun (edebug-it) "Evaluate the top-level form containing point, or after point. diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 2641387986d..5c0b7880e8b 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -117,11 +117,10 @@ ;; correctly, but I imagine them to be rare. ;; 3) Regexps for hilit19 are no longer supported. ;; 4) For FIXED FORMAT code, use fortran mode. -;; 5) This mode does not work under emacs-18.x. -;; 6) Preprocessor directives, i.e., lines starting with # are left-justified +;; 5) Preprocessor directives, i.e., lines starting with # are left-justified ;; and are untouched by all case-changing commands. There is, at present, no ;; mechanism for treating multi-line directives (continued by \ ). -;; 7) f77 do-loops do 10 i=.. ; ; 10 continue are not correctly indented. +;; 6) f77 do-loops do 10 i=.. ; ; 10 continue are not correctly indented. ;; You are urged to use f90-do loops (with labels if you wish). ;; List of user commands @@ -718,10 +717,7 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") (modify-syntax-entry ?* "." table) (modify-syntax-entry ?/ "." table) (modify-syntax-entry ?% "." table) ; bug#8820 - ;; I think that the f95 standard leaves the behavior of \ - ;; unspecified, but that f2k will require it to be non-special. - ;; Use `f90-backslash-not-special' to change. - (modify-syntax-entry ?\\ "\\" table) ; escape chars + (modify-syntax-entry ?\\ "." table) table) "Syntax table used in F90 mode.") @@ -926,9 +922,8 @@ then the presence of the token here allows a line-break before or after the other character, where a break would not normally be allowed. This minor issue currently only affects \"(/\" and \"/)\".") -(defvar f90-cache-position nil +(defvar-local f90-cache-position nil "Temporary position used to speed up region operations.") -(make-variable-buffer-local 'f90-cache-position) ;; Hideshow support. @@ -2396,9 +2391,11 @@ CHANGE-WORD should be one of `upcase-word', `downcase-word', `capitalize-word'." (defun f90-backslash-not-special (&optional all) "Make the backslash character (\\) be non-special in the current buffer. +This is the default in `f90-mode'. + With optional argument ALL, change the default for all present -and future F90 buffers. F90 mode normally treats backslash as an -escape character." +and future F90 buffers." + (declare (obsolete nil "28.1")) (or (derived-mode-p 'f90-mode) (user-error "This function should only be used in F90 buffers")) (when (equal (char-syntax ?\\ ) ?\\ ) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 1a8435fde33..d6ee8bb4236 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -275,8 +275,6 @@ See `compilation-error-screen-columns'." (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) (define-key map "\r" 'compile-goto-error) ;; ? - (define-key map "n" 'next-error-no-select) - (define-key map "p" 'previous-error-no-select) (define-key map "{" 'compilation-previous-file) (define-key map "}" 'compilation-next-file) (define-key map "\t" 'compilation-next-error) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 259da2fd019..eb114acdabc 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -638,8 +638,7 @@ The option \"--fullname\" must be included in this value." ;; receive a chunk of text which looks like it might contain the ;; beginning of a marker, we save it here between calls to the ;; filter. -(defvar gud-marker-acc "") -(make-variable-buffer-local 'gud-marker-acc) +(defvar-local gud-marker-acc "") (defun gud-gdb-marker-filter (string) (setq gud-marker-acc (concat gud-marker-acc string)) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index c11892492de..e8e55ae96d1 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -6876,7 +6876,6 @@ sort the list before displaying." (let ((completion-ignore-case t)) ; install correct value (apply function args)) (if (and (derived-mode-p 'idlwave-shell-mode) - (boundp 'font-lock-mode) (not font-lock-mode)) ;; For the shell, remove the fontification of the word before point (let ((beg (save-excursion diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 33bea59e3ba..cdf6536fc7e 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -717,26 +717,20 @@ This variable is like `sgml-attribute-offset'." table) "Syntax table for `js-mode'.") -(defvar js--quick-match-re nil +(defvar-local js--quick-match-re nil "Autogenerated regexp used by `js-mode' to match buffer constructs.") -(defvar js--quick-match-re-func nil +(defvar-local js--quick-match-re-func nil "Autogenerated regexp used by `js-mode' to match constructs and functions.") -(make-variable-buffer-local 'js--quick-match-re) -(make-variable-buffer-local 'js--quick-match-re-func) - -(defvar js--cache-end 1 +(defvar-local js--cache-end 1 "Last valid buffer position for the `js-mode' function cache.") -(make-variable-buffer-local 'js--cache-end) -(defvar js--last-parse-pos nil +(defvar-local js--last-parse-pos nil "Latest parse position reached by `js--ensure-cache'.") -(make-variable-buffer-local 'js--last-parse-pos) -(defvar js--state-at-last-parse-pos nil +(defvar-local js--state-at-last-parse-pos nil "Parse state at `js--last-parse-pos'.") -(make-variable-buffer-local 'js--state-at-last-parse-pos) (defun js--maybe-join (prefix separator suffix &rest list) "Helper function for `js--update-quick-match-re'. @@ -1505,8 +1499,7 @@ REGEXPS, but only if FRAMEWORK is in `js-enabled-frameworks'." (when (memq (quote ,framework) js-enabled-frameworks) (re-search-forward ,regexps limit t))))) -(defvar js--tmp-location nil) -(make-variable-buffer-local 'js--tmp-location) +(defvar-local js--tmp-location nil) (defun js--forward-destructuring-spec (&optional func) "Move forward over a JavaScript destructuring spec. diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index a0e09f51ce3..e382d6edcd2 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -435,6 +435,9 @@ not be enclosed in { } or ( )." '("[^$]\\(\\$[({][@%*][DF][})]\\)" 1 'makefile-targets append) + ;; Automatic variables. + '("[^$]\\(\\$[@%*?+^|]\\)" 1 'makefile-targets append) + ;; $(function ...) ${function ...} '("[^$]\\$[({]\\([-a-zA-Z0-9_.]+\\s \\)" 1 font-lock-function-name-face prepend) diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index a14a8d75a78..ddcc6f5450e 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -165,7 +165,7 @@ parenthetical grouping.") (modify-syntax-entry ?| "." table) (modify-syntax-entry ?! "." table) (modify-syntax-entry ?\\ "." table) - (modify-syntax-entry ?\' "\"" table) + (modify-syntax-entry ?\' "." table) (modify-syntax-entry ?\` "." table) (modify-syntax-entry ?. "." table) (modify-syntax-entry ?\" "\"" table) @@ -964,8 +964,7 @@ output is passed to the filter `inferior-octave-output-digest'." (setq list (cdr list))) (set-process-filter proc filter)))) -(defvar inferior-octave-directory-tracker-resync nil) -(make-variable-buffer-local 'inferior-octave-directory-tracker-resync) +(defvar-local inferior-octave-directory-tracker-resync nil) (defun inferior-octave-directory-tracker (string) "Tracks `cd' commands issued to the inferior Octave process. @@ -1517,7 +1516,8 @@ current buffer file unless called with a prefix arg \\[universal-argument]." ;; https://lists.gnu.org/r/emacs-devel/2013-10/msg00095.html (compilation-forget-errors) (insert-before-markers string "\n") - (comint-send-string proc (concat string "\n")))) + (comint-send-string proc (concat string "\n"))) + (deactivate-mark)) (if octave-send-show-buffer (display-buffer inferior-octave-buffer))) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index fc5e30111e5..abe563bec04 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -725,6 +725,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'." (require 'xref) (require 'grep) (let* ((pr (project-current t)) + (default-directory (project-root pr)) (files (if (not current-prefix-arg) (project-files pr) @@ -756,6 +757,7 @@ pattern to search for." (interactive (list (project--read-regexp))) (require 'xref) (let* ((pr (project-current t)) + (default-directory (project-root pr)) (files (project-files pr (cons (project-root pr) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d6c0a4d1dbf..afb96974b17 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3273,7 +3273,8 @@ process running; defaults to t when called interactively." ;; lines have been removed/added. (with-current-buffer (process-buffer process) (compilation-forget-errors)) - (python-shell-send-string string process))) + (python-shell-send-string string process) + (deactivate-mark))) (defun python-shell-send-statement (&optional send-main msg) "Send the statement at point to inferior Python process. diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index a8667acb9d5..e7f407b6367 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -1869,8 +1869,8 @@ It will be properly highlighted even when the call omits parens.") ;; Symbols with special characters. (":\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\)" (1 (unless (or - (eq (char-before (match-beginning 0)) ?:) - (nth 8 (syntax-ppss (match-beginning 1)))) + (nth 8 (syntax-ppss (match-beginning 1))) + (eq (char-before (match-beginning 0)) ?:)) (goto-char (match-end 0)) (string-to-syntax "_")))) ;; Symbols ending with '=' (bug#42846). diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index fd689527676..f588ad99c9d 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -541,10 +541,9 @@ sign. See `sh-feature'." :group 'sh-script) -(defvar sh-header-marker nil +(defvar-local sh-header-marker nil "When non-nil is the end of header for prepending by \\[sh-execute-region]. That command is also used for setting this variable.") -(make-variable-buffer-local 'sh-header-marker) (defcustom sh-beginning-of-command "\\([;({`|&]\\|\\`\\|[^\\]\n\\)[ \t]*\\([/~[:alnum:]:]\\)" diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el index 7806a6b46c8..a863e7eb4b4 100644 --- a/lisp/progmodes/simula.el +++ b/lisp/progmodes/simula.el @@ -281,7 +281,7 @@ for SIMULA mode to function correctly." (define-key map ":" 'simula-electric-label) (define-key map "\e\C-q" 'simula-indent-exp) (define-key map "\t" 'simula-indent-command) - ;; Emacs 19 defines menus in the mode map + (define-key map [menu-bar simula] (cons "SIMULA" (make-sparse-keymap "SIMULA"))) (define-key map [menu-bar simula indent-exp] diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 4d027f3df53..f1f4d61324b 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -2829,9 +2829,7 @@ configured." ;; Force font lock to reinitialize if it is already on ;; Otherwise, we can wait until it can be started. - (when (and (fboundp 'font-lock-mode) - (boundp 'font-lock-mode) - font-lock-mode) + (when font-lock-mode (font-lock-mode-internal nil) (font-lock-mode-internal t)) diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 0a0118a5eba..82e1343e057 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -651,7 +651,6 @@ already exist." (setq-local add-log-current-defun-function #'tcl-add-log-defun) - (setq-local beginning-of-defun-function #'tcl-beginning-of-defun-function) (setq-local end-of-defun-function #'tcl-end-of-defun-function)) @@ -849,14 +848,12 @@ Returns nil if line starts inside a string, t if in a comment." state containing-sexp found-next-line) - (cond - (parse-start + + (if parse-start (goto-char parse-start)) - ((not (beginning-of-defun)) - ;; If we're not in a function, don't use - ;; `tcl-beginning-of-defun-function'. - (let ((beginning-of-defun-function nil)) - (beginning-of-defun)))) + + (beginning-of-defun) + (while (< (point) indent-point) (setq parse-start (point)) (setq state (parse-partial-sexp (point) indent-point 0)) @@ -1035,22 +1032,6 @@ Returns nil if line starts inside a string, t if in a comment." ;; Interfaces to other packages. ;; -(defun tcl-beginning-of-defun-function (&optional arg) - "`beginning-of-defun-function' for Tcl mode." - (when (or (not arg) (= arg 0)) - (setq arg 1)) - (let* ((search-fn (if (> arg 0) - ;; Positive arg means to search backward. - #'re-search-backward - #'re-search-forward)) - (arg (abs arg)) - (result t)) - (while (and (> arg 0) result) - (unless (funcall search-fn tcl-proc-regexp nil t) - (setq result nil)) - (setq arg (1- arg))) - result)) - (defun tcl-end-of-defun-function () "`end-of-defun-function' for Tcl mode." ;; Because we let users redefine tcl-proc-list, we don't really know diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 8dddcf0eef0..f934ef7a80e 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -9,7 +9,7 @@ ;; Keywords: languages ;; The "Version" is the date followed by the decimal rendition of the Git ;; commit hex. -;; Version: 2020.06.27.014326051 +;; Version: 2021.02.02.263931197 ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this ;; file on 19/3/2008, and the maintainer agreed that when a bug is @@ -124,7 +124,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2020-06-27-0da9923-vpo-GNU" +(defconst verilog-mode-version "2021-02-02-fbb453d-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -134,6 +134,16 @@ (interactive) (message "Using verilog-mode version %s" verilog-mode-version)) +(defmacro verilog--supressed-warnings (warnings &rest body) + (declare (indent 1) (debug t)) + (cond + ((fboundp 'with-suppressed-warnings) + `(with-suppressed-warnings ,warnings ,@body)) + ((fboundp 'with-no-warnings) + `(with-no-warnings ,@body)) + (t + `(progn ,@body)))) + ;; Insure we have certain packages, and deal with it if we don't ;; Be sure to note which Emacs flavor and version added each feature. (eval-when-compile @@ -220,7 +230,7 @@ STRING should be given if the last search was by `string-match' on STRING." ) (if (fboundp 'defface) nil ; great! - (defmacro defface (var values doc &rest _args) + (defmacro defface (var _values _doc &rest _args) `(make-face ,var)) ) @@ -339,7 +349,7 @@ wherever possible, since it is slow." ((fboundp 'quit-window) (defalias 'verilog-quit-window 'quit-window)) (t - (defun verilog-quit-window (kill-ignored window) + (defun verilog-quit-window (_kill-ignored window) "Quit WINDOW and bury its buffer. KILL-IGNORED is ignored." (delete-window window))))) @@ -407,7 +417,7 @@ wherever possible, since it is slow." "Filter `define-abbrev-table' TABLENAME DEFINITIONS Provides DOCSTRING PROPS in newer Emacs (23.1)." (condition-case nil - (apply 'define-abbrev-table tablename definitions docstring props) + (apply #'define-abbrev-table tablename definitions docstring props) (error (define-abbrev-table tablename definitions)))) @@ -572,7 +582,7 @@ entry \"Fontify Buffer\"). XEmacs: turn off and on font locking." :type 'boolean :group 'verilog-mode-indent) ;; Note we don't use :safe, as that would break on Emacsen before 22.0. -(put 'verilog-highlight-translate-off 'safe-local-variable 'verilog-booleanp) +(put 'verilog-highlight-translate-off 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-lineup 'declarations "Type of statements to lineup across multiple lines. @@ -611,7 +621,7 @@ are lineup only when \\[verilog-pretty-declarations] is typed." "Indentation of Verilog statements with respect to containing block." :group 'verilog-mode-indent :type 'integer) -(put 'verilog-indent-level 'safe-local-variable 'integerp) +(put 'verilog-indent-level 'safe-local-variable #'integerp) (defcustom verilog-indent-level-module 3 "Indentation of Module level Verilog statements (eg always, initial). @@ -619,14 +629,14 @@ Set to 0 to get initial and always statements lined up on the left side of your screen." :group 'verilog-mode-indent :type 'integer) -(put 'verilog-indent-level-module 'safe-local-variable 'integerp) +(put 'verilog-indent-level-module 'safe-local-variable #'integerp) (defcustom verilog-indent-level-declaration 3 "Indentation of declarations with respect to containing block. Set to 0 to get them list right under containing block." :group 'verilog-mode-indent :type 'integer) -(put 'verilog-indent-level-declaration 'safe-local-variable 'integerp) +(put 'verilog-indent-level-declaration 'safe-local-variable #'integerp) (defcustom verilog-indent-declaration-macros nil "How to treat macro expansions in a declaration. @@ -640,7 +650,7 @@ If non-nil, treat as: output c;" :group 'verilog-mode-indent :type 'boolean) -(put 'verilog-indent-declaration-macros 'safe-local-variable 'verilog-booleanp) +(put 'verilog-indent-declaration-macros 'safe-local-variable #'verilog-booleanp) (defcustom verilog-indent-lists t "How to treat indenting items in a list. @@ -653,72 +663,72 @@ If nil, treat as: reset ) begin" :group 'verilog-mode-indent :type 'boolean) -(put 'verilog-indent-lists 'safe-local-variable 'verilog-booleanp) +(put 'verilog-indent-lists 'safe-local-variable #'verilog-booleanp) (defcustom verilog-indent-level-behavioral 3 "Absolute indentation of first begin in a task or function block. Set to 0 to get such code to start at the left side of the screen." :group 'verilog-mode-indent :type 'integer) -(put 'verilog-indent-level-behavioral 'safe-local-variable 'integerp) +(put 'verilog-indent-level-behavioral 'safe-local-variable #'integerp) (defcustom verilog-indent-level-directive 1 "Indentation to add to each level of \\=`ifdef declarations. Set to 0 to have all directives start at the left side of the screen." :group 'verilog-mode-indent :type 'integer) -(put 'verilog-indent-level-directive 'safe-local-variable 'integerp) +(put 'verilog-indent-level-directive 'safe-local-variable #'integerp) (defcustom verilog-cexp-indent 2 "Indentation of Verilog statements split across lines." :group 'verilog-mode-indent :type 'integer) -(put 'verilog-cexp-indent 'safe-local-variable 'integerp) +(put 'verilog-cexp-indent 'safe-local-variable #'integerp) (defcustom verilog-case-indent 2 "Indentation for case statements." :group 'verilog-mode-indent :type 'integer) -(put 'verilog-case-indent 'safe-local-variable 'integerp) +(put 'verilog-case-indent 'safe-local-variable #'integerp) (defcustom verilog-auto-newline t "Non-nil means automatically newline after semicolons." :group 'verilog-mode-indent :type 'boolean) -(put 'verilog-auto-newline 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-newline 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-indent-on-newline t "Non-nil means automatically indent line after newline." :group 'verilog-mode-indent :type 'boolean) -(put 'verilog-auto-indent-on-newline 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-indent-on-newline 'safe-local-variable #'verilog-booleanp) (defcustom verilog-tab-always-indent t "Non-nil means TAB should always re-indent the current line. A nil value means TAB will only reindent when at the beginning of the line." :group 'verilog-mode-indent :type 'boolean) -(put 'verilog-tab-always-indent 'safe-local-variable 'verilog-booleanp) +(put 'verilog-tab-always-indent 'safe-local-variable #'verilog-booleanp) (defcustom verilog-tab-to-comment nil "Non-nil means TAB moves to the right hand column in preparation for a comment." :group 'verilog-mode-actions :type 'boolean) -(put 'verilog-tab-to-comment 'safe-local-variable 'verilog-booleanp) +(put 'verilog-tab-to-comment 'safe-local-variable #'verilog-booleanp) (defcustom verilog-indent-begin-after-if t "Non-nil means indent begin statements following if, else, while, etc. Otherwise, line them up." :group 'verilog-mode-indent :type 'boolean) -(put 'verilog-indent-begin-after-if 'safe-local-variable 'verilog-booleanp) +(put 'verilog-indent-begin-after-if 'safe-local-variable #'verilog-booleanp) (defcustom verilog-align-ifelse nil "Non-nil means align `else' under matching `if'. Otherwise else is lined up with first character on line holding matching if." :group 'verilog-mode-indent :type 'boolean) -(put 'verilog-align-ifelse 'safe-local-variable 'verilog-booleanp) +(put 'verilog-align-ifelse 'safe-local-variable #'verilog-booleanp) (defcustom verilog-minimum-comment-distance 10 "Minimum distance (in lines) between begin and end required before a comment. @@ -726,7 +736,7 @@ Setting this variable to zero results in every end acquiring a comment; the default avoids too many redundant comments in tight quarters." :group 'verilog-mode-indent :type 'integer) -(put 'verilog-minimum-comment-distance 'safe-local-variable 'integerp) +(put 'verilog-minimum-comment-distance 'safe-local-variable #'integerp) (defcustom verilog-highlight-p1800-keywords nil "Obsolete. @@ -734,7 +744,7 @@ Was non-nil means highlight SystemVerilog IEEE-1800 differently. All code is now highlighted as if SystemVerilog IEEE-1800." :group 'verilog-mode-indent :type 'boolean) -(put 'verilog-highlight-p1800-keywords 'safe-local-variable 'verilog-booleanp) +(put 'verilog-highlight-p1800-keywords 'safe-local-variable #'verilog-booleanp) (make-obsolete-variable 'verilog-highlight-p1800-keywords nil "27.1") (defcustom verilog-highlight-grouping-keywords nil @@ -745,7 +755,7 @@ Some find that special highlighting on these grouping constructs allow the structure of the code to be understood at a glance." :group 'verilog-mode-indent :type 'boolean) -(put 'verilog-highlight-grouping-keywords 'safe-local-variable 'verilog-booleanp) +(put 'verilog-highlight-grouping-keywords 'safe-local-variable #'verilog-booleanp) (defcustom verilog-highlight-modules nil "Non-nil means highlight module statements for `verilog-load-file-at-point'. @@ -754,7 +764,7 @@ module definition. If false, this is not supported. Setting this is experimental, and may lead to bad performance." :group 'verilog-mode-indent :type 'boolean) -(put 'verilog-highlight-modules 'safe-local-variable 'verilog-booleanp) +(put 'verilog-highlight-modules 'safe-local-variable #'verilog-booleanp) (defcustom verilog-highlight-includes t "Non-nil means highlight module statements for `verilog-load-file-at-point'. @@ -762,7 +772,17 @@ When true, mousing over include file names will allow jumping to the file referenced. If false, this is not supported." :group 'verilog-mode-indent :type 'boolean) -(put 'verilog-highlight-includes 'safe-local-variable 'verilog-booleanp) +(put 'verilog-highlight-includes 'safe-local-variable #'verilog-booleanp) + +(defcustom verilog-highlight-max-lookahead 10000 + "Maximum size of declaration statement that undergoes highlighting. +Highlighting is performed only on the first `verilog-highlight-max-lookahead' +characters in a declaration statement. +Setting this variable to zero would remove this limit. Note that removing +the limit can greatly slow down highlighting for very large files." + :group 'verilog-mode-indent + :type 'integer) +(put 'verilog-highlight-max-lookahead 'safe-local-variable #'integerp) (defcustom verilog-auto-declare-nettype nil "Non-nil specifies the data type to use with `verilog-auto-input' etc. @@ -772,14 +792,14 @@ mode is experimental." :version "24.1" ; rev670 :group 'verilog-mode-actions :type 'boolean) -(put 'verilog-auto-declare-nettype 'safe-local-variable 'stringp) +(put 'verilog-auto-declare-nettype 'safe-local-variable #'stringp) (defcustom verilog-auto-wire-comment t "Non-nil indicates to insert to/from comments with `verilog-auto-wire' etc." :version "25.1" :group 'verilog-mode-actions :type 'boolean) -(put 'verilog-auto-wire-comment 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-wire-comment 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-wire-type nil "Non-nil specifies the data type to use with `verilog-auto-wire' etc. @@ -790,21 +810,21 @@ containing SystemVerilog cells." :version "24.1" ; rev673 :group 'verilog-mode-actions :type '(choice (const nil) string)) -(put 'verilog-auto-wire-type 'safe-local-variable 'stringp) +(put 'verilog-auto-wire-type 'safe-local-variable #'stringp) (defcustom verilog-auto-endcomments t "Non-nil means insert a comment /* ... */ after `end's. The name of the function or case will be set between the braces." :group 'verilog-mode-actions :type 'boolean) -(put 'verilog-auto-endcomments 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-endcomments 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-delete-trailing-whitespace nil "Non-nil means to `delete-trailing-whitespace' in `verilog-auto'." :version "24.1" ; rev703 :group 'verilog-mode-actions :type 'boolean) -(put 'verilog-auto-delete-trailing-whitespace 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-delete-trailing-whitespace 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-ignore-concat nil "Non-nil means ignore signals in {...} concatenations for AUTOWIRE etc. @@ -812,7 +832,7 @@ This will exclude signals referenced as pin connections in {...} or (...) from AUTOWIRE, AUTOOUTPUT and friends." :group 'verilog-mode-actions :type 'boolean) -(put 'verilog-auto-ignore-concat 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-ignore-concat 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-read-includes nil "Non-nil means to automatically read includes before AUTOs. @@ -822,7 +842,7 @@ but can result in very slow reading times if there are many or large include files." :group 'verilog-mode-actions :type 'boolean) -(put 'verilog-auto-read-includes 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-read-includes 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-save-policy nil "Non-nil indicates action to take when saving a Verilog buffer with AUTOs. @@ -843,7 +863,7 @@ They will be expanded in the same way as if there was an AUTOINST in the instantiation. See also `verilog-auto-star' and `verilog-auto-star-save'." :group 'verilog-mode-actions :type 'boolean) -(put 'verilog-auto-star-expand 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-star-expand 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-star-save nil "Non-nil means save to disk SystemVerilog .* instance expansions. @@ -854,7 +874,7 @@ Instead of setting this, you may want to use /*AUTOINST*/, which will always be saved." :group 'verilog-mode-actions :type 'boolean) -(put 'verilog-auto-star-save 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-star-save 'safe-local-variable #'verilog-booleanp) (defvar verilog-auto-update-tick nil "Modification tick at which autos were last performed.") @@ -862,7 +882,7 @@ always be saved." (defvar verilog-auto-last-file-locals nil "Text from file-local-variables during last evaluation.") -(defvar verilog-diff-function 'verilog-diff-report +(defvar verilog-diff-function #'verilog-diff-report "Function to run when `verilog-diff-auto' detects differences. Function takes three arguments, the original buffer, the difference buffer, and the point in original buffer with the @@ -917,7 +937,7 @@ See `compilation-error-regexp-alist' for the formatting. For Emacs 22+.") ;; Emacs form is '((v-tool "re" 1 2) ...) ;; XEmacs form is '(verilog ("re" 1 2) ...) ;; So we can just map from Emacs to XEmacs - (cons 'verilog (mapcar 'cdr verilog-error-regexp-emacs-alist)) + (cons 'verilog (mapcar #'cdr verilog-error-regexp-emacs-alist)) "List of regexps for Verilog compilers. See `compilation-error-regexp-alist-alist' for the formatting. For XEmacs.") @@ -997,7 +1017,7 @@ have problems, use \\[find-alternate-file] RET to have these take effect. See also the variables mentioned above." :group 'verilog-mode-auto :type '(repeat string)) -(put 'verilog-library-flags 'safe-local-variable 'listp) +(put 'verilog-library-flags 'safe-local-variable #'listp) (defcustom verilog-library-directories '(".") "List of directories when looking for files for /*AUTOINST*/. @@ -1020,7 +1040,7 @@ See also `verilog-library-flags', `verilog-library-files' and `verilog-library-extensions'." :group 'verilog-mode-auto :type '(repeat file)) -(put 'verilog-library-directories 'safe-local-variable 'listp) +(put 'verilog-library-directories 'safe-local-variable #'listp) (defcustom verilog-library-files '() "List of files to search for modules. @@ -1042,14 +1062,14 @@ have problems, use \\[find-alternate-file] RET to have these take effect. See also `verilog-library-flags', `verilog-library-directories'." :group 'verilog-mode-auto :type '(repeat directory)) -(put 'verilog-library-files 'safe-local-variable 'listp) +(put 'verilog-library-files 'safe-local-variable #'listp) (defcustom verilog-library-extensions '(".v" ".va" ".sv") "List of extensions to use when looking for files for /*AUTOINST*/. See also `verilog-library-flags', `verilog-library-directories'." :type '(repeat string) :group 'verilog-mode-auto) -(put 'verilog-library-extensions 'safe-local-variable 'listp) +(put 'verilog-library-extensions 'safe-local-variable #'listp) (defcustom verilog-active-low-regexp nil "If true, treat signals matching this regexp as active low. @@ -1057,7 +1077,7 @@ This is used for AUTORESET and AUTOTIEOFF. For proper behavior, you will probably also need `verilog-auto-reset-widths' set." :group 'verilog-mode-auto :type '(choice (const nil) regexp)) -(put 'verilog-active-low-regexp 'safe-local-variable 'stringp) +(put 'verilog-active-low-regexp 'safe-local-variable #'stringp) (defcustom verilog-auto-sense-include-inputs nil "Non-nil means AUTOSENSE should include all inputs. @@ -1065,7 +1085,7 @@ If nil, only inputs that are NOT output signals in the same block are included." :group 'verilog-mode-auto :type 'boolean) -(put 'verilog-auto-sense-include-inputs 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-sense-include-inputs 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-sense-defines-constant nil "Non-nil means AUTOSENSE should assume all defines represent constants. @@ -1074,7 +1094,7 @@ maintain compatibility with other sites, this should be set at the bottom of each Verilog file that requires it, rather than being set globally." :group 'verilog-mode-auto :type 'boolean) -(put 'verilog-auto-sense-defines-constant 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-sense-defines-constant 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-simplify-expressions t "Non-nil means AUTOs will simplify expressions when calculating bit ranges. @@ -1086,7 +1106,7 @@ file that requires it, rather than being set globally." :version "27.1" :group 'verilog-mode-auto :type 'boolean) -(put 'verilog-auto-simplify-expressions 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-simplify-expressions 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-reset-blocking-in-non t "Non-nil means AUTORESET will reset blocking statements. @@ -1101,7 +1121,7 @@ those temporaries reset. See example in `verilog-auto-reset'." :version "24.1" ; rev718 :type 'boolean :group 'verilog-mode-auto) -(put 'verilog-auto-reset-blocking-in-non 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-reset-blocking-in-non 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-reset-widths t "True means AUTORESET should determine the width of signals. @@ -1124,7 +1144,7 @@ SystemVerilog designs." "Text used for delays in delayed assignments. Add a trailing space if set." :group 'verilog-mode-auto :type 'string) -(put 'verilog-assignment-delay 'safe-local-variable 'stringp) +(put 'verilog-assignment-delay 'safe-local-variable #'stringp) (defcustom verilog-auto-arg-format 'packed "Formatting to use for AUTOARG signal names. @@ -1150,7 +1170,7 @@ it's bad practice to rely on order based instantiations anyhow. See also `verilog-auto-inst-sort'." :group 'verilog-mode-auto :type 'boolean) -(put 'verilog-auto-arg-sort 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-arg-sort 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-inst-dot-name nil "Non-nil means when creating ports with AUTOINST, use .name syntax. @@ -1160,7 +1180,7 @@ simulators. Setting `verilog-auto-inst-vector' to nil may also be desirable to increase how often .name will be used." :group 'verilog-mode-auto :type 'boolean) -(put 'verilog-auto-inst-dot-name 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-inst-dot-name 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-inst-param-value nil "Non-nil means AUTOINST will replace parameters with the parameter value. @@ -1227,7 +1247,7 @@ This second expansion of parameter types can be overridden with `verilog-auto-inst-param-value-type'." :group 'verilog-mode-auto :type 'boolean) -(put 'verilog-auto-inst-param-value 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-inst-param-value 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-inst-param-value-type t "Non-nil means expand parameter type in instantiations. @@ -1237,7 +1257,7 @@ See `verilog-auto-inst-param-value'." :version "25.1" :group 'verilog-mode-auto :type 'boolean) -(put 'verilog-auto-inst-param-value-type 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-inst-param-value-type 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-inst-sort nil "Non-nil means AUTOINST signals will be sorted, not in declaration order. @@ -1250,7 +1270,7 @@ See also `verilog-auto-arg-sort'." :version "24.1" ; rev688 :group 'verilog-mode-auto :type 'boolean) -(put 'verilog-auto-inst-sort 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-inst-sort 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-inst-vector t "True means when creating default ports with AUTOINST, use bus subscripts. @@ -1292,48 +1312,48 @@ to a net with the same name as the port." :version "28.0" :group 'verilog-mode-auto :type 'boolean) -(put 'verilog-auto-inst-template-required 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-inst-template-required 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-inst-column 40 "Indent-to column number for net name part of AUTOINST created pin." :group 'verilog-mode-indent :type 'integer) -(put 'verilog-auto-inst-column 'safe-local-variable 'integerp) +(put 'verilog-auto-inst-column 'safe-local-variable #'integerp) (defcustom verilog-auto-inst-interfaced-ports nil "Non-nil means include interfaced ports in AUTOINST expansions." :version "24.3" ; rev773, default change rev815 :group 'verilog-mode-auto :type 'boolean) -(put 'verilog-auto-inst-interfaced-ports 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-inst-interfaced-ports 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-input-ignore-regexp nil "If non-nil, when creating AUTOINPUT, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto :type '(choice (const nil) regexp)) -(put 'verilog-auto-input-ignore-regexp 'safe-local-variable 'stringp) +(put 'verilog-auto-input-ignore-regexp 'safe-local-variable #'stringp) (defcustom verilog-auto-reg-input-assigned-ignore-regexp nil "If non-nil, when creating AUTOINPUTREG, ignore signals matching this regexp." :version "27.1" :group 'verilog-mode-auto :type '(choice (const nil) regexp)) -(put 'verilog-auto-reg-input-assigned-ignore-regexp 'safe-local-variable 'stringp) +(put 'verilog-auto-reg-input-assigned-ignore-regexp 'safe-local-variable #'stringp) (defcustom verilog-auto-inout-ignore-regexp nil "If non-nil, when creating AUTOINOUT, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto :type '(choice (const nil) regexp)) -(put 'verilog-auto-inout-ignore-regexp 'safe-local-variable 'stringp) +(put 'verilog-auto-inout-ignore-regexp 'safe-local-variable #'stringp) (defcustom verilog-auto-output-ignore-regexp nil "If non-nil, when creating AUTOOUTPUT, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto :type '(choice (const nil) regexp)) -(put 'verilog-auto-output-ignore-regexp 'safe-local-variable 'stringp) +(put 'verilog-auto-output-ignore-regexp 'safe-local-variable #'stringp) (defcustom verilog-auto-template-warn-unused nil "Non-nil means report warning if an AUTO_TEMPLATE line is not used. @@ -1341,7 +1361,7 @@ This feature is not supported before Emacs 21.1 or XEmacs 21.4." :version "24.3" ; rev787 :group 'verilog-mode-auto :type 'boolean) -(put 'verilog-auto-template-warn-unused 'safe-local-variable 'verilog-booleanp) +(put 'verilog-auto-template-warn-unused 'safe-local-variable #'verilog-booleanp) (defcustom verilog-auto-tieoff-declaration "wire" "Data type used for the declaration for AUTOTIEOFF. @@ -1350,21 +1370,21 @@ assignment, else the data type for variable creation." :version "24.1" ; rev713 :group 'verilog-mode-auto :type 'string) -(put 'verilog-auto-tieoff-declaration 'safe-local-variable 'stringp) +(put 'verilog-auto-tieoff-declaration 'safe-local-variable #'stringp) (defcustom verilog-auto-tieoff-ignore-regexp nil "If non-nil, when creating AUTOTIEOFF, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto :type '(choice (const nil) regexp)) -(put 'verilog-auto-tieoff-ignore-regexp 'safe-local-variable 'stringp) +(put 'verilog-auto-tieoff-ignore-regexp 'safe-local-variable #'stringp) (defcustom verilog-auto-unused-ignore-regexp nil "If non-nil, when creating AUTOUNUSED, ignore signals matching this regexp. See the \\[verilog-faq] for examples on using this." :group 'verilog-mode-auto :type '(choice (const nil) regexp)) -(put 'verilog-auto-unused-ignore-regexp 'safe-local-variable 'stringp) +(put 'verilog-auto-unused-ignore-regexp 'safe-local-variable #'stringp) (defcustom verilog-case-fold t "Non-nil means `verilog-mode' regexps should ignore case. @@ -1372,7 +1392,7 @@ This variable is t for backward compatibility; nil is suggested." :version "24.4" :group 'verilog-mode :type 'boolean) -(put 'verilog-case-fold 'safe-local-variable 'verilog-booleanp) +(put 'verilog-case-fold 'safe-local-variable #'verilog-booleanp) (defcustom verilog-typedef-regexp nil "If non-nil, regular expression that matches Verilog-2001 typedef names. @@ -1380,9 +1400,9 @@ For example, \"_t$\" matches typedefs named with _t, as in the C language. See also `verilog-case-fold'." :group 'verilog-mode-auto :type '(choice (const nil) regexp)) -(put 'verilog-typedef-regexp 'safe-local-variable 'stringp) +(put 'verilog-typedef-regexp 'safe-local-variable #'stringp) -(defcustom verilog-mode-hook 'verilog-set-compile-command +(defcustom verilog-mode-hook (list #'verilog-set-compile-command) "Hook run after Verilog mode is loaded." :type 'hook :group 'verilog-mode) @@ -2035,17 +2055,25 @@ be substituted." (set (make-local-variable 'verilog-compile-command-post-mod) compile-command)))) -(if (featurep 'xemacs) +(when (featurep 'xemacs) + (defvar compilation-error-regexp-systems-alist) + (if (not (and (= emacs-major-version 21) (<= emacs-minor-version 4))) + ;; XEmacs 21.5 and newer match GNU, see bug1700 + (defun verilog-error-regexp-add-xemacs () + (interactive) + (verilog-error-regexp-add-xemacs)) + ;; XEmacs 21.4 and older ;; Following code only gets called from compilation-mode-hook on XEmacs to add error handling. (defun verilog-error-regexp-add-xemacs () - "Teach XEmacs about verilog errors. + "Teach XEmacs about Verilog errors. Called by `compilation-mode-hook'. This allows \\[next-error] to find the errors." (interactive) (if (boundp 'compilation-error-regexp-systems-alist) (if (and (not (equal compilation-error-regexp-systems-list 'all)) - (not (member compilation-error-regexp-systems-list 'verilog))) + ;; eval required due to bug1700, XEmacs otherwise errors on compile + (not (eval "(member compilation-error-regexp-systems-list 'verilog)"))) (push 'verilog compilation-error-regexp-systems-list))) (if (boundp 'compilation-error-regexp-alist-alist) (if (not (assoc 'verilog compilation-error-regexp-alist-alist)) @@ -2060,7 +2088,7 @@ find the errors." ;; Need to re-run compilation-error-regexp builder (if (fboundp 'compilation-build-compilation-error-regexp-alist) (compilation-build-compilation-error-regexp-alist)) - )) + ))) ;; Following code only gets called from compilation-mode-hook on Emacs to add error handling. (defun verilog-error-regexp-add-emacs () @@ -2076,8 +2104,10 @@ find the errors." (push item compilation-error-regexp-alist-alist)) verilog-error-regexp-emacs-alist)))) -(if (featurep 'xemacs) (add-hook 'compilation-mode-hook 'verilog-error-regexp-add-xemacs)) -(if (featurep 'emacs) (add-hook 'compilation-mode-hook 'verilog-error-regexp-add-emacs)) +(add-hook 'compilation-mode-hook + (if (featurep 'xemacs) + #'verilog-error-regexp-add-xemacs + #'verilog-error-regexp-add-emacs)) (defconst verilog-compiler-directives (eval-when-compile @@ -2285,7 +2315,8 @@ find the errors." "`ovm_update_sequence_lib_and_item" "`ovm_warning" "`static_dut_error" - "`static_message") nil ))) + "`static_message") + nil ))) (defconst verilog-uvm-statement-re (eval-when-compile @@ -2424,7 +2455,8 @@ find the errors." "`uvm_update_sequence_lib" ; Deprecated in 1.1 "`uvm_update_sequence_lib_and_item" ; Deprecated in 1.1 "`uvm_warning" - "`uvm_warning_context") nil ))) + "`uvm_warning_context") + nil ))) ;; @@ -2566,10 +2598,10 @@ find the errors." "\\(property\\)\\|" ; 16 "\\(connectmodule\\)\\|" ; 17 "\\)\\>\\)")) + (defconst verilog-end-block-re (eval-when-compile (verilog-regexp-words - '("end" ; closes begin "endcase" ; closes any of case, casex casez or randcase "join" "join_any" "join_none" ; closes fork @@ -2606,7 +2638,6 @@ find the errors." "`vmm_xactor_member_end" )))) - (defconst verilog-endcomment-reason-re ;; Parenthesis indicate type of keyword found (concat @@ -2775,6 +2806,8 @@ find the errors." "shortreal" "real" "realtime" ;; net_type "supply0" "supply1" "tri" "triand" "trior" "trireg" "tri0" "tri1" "uwire" "wire" "wand" "wor" + ;; parameters + "localparam" "parameter" "var" ;; misc "string" "event" "chandle" "virtual" "enum" "genvar" "struct" "union" @@ -3310,13 +3343,20 @@ See also `verilog-font-lock-extra-types'.") '("\\<function\\>\\s-+\\(\\sw+\\)" 1 'font-lock-constant-face append) ;; Fontify variable names in declarations - (list ;; Implemented as an anchored-matcher - (concat verilog-declaration-re - " *\\(" verilog-range-re "\\)?") - (list ;; anchored-highlighter - (concat "\\_<\\(" verilog-symbol-re "\\)" - " *\\(" verilog-range-re "\\)?*") - nil nil '(1 font-lock-variable-name-face)))))) + (list + verilog-declaration-re + (list + ;; Anchored matcher (lookup Search-Based Fontification) + 'verilog-declaration-varname-matcher + ;; Pre-form for this anchored matcher: + ;; First, avoid declaration keywords written in comments, + ;; which can also trigger this anchor. + '(if (not (verilog-in-comment-p)) + (verilog-single-declaration-end verilog-highlight-max-lookahead) + (point)) ;; => current declaration statement is of 0 length + nil ;; Post-form: nothing to be done + '(0 font-lock-variable-name-face t t))) + ))) (setq verilog-font-lock-keywords-2 @@ -3402,7 +3442,7 @@ For insignificant changes, see instead `verilog-save-buffer-state'." (verilog-run-hooks 'verilog-before-save-font-hook) (let* ((verilog-save-font-mod-hooked (- (point-max) (point-min))) ;; Significant speed savings with no font-lock properties - (fontlocked (when (and (boundp 'font-lock-mode) font-lock-mode) + (fontlocked (when font-lock-mode (font-lock-mode 0) t))) (run-hook-with-args 'before-change-functions (point-min) (point-max)) @@ -3564,6 +3604,87 @@ inserted using a single call to `verilog-insert'." (defun verilog-declaration-end () (search-forward ";")) +(defun verilog-single-declaration-end (limit) + "Returns pos where current (single) declaration statement ends. +Also, this function moves POINT forward to the start of a variable name +(skipping the range-part and whitespace). +Function expected to be called with POINT just after a declaration keyword. +LIMIT sets the max POINT for searching and moving to. No such limit if LIMIT +is 0. + +Meaning of *single* declaration: + Eg. In a module's port-list - + module test(input clk, rst, x, output [1:0] y); + Here 'input clk, rst, x' is 1 *single* declaration statement, +and 'output [1:0] y' is the other single declaration. In the 1st single +declaration, POINT is moved to start of 'clk'. And in the 2nd declaration, +POINT is moved to 'y'." + + + (let (maxpoint old-point) + ;; maxpoint = min(curr-point + limit, buffer-size) + (setq maxpoint (if (eq limit 0) + (point-max) ;; no bounds if search-bound is zero + (+ (point) limit))) + (if (> maxpoint (buffer-size)) (setq maxpoint (buffer-size))) + + ;; Skip comment - range - comment + (verilog-forward-ws&directives maxpoint) + (when (eq (char-after) ?\[) + (re-search-forward verilog-range-re maxpoint t)) + (verilog-forward-ws&directives maxpoint) + + ;; Move forward until a delimiter is reached which marks end of current + ;; single declaration. Return point at found delimiter + (save-excursion + (while (and (< (point) maxpoint) + (not (eq old-point (point))) + (not (eq (char-after) ?\; )) + (not (eq (char-after) ?\) )) + (not (looking-at verilog-declaration-re))) + (setq old-point (point)) + (ignore-errors + (forward-sexp) + (verilog-forward-ws&directives maxpoint) + (when (eq (char-after) ?,) + (forward-char) + (verilog-forward-ws&directives maxpoint)))) + (point)))) + +(defun verilog-declaration-varname-matcher (limit) + "Match first variable name b/w POINT & LIMIT, move POINT to next variable. +Expected to be called within a declaration statement, with POINT already beyond +the declaration keyword and range ([a:b]) +This function moves POINT to the next variable within the same declaration (if +it exists). +LIMIT is expected to be the pos at which current single-declaration ends, +obtained using `verilog-single-declaration-end'." + + (let (found-var old-point) + + ;; Remove starting whitespace + (verilog-forward-ws&directives limit) + + (when (< (point) limit) ;; no matching if this is violated + + ;; Find the variable name (match-data is set here) + (setq found-var (re-search-forward verilog-symbol-re limit t)) + + ;; Walk to this variable's delimiter + (save-match-data + (verilog-forward-ws&directives limit) + (setq old-point nil) + (while (and (< (point) limit) + (not (member (char-after) '(?, ?\) ?\;))) + (not (eq old-point (point)))) + (setq old-point (point)) + (verilog-forward-ws&directives limit) + (forward-sexp) + (verilog-forward-ws&directives limit)) + ;; Only a comma or semicolon expected at this point + (skip-syntax-forward ".")) + found-var))) + (defun verilog-point-text (&optional pointnum) "Return text describing where POINTNUM or current point is (for errors). Use filename, if current buffer being edited shorten to just buffer name." @@ -3934,13 +4055,13 @@ Key bindings specific to `verilog-mode-map' are: \\{verilog-mode-map}" :abbrev-table verilog-mode-abbrev-table (set (make-local-variable 'beginning-of-defun-function) - 'verilog-beg-of-defun) + #'verilog-beg-of-defun) (set (make-local-variable 'end-of-defun-function) - 'verilog-end-of-defun) + #'verilog-end-of-defun) (set-syntax-table verilog-mode-syntax-table) (set (make-local-variable 'indent-line-function) #'verilog-indent-line-relative) - (set (make-local-variable 'comment-indent-function) 'verilog-comment-indent) + (set (make-local-variable 'comment-indent-function) #'verilog-comment-indent) (set (make-local-variable 'parse-sexp-ignore-comments) nil) (set (make-local-variable 'comment-start) "// ") (set (make-local-variable 'comment-end) "") @@ -3951,7 +4072,7 @@ Key bindings specific to `verilog-mode-map' are: (setq verilog-tool 'verilog-linter) (verilog-set-compile-command) (when (boundp 'hack-local-variables-hook) ; Also modify any file-local-variables - (add-hook 'hack-local-variables-hook 'verilog-modify-compile-command t)) + (add-hook 'hack-local-variables-hook #'verilog-modify-compile-command t)) ;; Setting up menus (when (featurep 'xemacs) @@ -3973,6 +4094,10 @@ Key bindings specific to `verilog-mode-map' are: ;; verilog-beg-of-defun. nil 'verilog-beg-of-defun))) + + ;; Stuff for multiline font-lock + (set (make-local-variable 'font-lock-multiline) t) + ;;------------------------------------------------------------ ;; now hook in 'verilog-highlight-include-files (eldo-mode.el&spice-mode.el) ;; all buffer local: @@ -3981,9 +4106,9 @@ Key bindings specific to `verilog-mode-map' are: (make-local-hook 'font-lock-mode-hook) (make-local-hook 'font-lock-after-fontify-buffer-hook); doesn't exist in Emacs (make-local-hook 'after-change-functions)) - (add-hook 'font-lock-mode-hook 'verilog-highlight-buffer t t) - (add-hook 'font-lock-after-fontify-buffer-hook 'verilog-highlight-buffer t t) ; not in Emacs - (add-hook 'after-change-functions 'verilog-highlight-region t t)) + (add-hook 'font-lock-mode-hook #'verilog-highlight-buffer t t) + (add-hook 'font-lock-after-fontify-buffer-hook #'verilog-highlight-buffer t t) ; not in Emacs + (add-hook 'after-change-functions #'verilog-highlight-region t t)) ;; Tell imenu how to handle Verilog. (set (make-local-variable 'imenu-generic-expression) @@ -4005,7 +4130,7 @@ Key bindings specific to `verilog-mode-map' are: ;; Stuff for autos (add-hook (if (boundp 'write-contents-hooks) 'write-contents-hooks 'write-contents-functions) ; Emacs >= 22.1 - 'verilog-auto-save-check nil 'local) + #'verilog-auto-save-check nil 'local) ;; verilog-mode-hook call added by define-derived-mode ) @@ -5410,7 +5535,7 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name'." default nil nil 'verilog-preprocess-history default))))) (unless command (setq command (verilog-expand-command verilog-preprocessor))) - (let* ((fontlocked (and (boundp 'font-lock-mode) font-lock-mode)) + (let* ((fontlocked font-lock-mode) (dir (file-name-directory (or filename buffer-file-name))) (cmd (concat "cd " dir "; " command))) (with-output-to-temp-buffer "*Verilog-Preprocessed*" @@ -5424,22 +5549,23 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name'." ;; We should use font-lock-ensure in preference to ;; font-lock-fontify-buffer, but IIUC the problem this is supposed to ;; solve only appears in Emacsen older than font-lock-ensure anyway. - ;; So avoid bytecomp's interactive-only by going through intern. - (when fontlocked (funcall (intern "font-lock-fontify-buffer")))))))) + (when fontlocked + (verilog--supressed-warnings + ((interactive-only font-lock-fontify-buffer)) + (font-lock-fontify-buffer)))))))) ;;; Batch: ;; (defun verilog-warn (string &rest args) "Print a warning with `format' using STRING and optional ARGS." - (apply 'message (concat "%%Warning: " string) args)) + (apply #'message (concat "%%Warning: " string) args)) (defun verilog-warn-error (string &rest args) "Call `error' using STRING and optional ARGS. If `verilog-warn-fatal' is non-nil, call `verilog-warn' instead." - (if verilog-warn-fatal - (apply 'error string args) - (apply 'verilog-warn string args))) + (apply (if verilog-warn-fatal #'error #'verilog-warn) + string args)) (defmacro verilog-batch-error-wrapper (&rest body) "Execute BODY and add error prefix to any errors found. @@ -6452,6 +6578,7 @@ Return >0 for nested struct." (let ((p (point))) (and (equal (char-after) ?\{) + (not (verilog-at-streaming-op-p)) (ignore-errors (forward-list)) (progn (backward-char 1) (verilog-backward-ws&directives) @@ -6489,6 +6616,18 @@ Return >0 for nested struct." ;; not nil)) +(defconst verilog-streaming-op-re + ;; Regexp to detect Streaming Operator expressions + (concat + "{" "\\s-*" + "\\(<<\\|>>\\)" ".*" + "{" ".*" "}" "\\s-*" "}" + )) + +(defun verilog-at-streaming-op-p () + "If at the { of a streaming operator, return t." + (looking-at verilog-streaming-op-re)) + (defun verilog-at-struct-p () "If at the { of a struct, return true, not moving point." (save-excursion @@ -7961,6 +8100,8 @@ See also `verilog-sk-header' for an alternative format." ;; Unfortunately we use 'assoc' on this, so can't be a vector (defsubst verilog-sig-new (name bits comment mem enum signed type multidim modport) (list name bits comment mem enum signed type multidim modport)) +(defsubst verilog-sig-new-renamed (name old-sig) + (cons name (cdr old-sig))) (defsubst verilog-sig-name (sig) (car sig)) (defsubst verilog-sig-bits (sig) ; First element of packed array (pre signal-name) @@ -8315,7 +8456,7 @@ Tieoff value uses `verilog-active-low-regexp' and (t (let* ((width (verilog-sig-width sig))) (cond ((not width) - "`0/*NOWIDTH*/") + "'0/*NOWIDTH*/") ((string-match "^[0-9]+$" width) (concat width (if (verilog-sig-signed sig) "'sh0" "'h0"))) (t @@ -8497,9 +8638,25 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters." (error "%s: Expected <= %d parameters" (verilog-point-text) max-param)) (nreverse olist))) +;; Prevent compile warnings; these are let's, not globals. +(defvar sigs-in) +(defvar sigs-inout) +(defvar sigs-intf) +(defvar sigs-intfd) +(defvar sigs-out) +(defvar sigs-out-d) +(defvar sigs-out-i) +(defvar sigs-out-unk) +(defvar sigs-temp) +;; These are known to be from other packages and may not be defined +(defvar diff-command) +;; There are known to be from newer versions of Emacs +(defvar create-lockfiles) +(defvar which-func-modes) + (defun verilog-read-decls () "Compute signal declaration information for the current module at point. -Return an array of [outputs inouts inputs wire reg assign const]." +Return an array of [outputs inouts inputs wire reg assign const gparam intf]." (let ((end-mod-point (or (verilog-get-end-of-defun) (point-max))) (functask 0) (paren 0) (sig-paren 0) (v2kargs-ok t) in-modport in-clocking in-ign-to-semi ptype ign-prop @@ -8777,25 +8934,6 @@ Return an array of [outputs inouts inputs wire reg assign const]." (defvar verilog-read-sub-decls-gate-ios nil "For `verilog-read-sub-decls', gate IO pins remaining, nil if non-primitive.") -(eval-when-compile - ;; Prevent compile warnings; these are let's, not globals - ;; Do not remove the eval-when-compile - ;; - we want an error when we are debugging this code if they are refed. - (defvar sigs-in) - (defvar sigs-inout) - (defvar sigs-intf) - (defvar sigs-intfd) - (defvar sigs-out) - (defvar sigs-out-d) - (defvar sigs-out-i) - (defvar sigs-out-unk) - (defvar sigs-temp) - ;; These are known to be from other packages and may not be defined - (defvar diff-command) - ;; There are known to be from newer versions of Emacs - (defvar create-lockfiles) - (defvar which-func-modes)) - (defun verilog-read-sub-decls-type (par-values portdata) "For `verilog-read-sub-decls-line', decode a signal type." (let* ((type (verilog-sig-type portdata)) @@ -8894,7 +9032,8 @@ Return an array of [outputs inouts inputs wire reg assign const]." "For `verilog-read-sub-decls-line', parse a subexpression and add signals." ;;(message "vrsde: `%s'" expr) ;; Replace special /*[....]*/ comments inserted by verilog-auto-inst-port - (setq expr (verilog-string-replace-matches "/\\*\\(\\.?\\[[^*]+\\]\\)\\*/" "\\1" nil nil expr)) + (setq expr (verilog-string-replace-matches + "/\\*\\(\\.?\\[\\([^*]+\\|[*][^/]\\)+\\]\\)\\*/" "\\1" nil nil expr)) ;; Remove front operators (setq expr (verilog-string-replace-matches "^\\s-*[---+~!|&]+\\s-*" "" nil nil expr)) ;; @@ -9809,10 +9948,10 @@ Use DEFAULT-DIR to anchor paths if non-nil." "Convert `verilog-library-flags' into standard library variables." ;; If the flags are local, then all the outputs should be local also (when (local-variable-p 'verilog-library-flags (current-buffer)) - (mapc 'make-local-variable '(verilog-library-extensions - verilog-library-directories - verilog-library-files - verilog-library-flags))) + (mapc #'make-local-variable '(verilog-library-extensions + verilog-library-directories + verilog-library-files + verilog-library-flags))) ;; Allow user to customize (verilog-run-hooks 'verilog-before-getopt-flags-hook) ;; Process arguments @@ -10017,7 +10156,7 @@ Or, just the existing dirnames themselves if there are no wildcards." (setq dirnames (reverse dirnames)) ; not nreverse (let ((dirlist nil) pattern dirfile dirfiles dirname root filename rest basefile) - (setq dirnames (mapcar 'substitute-in-file-name dirnames)) + (setq dirnames (mapcar #'substitute-in-file-name dirnames)) (while dirnames (setq dirname (car dirnames) dirnames (cdr dirnames)) @@ -10210,7 +10349,7 @@ Return modi if successful, else print message unless IGNORE-ERROR is true." (if (not (equal module realname)) (concat " (Expanded macro to " realname ")") "") - (mapconcat 'concat orig-filenames "\n\t"))) + (mapconcat #'concat orig-filenames "\n\t"))) (when (eval-when-compile (fboundp 'make-hash-table)) (unless verilog-modi-lookup-cache (setq verilog-modi-lookup-cache @@ -10348,42 +10487,47 @@ those clocking block's signals." (defun verilog-signals-matching-enum (in-list enum) "Return all signals in IN-LIST matching the given ENUM." (let (out-list) - (while in-list - (if (equal (verilog-sig-enum (car in-list)) enum) - (setq out-list (cons (car in-list) out-list))) - (setq in-list (cdr in-list))) + (dolist (sig in-list) + (if (equal (verilog-sig-enum sig) enum) + (push sig out-list))) ;; New scheme ;; Namespace intentionally short for AUTOs and compatibility - (let* ((enumvar (intern (concat "venum-" enum))) - (enumlist (and (boundp enumvar) (eval enumvar)))) - (while enumlist - (add-to-list 'out-list (list (car enumlist))) - (setq enumlist (cdr enumlist)))) + (let* ((enumvar (intern (concat "venum-" enum)))) + (dolist (en (and (boundp enumvar) (eval enumvar))) + (let ((sig (list en))) + (unless (member sig out-list) + (push sig out-list))))) (nreverse out-list))) (defun verilog-signals-matching-regexp (in-list regexp) - "Return all signals in IN-LIST matching the given REGEXP, if non-nil." + "Return all signals in IN-LIST matching the given REGEXP, if non-nil. +Allow regexp inversion if REGEXP begins with ?!." (if (or (not regexp) (equal regexp "")) in-list - (let ((case-fold-search verilog-case-fold) - out-list) - (while in-list - (if (string-match regexp (verilog-sig-name (car in-list))) - (setq out-list (cons (car in-list) out-list))) - (setq in-list (cdr in-list))) - (nreverse out-list)))) + (if (string-match "^\\?!" regexp) + (verilog-signals-not-matching-regexp in-list (substring regexp 2)) + (let ((case-fold-search verilog-case-fold) + out-list) + (while in-list + (if (string-match regexp (verilog-sig-name (car in-list))) + (setq out-list (cons (car in-list) out-list))) + (setq in-list (cdr in-list))) + (nreverse out-list))))) (defun verilog-signals-not-matching-regexp (in-list regexp) - "Return all signals in IN-LIST not matching the given REGEXP, if non-nil." + "Return all signals in IN-LIST not matching the given REGEXP, if non-nil. +Allow regexp inversion if REGEXP begins with ?!." (if (or (not regexp) (equal regexp "")) in-list - (let ((case-fold-search verilog-case-fold) - out-list) - (while in-list - (if (not (string-match regexp (verilog-sig-name (car in-list)))) - (setq out-list (cons (car in-list) out-list))) - (setq in-list (cdr in-list))) - (nreverse out-list)))) + (if (string-match "^\\?!" regexp) + (verilog-signals-matching-regexp in-list (substring regexp 2)) + (let ((case-fold-search verilog-case-fold) + out-list) + (while in-list + (if (not (string-match regexp (verilog-sig-name (car in-list)))) + (setq out-list (cons (car in-list) out-list))) + (setq in-list (cdr in-list))) + (nreverse out-list))))) (defun verilog-signals-matching-dir-re (in-list decl-type regexp) "Return all signals in IN-LIST matching the given DECL-TYPE and REGEXP, @@ -10396,7 +10540,7 @@ if non-nil." (setq to-match (concat decl-type " " (verilog-sig-signed (car in-list)) - " " (verilog-sig-multidim (car in-list)) + " " (verilog-sig-multidim-string (car in-list)) (verilog-sig-bits (car in-list)))) (if (string-match regexp to-match) (setq out-list (cons (car in-list) out-list))) @@ -10410,6 +10554,20 @@ if non-nil." (verilog-sig-type-set sig nil)) sig) in-list)) +(defun verilog-signals-add-prefix (in-list prefix) + "Return all signals in IN-LIST with PREFIX added." + (if (or (not prefix) (equal prefix "")) + in-list + (let (out-list) + (while in-list + (setq out-list (cons (verilog-sig-new-renamed + (concat prefix (verilog-sig-name (car in-list))) + (car in-list)) + out-list)) + (setq in-list (cdr in-list))) + (nreverse out-list)))) +;(verilog-signals-add-prefix (list (list "foo" "...") (list "bar" "...")) "p_") + ;; Combined (defun verilog-decls-get-signals (decls) "Return all declared signals in DECLS, excluding `assign' statements." @@ -10450,7 +10608,7 @@ if non-nil." ;; (defun verilog-auto-re-search-do (search-for func) - "Search for given auto text regexp SEARCH-FOR, and perform FUNC where it occurs." + "Given start brace BRA, and end brace KET, expand one line into many lines." (goto-char (point-min)) (while (verilog-re-search-forward-quick search-for nil t) (funcall func))) @@ -10540,9 +10698,7 @@ When MODI is non-null, also add to modi-cache, for tracking." (verilog-insert "// " (verilog-sig-comment sig) "\n")) (setq sigs (cdr sigs))))) -(eval-when-compile - (if (not (boundp 'indent-pt)) - (defvar indent-pt nil "Local used by `verilog-insert-indent'."))) +(defvar indent-pt) ;; Local used by `verilog-insert-indent'. (defun verilog-insert-indent (&rest stuff) "Indent to position stored in local `indent-pt' variable, then insert STUFF. @@ -10649,11 +10805,15 @@ This repairs those mis-inserted by an AUTOARG." (match-string 3 out)) nil nil out))) ;; For precedence do *,/ before +,-,>>,<< - (while (string-match - (concat "\\([[({:*/<>+-]\\)" - "\\([0-9]+\\)\\s *\\([*/]\\)\\s *\\([0-9]+\\)" - "\\([])}:*/<>+-]\\)") - out) + (while (and + (string-match + (concat "\\([[({:*/<>+-]\\)" + "\\([0-9]+\\)\\s *\\([*/]\\)\\s *\\([0-9]+\\)" + "\\([])}:*/<>+-]\\)") + out) + (not (and (equal (match-string 3 out) "/") + (not (equal 0 (% (string-to-number (match-string 2 out)) + (string-to-number (match-string 4 out)))))))) (setq out (replace-match (concat (match-string 1 out) (if (equal (match-string 3 out) "/") @@ -10725,6 +10885,7 @@ This repairs those mis-inserted by an AUTOARG." ;;(verilog-simplify-range-expression "[(TEST[1])-1:0]") ;;(verilog-simplify-range-expression "[1<<2:8>>2]") ; [4:2] ;;(verilog-simplify-range-expression "[2*4/(4-2) +2+4 <<4 >>2]") +;;(verilog-simplify-range-expression "[WIDTH*2/8-1:0]") (defun verilog-clog2 (value) "Compute $clog2 - ceiling log2 of VALUE." @@ -11336,6 +11497,8 @@ making verification modules that connect to UVM interfaces. The optional fourth parameter is a regular expression, and only signals matching the regular expression will be included. + The optional fifth parameter is a prefix to add to the signals. + Limitations: Interface names must be resolvable to filenames. See `verilog-auto-inst'. @@ -11349,11 +11512,12 @@ Limitations: See the example in `verilog-auto-inout-modport'." (save-excursion - (let* ((params (verilog-read-auto-params 3 4)) + (let* ((params (verilog-read-auto-params 3 5)) (submod (nth 0 params)) (modport-re (nth 1 params)) (inst-name (nth 2 params)) (regexp (nth 3 params)) + (prefix (nth 4 params)) direction-re submodi) ; direction argument not supported until requested ;; Lookup position, etc of co-module ;; Note this may raise an error @@ -11387,15 +11551,18 @@ See the example in `verilog-auto-inout-modport'." ;; Don't sort them so an upper AUTOINST will match the main module (let ((sigs sig-list-o)) (while sigs - (verilog-insert-indent "assign " (verilog-sig-name (car sigs)) - " = " inst-name - "." (verilog-sig-name (car sigs)) ";\n") + (verilog-insert-indent "assign " + (concat prefix (verilog-sig-name (car sigs))) + " = " inst-name + "." (verilog-sig-name (car sigs)) ";\n") (setq sigs (cdr sigs)))) (let ((sigs sig-list-i)) (while sigs - (verilog-insert-indent "assign " inst-name - "." (verilog-sig-name (car sigs)) - " = " (verilog-sig-name (car sigs)) ";\n") + (verilog-insert-indent "assign " inst-name + "." (verilog-sig-name (car sigs)) + " = " + (concat prefix (verilog-sig-name (car sigs))) + ";\n") (setq sigs (cdr sigs)))) (verilog-insert-indent "// End of automatics\n"))))))) @@ -11611,7 +11778,9 @@ declaration with ones automatically derived from the module or interface header of the instantiated item. You may also provide an optional regular expression, in which -case only I/O matching the regular expression will be included. +case only I/O matching the regular expression will be included, +or excluded if the regexp begins with ?! (question-mark +exclamation-mark). If `verilog-auto-star-expand' is set, also expand SystemVerilog .* ports, and delete them before saving unless `verilog-auto-star-save' is set. @@ -12047,7 +12216,8 @@ automatically derived from the module header of the instantiated netlist. You may also provide an optional regular expression, in which case only parameters matching the regular expression will be -included. +included, or excluded if the regexp begins with ?! (question-mark +exclamation-mark). See \\[verilog-auto-inst] for limitations, and templates to customize the output. @@ -12466,9 +12636,11 @@ Typing \\[verilog-auto] will make this into: wire o = tempb; endmodule -You may also provide an optional regular expression, in which case only -signals matching the regular expression will be included. For example the -same expansion will result from only extracting outputs starting with ov: +You may also provide an optional regular expression, in which +case only signals matching the regular expression will be +included,or excluded if the regexp begins with ?! (question-mark +exclamation-mark). For example the same expansion will result +from only extracting outputs starting with ov: /*AUTOOUTPUTEVERY(\"^ov\")*/" (save-excursion @@ -12544,9 +12716,12 @@ Typing \\[verilog-auto] will make this into: .i (i)); endmodule -You may also provide an optional regular expression, in which case only -signals matching the regular expression will be included. For example the -same expansion will result from only extracting inputs starting with i: +You may also provide an optional regular expression, in which +case only signals matching the regular expression will be +included. or excluded if the regexp begins with +?! (question-mark exclamation-mark). For example the same +expansion will result from only extracting inputs starting with +i: /*AUTOINPUT(\"^i\")*/" (save-excursion @@ -12628,9 +12803,11 @@ Typing \\[verilog-auto] will make this into: .io (io)); endmodule -You may also provide an optional regular expression, in which case only -signals matching the regular expression will be included. For example the -same expansion will result from only extracting inouts starting with i: +You may also provide an optional regular expression, in which +case only signals matching the regular expression will be +included, or excluded if the regexp begins with ?! (question-mark +exclamation-mark). For example the same expansion will result +from only extracting inouts starting with i: /*AUTOINOUT(\"^i\")*/" (save-excursion @@ -12711,9 +12888,11 @@ Typing \\[verilog-auto] will make this into: // End of automatics endmodule -You may also provide an optional regular expression, in which case only -signals matching the regular expression will be included. For example the -same expansion will result from only extracting signals starting with i: +You may also provide an optional regular expression, in which +case only signals matching the regular expression will be +included, or excluded if the regexp begins with ?! (question-mark +exclamation-mark). For example the same expansion will result +from only extracting signals starting with i: /*AUTOINOUTMODULE(\"ExampMain\",\"^i\")*/ @@ -12919,9 +13098,11 @@ Typing \\[verilog-auto] will make this into: // End of automatics endmodule -You may also provide an optional regular expression, in which case only -signals matching the regular expression will be included. For example the -same expansion will result from only extracting signals starting with i: +You may also provide an optional regular expression, in which +case only signals matching the regular expression will be +included, or excluded if the regexp begins with ?! (question-mark +exclamation-mark). For example the same expansion will result +from only extracting signals starting with i: /*AUTOINOUTIN(\"ExampMain\",\"^i\")*/" (verilog-auto-inout-module nil t)) @@ -13009,6 +13190,8 @@ for making verification modules that connect to UVM interfaces. The optional third parameter is a regular expression, and only signals matching the regular expression will be included. + The optional fourth parameter is a prefix to add to the signals. + Limitations: If placed inside the parenthesis of a module declaration, it creates Verilog 2001 style, else uses Verilog 1995 style. @@ -13032,10 +13215,16 @@ An example: modport mp(clocking mon_clkblk); endinterface + module ExampMain ( input clk, /*AUTOINOUTMODPORT(\"ExampIf\", \"mp\")*/ ); + + ExampleIf i; + + /*AUTOASSIGNMODPORT(\"ExampIf\", \"mp\", \"i\")*/ + endmodule Typing \\[verilog-auto] will make this into: @@ -13048,16 +13237,26 @@ Typing \\[verilog-auto] will make this into: input [7:0] req_dat // End of automatics ); + + ExampleIf i; + + /*AUTOASSIGNMODPORT(\"ExampIf\", \"mp\", \"i\")*/ + // Beginning of automatic assignments from modport + assign i.req_dat = req_dat; + assign i.req_val = req_val; + // End of automatics + endmodule If the modport is part of a UVM monitor/driver class, this creates a wrapper module that may be used to instantiate the driver/monitor using AUTOINST in the testbench." (save-excursion - (let* ((params (verilog-read-auto-params 2 3)) + (let* ((params (verilog-read-auto-params 2 4)) (submod (nth 0 params)) (modport-re (nth 1 params)) (regexp (nth 2 params)) + (prefix (nth 3 params)) direction-re submodi) ; direction argument not supported until requested ;; Lookup position, etc of co-module ;; Note this may raise an error @@ -13072,33 +13271,42 @@ driver/monitor using AUTOINST in the testbench." (verilog-decls-get-vars submoddecls) (verilog-signals-not-in (verilog-decls-get-inputs submodportdecls) - (append (verilog-decls-get-ports submoddecls) - (verilog-decls-get-ports moddecls))))) + (verilog-decls-get-ports submoddecls)))) (sig-list-o (verilog-signals-in ; Decls doesn't have data types, must resolve (verilog-decls-get-vars submoddecls) (verilog-signals-not-in (verilog-decls-get-outputs submodportdecls) - (append (verilog-decls-get-ports submoddecls) - (verilog-decls-get-ports moddecls))))) + (verilog-decls-get-ports submoddecls)))) (sig-list-io (verilog-signals-in ; Decls doesn't have data types, must resolve (verilog-decls-get-vars submoddecls) (verilog-signals-not-in (verilog-decls-get-inouts submodportdecls) - (append (verilog-decls-get-ports submoddecls) - (verilog-decls-get-ports moddecls)))))) + (verilog-decls-get-ports submoddecls))))) (forward-line 1) (setq sig-list-i (verilog-signals-edit-wire-reg - (verilog-signals-matching-dir-re - (verilog-signals-matching-regexp sig-list-i regexp) - "input" direction-re)) + (verilog-signals-not-in + (verilog-signals-add-prefix + (verilog-signals-matching-dir-re + (verilog-signals-matching-regexp sig-list-i regexp) + "input" direction-re) + prefix) + (verilog-decls-get-ports moddecls))) sig-list-o (verilog-signals-edit-wire-reg - (verilog-signals-matching-dir-re - (verilog-signals-matching-regexp sig-list-o regexp) - "output" direction-re)) + (verilog-signals-not-in + (verilog-signals-add-prefix + (verilog-signals-matching-dir-re + (verilog-signals-matching-regexp sig-list-o regexp) + "output" direction-re) + prefix) + (verilog-decls-get-ports moddecls))) sig-list-io (verilog-signals-edit-wire-reg - (verilog-signals-matching-dir-re - (verilog-signals-matching-regexp sig-list-io regexp) - "inout" direction-re))) + (verilog-signals-not-in + (verilog-signals-add-prefix + (verilog-signals-matching-dir-re + (verilog-signals-matching-regexp sig-list-io regexp) + "inout" direction-re) + prefix) + (verilog-decls-get-ports moddecls)))) (when v2k (verilog-repair-open-comma)) (when (or sig-list-i sig-list-o sig-list-io) (verilog-insert-indent "// Beginning of automatic in/out/inouts (from modport)\n") @@ -13335,7 +13543,7 @@ them to a one. AUTORESET may try to reset arrays or structures that cannot be reset by a simple assignment, resulting in compile errors. This is a feature to be taken as a hint that you need to reset these -signals manually (or put them into a \"\\=`ifdef NEVER signal<=\\=`0; +signals manually (or put them into a \"\\=`ifdef NEVER signal<=\\='0; \\=`endif\" so Verilog-Mode ignores them.) An example: @@ -13559,7 +13767,7 @@ defines the regular expression will be undefed." (t (setq defs (delete (match-string-no-properties 2) defs)))))) ;; Insert - (setq defs (sort defs 'string<)) + (setq defs (sort defs #'string<)) (when defs (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic undefs\n") diff --git a/lisp/registry.el b/lisp/registry.el index a5c30f20efc..258f7fc9046 100644 --- a/lisp/registry.el +++ b/lisp/registry.el @@ -1,4 +1,4 @@ -;;; registry.el --- Track and remember data items by various fields +;;; registry.el --- Track and remember data items by various fields -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2021 Free Software Foundation, Inc. @@ -128,7 +128,7 @@ :type hash-table :documentation "The data hash table."))) -(cl-defmethod initialize-instance :before ((this registry-db) slots) +(cl-defmethod initialize-instance :before ((_this registry-db) slots) "Check whether a registry object needs to be upgraded." ;; Hardcoded upgrade routines. Version 0.1 to 0.2 requires the ;; :max-soft slot to disappear, and the :max-hard slot to be renamed @@ -212,7 +212,7 @@ When SET is not nil, set it for VAL (use t for an empty list)." (:regex (string-match (car vals) (mapconcat - 'prin1-to-string + #'prin1-to-string (cdr-safe (assoc key entry)) "\0")))) vals (cdr-safe vals))) @@ -247,7 +247,7 @@ Updates the secondary ('tracked') indices as well. With assert non-nil, errors out if the key does not exist already." (let* ((data (oref db data)) (keys (or keys - (apply 'registry-search db spec))) + (apply #'registry-search db spec))) (tracked (oref db tracked))) (dolist (key keys) @@ -308,19 +308,18 @@ Errors out if the key exists already." (let ((count 0) (expected (* (length (oref db tracked)) (registry-size db)))) (dolist (tr (oref db tracked)) - (let (values) - (maphash - (lambda (key v) - (cl-incf count) - (when (and (< 0 expected) - (= 0 (mod count 1000))) - (message "reindexing: %d of %d (%.2f%%)" - count expected (/ (* 100.0 count) expected))) - (dolist (val (cdr-safe (assq tr v))) - (let ((value-keys (registry-lookup-secondary-value db tr val))) - (push key value-keys) - (registry-lookup-secondary-value db tr val value-keys)))) - (oref db data)))))) + (maphash + (lambda (key v) + (cl-incf count) + (when (and (< 0 expected) + (= 0 (mod count 1000))) + (message "reindexing: %d of %d (%.2f%%)" + count expected (/ (* 100.0 count) expected))) + (dolist (val (cdr-safe (assq tr v))) + (let ((value-keys (registry-lookup-secondary-value db tr val))) + (push key value-keys) + (registry-lookup-secondary-value db tr val value-keys)))) + (oref db data))))) (cl-defmethod registry-prune ((db registry-db) &optional sortfunc) "Prune the registry-db object DB. diff --git a/lisp/repeat.el b/lisp/repeat.el index d4888893484..795577c93fc 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -239,9 +239,7 @@ recently executed command not bound to an input event\"." (car (memq last-command-event (listify-key-sequence repeat-on-final-keystroke)))))) - (if (memq last-repeatable-command '(exit-minibuffer - minibuffer-complete-and-exit - self-insert-and-exit)) + (if (eq last-repeatable-command (caar command-history)) (let ((repeat-command (car command-history))) (repeat-message "Repeating %S" repeat-command) (eval repeat-command)) diff --git a/lisp/replace.el b/lisp/replace.el index f13d27aff89..eb7a439b54a 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1161,6 +1161,7 @@ a previously found match." (define-key map "\C-o" 'occur-mode-display-occurrence) (define-key map "n" 'next-error-no-select) (define-key map "p" 'previous-error-no-select) + (define-key map "l" 'recenter-current-error) (define-key map "\M-n" 'occur-next) (define-key map "\M-p" 'occur-prev) (define-key map "r" 'occur-rename-buffer) @@ -1545,7 +1546,10 @@ You can add this to `occur-hook' if you always want a separate (with-current-buffer (if (eq major-mode 'occur-mode) (current-buffer) (get-buffer "*Occur*")) (rename-buffer (concat "*Occur: " - (mapconcat #'buffer-name + (mapconcat (lambda (boo) + (buffer-name (if (overlayp boo) + (overlay-buffer boo) + boo))) (car (cddr occur-revert-arguments)) "/") "*") (or unique-p (not interactive-p))))) @@ -1779,7 +1783,8 @@ See also `multi-occur'." 42) (window-width)) "" (occur-regexp-descr regexp)))) - (occur--garbage-collect-revert-args) + (unless (eq bufs (nth 2 occur-revert-arguments)) + (occur--garbage-collect-revert-args)) (setq occur-revert-arguments (list regexp nlines bufs)) (if (= count 0) (kill-buffer occur-buf) diff --git a/lisp/reveal.el b/lisp/reveal.el index c01afd9739a..697df45c5c3 100644 --- a/lisp/reveal.el +++ b/lisp/reveal.el @@ -67,13 +67,11 @@ revealed text manually." :type 'boolean :version "28.1") -(defvar reveal-open-spots nil +(defvar-local reveal-open-spots nil "List of spots in the buffer which are open. Each element has the form (WINDOW . OVERLAY).") -(make-variable-buffer-local 'reveal-open-spots) -(defvar reveal-last-tick nil) -(make-variable-buffer-local 'reveal-last-tick) +(defvar-local reveal-last-tick nil) ;; Actual code diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index 1e819044194..38283a5c568 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -572,10 +572,9 @@ This variable is expected to be made buffer-local by modes.") Call `ruler-mode-ruler-function' to compute the ruler value.") ;;;###autoload -(defvar ruler-mode nil +(defvar-local ruler-mode nil "Non-nil if Ruler mode is enabled. Use the command `ruler-mode' to change this variable.") -(make-variable-buffer-local 'ruler-mode) (defun ruler--save-header-line-format () "Install the header line format for Ruler mode. diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el index e8f69b29565..d283b8089ce 100644 --- a/lisp/scroll-lock.el +++ b/lisp/scroll-lock.el @@ -40,9 +40,8 @@ map) "Keymap for Scroll Lock mode.") -(defvar scroll-lock-preserve-screen-pos-save scroll-preserve-screen-position +(defvar-local scroll-lock-preserve-screen-pos-save scroll-preserve-screen-position "Used for saving the state of `scroll-preserve-screen-position'.") -(make-variable-buffer-local 'scroll-lock-preserve-screen-pos-save) (defvar scroll-lock-temporary-goal-column 0 "Like `temporary-goal-column' but for scroll-lock-* commands.") diff --git a/lisp/server.el b/lisp/server.el index b82e301d0aa..220694f6cbf 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -197,9 +197,8 @@ The created frame is selected when the hook is called." "List of current server clients. Each element is a process.") -(defvar server-buffer-clients nil +(defvar-local server-buffer-clients nil "List of client processes requesting editing of current buffer.") -(make-variable-buffer-local 'server-buffer-clients) ;; Changing major modes should not erase this local. (put 'server-buffer-clients 'permanent-local t) @@ -239,11 +238,10 @@ in this way." :type 'boolean :version "21.1") -(defvar server-existing-buffer nil +(defvar-local server-existing-buffer nil "Non-nil means the buffer existed before the server was asked to visit it. This means that the server should not kill the buffer when you say you are done with it in the server.") -(make-variable-buffer-local 'server-existing-buffer) (defvar server--external-socket-initialized nil "When an external socket is passed into Emacs, we need to call diff --git a/lisp/shell.el b/lisp/shell.el index 0f866158fe3..32128241655 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -26,9 +26,7 @@ ;;; Commentary: ;; This file defines a shell-in-a-buffer package (shell mode) built on -;; top of comint mode. This is actually cmushell with things renamed -;; to replace its counterpart in Emacs 18. cmushell is more -;; featureful, robust, and uniform than the Emacs 18 version. +;; top of comint mode. ;; Since this mode is built on top of the general command-interpreter-in- ;; a-buffer mode (comint mode), it shares a common base functionality, @@ -785,8 +783,7 @@ Make the shell buffer the current buffer, and return it. ;; that tracks cd, pushd, and popd commands issued to the shell, and ;; changes the current directory of the shell buffer accordingly. ;; -;; This is basically a fragile hack, although it's more accurate than -;; the version in Emacs 18's shell.el. It has the following failings: +;; This is basically a fragile hack. It has the following failings: ;; 1. It doesn't know about the cdpath shell variable. ;; 2. It cannot infallibly deal with command sequences, though it does well ;; with these and with ignoring commands forked in another shell with ()s. diff --git a/lisp/simple.el b/lisp/simple.el index 742fc5004dc..0c5bcb66724 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -134,10 +134,9 @@ messages are highlighted; this helps to see what messages were visited." :group 'next-error :version "28.1") -(defvar next-error--message-highlight-overlay +(defvar-local next-error--message-highlight-overlay nil "Overlay highlighting the current error message in the `next-error' buffer.") -(make-variable-buffer-local 'next-error--message-highlight-overlay) (defcustom next-error-hook nil "List of hook functions run by `next-error' after visiting source file." @@ -165,15 +164,14 @@ A buffer becomes most recent when its compilation, grep, or similar mode is started, or when it is used with \\[next-error] or \\[compile-goto-error].") -(defvar next-error-buffer nil +(defvar-local next-error-buffer nil "The buffer-local value of the most recent `next-error' buffer.") ;; next-error-buffer is made buffer-local to keep the reference ;; to the parent buffer used to navigate to the current buffer, so the ;; next call of next-buffer will use the same parent buffer to ;; continue navigation from it. -(make-variable-buffer-local 'next-error-buffer) -(defvar next-error-function nil +(defvar-local next-error-function nil "Function to use to find the next error in the current buffer. The function is called with 2 parameters: ARG is an integer specifying by how many errors to move. @@ -182,15 +180,13 @@ of the errors before moving. Major modes providing compile-like functionality should set this variable to indicate to `next-error' that this is a candidate buffer and how to navigate in it.") -(make-variable-buffer-local 'next-error-function) -(defvar next-error-move-function nil +(defvar-local next-error-move-function nil "Function to use to move to an error locus. It takes two arguments, a buffer position in the error buffer and a buffer position in the error locus buffer. The buffer for the error locus should already be current. nil means use goto-char using the second argument position.") -(make-variable-buffer-local 'next-error-move-function) (defsubst next-error-buffer-p (buffer &optional avoid-current @@ -496,6 +492,16 @@ buffer causes automatic display of the corresponding source code location." (overlay-put ol 'window (get-buffer-window)) (setf next-error--message-highlight-overlay ol))))) +(defun recenter-current-error (&optional arg) + "Recenter the current displayed error in the `next-error' buffer." + (interactive "P") + (save-selected-window + (let ((next-error-highlight next-error-highlight-no-select) + (display-buffer-overriding-action + '(nil (inhibit-same-window . t)))) + (next-error 0) + (set-buffer (window-buffer)) + (recenter-top-bottom arg)))) ;;; @@ -1268,9 +1274,8 @@ that uses or sets the mark." ;; Counting lines, one way or another. -(defvar goto-line-history nil +(defvar-local goto-line-history nil "History of values entered with `goto-line'.") -(make-variable-buffer-local 'goto-line-history) (defun goto-line-read-args (&optional relative) "Read arguments for `goto-line' related commands." @@ -1448,9 +1453,9 @@ included in the count." (save-excursion (save-restriction (narrow-to-region start end) - (goto-char (point-min)) (cond ((and (not ignore-invisible-lines) (eq selective-display t)) + (goto-char (point-min)) (save-match-data (let ((done 0)) (while (re-search-forward "\n\\|\r[^\n]" nil t 40) @@ -1463,6 +1468,7 @@ included in the count." (1+ done) done)))) (ignore-invisible-lines + (goto-char (point-min)) (save-match-data (- (buffer-size) (forward-line (buffer-size)) @@ -1477,27 +1483,11 @@ included in the count." (assq prop buffer-invisibility-spec))) (setq invisible-count (1+ invisible-count)))) invisible-count)))) - (t (- (buffer-size) (forward-line (buffer-size)))))))) - -(defun line-number-at-pos (&optional pos absolute) - "Return buffer line number at position POS. -If POS is nil, use current buffer location. - -If ABSOLUTE is nil, the default, counting starts -at (point-min), so the value refers to the contents of the -accessible portion of the (potentially narrowed) buffer. If -ABSOLUTE is non-nil, ignore any narrowing and return the -absolute line number." - (save-restriction - (when absolute - (widen)) - (let ((opoint (or pos (point))) start) - (save-excursion - (goto-char (point-min)) - (setq start (point)) - (goto-char opoint) - (forward-line 0) - (1+ (count-lines start (point))))))) + (t + (goto-char (point-max)) + (if (bolp) + (1- (line-number-at-pos)) + (line-number-at-pos))))))) (defcustom what-cursor-show-names nil "Whether to show character names in `what-cursor-position'." @@ -1819,31 +1809,34 @@ this command arranges for all errors to enter the debugger." (cons (read--expression "Eval: ") (eval-expression-get-print-arguments current-prefix-arg))) - (if (null eval-expression-debug-on-error) - (push (eval (let ((lexical-binding t)) (macroexpand-all exp)) t) - values) - (let ((old-value (make-symbol "t")) new-value) - ;; Bind debug-on-error to something unique so that we can - ;; detect when evalled code changes it. - (let ((debug-on-error old-value)) - (push (eval (let ((lexical-binding t)) (macroexpand-all exp)) t) - values) - (setq new-value debug-on-error)) - ;; If evalled code has changed the value of debug-on-error, - ;; propagate that change to the global binding. - (unless (eq old-value new-value) - (setq debug-on-error new-value)))) - - (let ((print-length (unless no-truncate eval-expression-print-length)) - (print-level (unless no-truncate eval-expression-print-level)) - (eval-expression-print-maximum-character char-print-limit) - (deactivate-mark)) - (let ((out (if insert-value (current-buffer) t))) - (prog1 - (prin1 (car values) out) - (let ((str (and char-print-limit - (eval-expression-print-format (car values))))) - (when str (princ str out))))))) + (let (result) + (if (null eval-expression-debug-on-error) + (setq result + (values--store-value + (eval (let ((lexical-binding t)) (macroexpand-all exp)) t))) + (let ((old-value (make-symbol "t")) new-value) + ;; Bind debug-on-error to something unique so that we can + ;; detect when evalled code changes it. + (let ((debug-on-error old-value)) + (setq result + (values--store-value + (eval (let ((lexical-binding t)) (macroexpand-all exp)) t))) + (setq new-value debug-on-error)) + ;; If evalled code has changed the value of debug-on-error, + ;; propagate that change to the global binding. + (unless (eq old-value new-value) + (setq debug-on-error new-value)))) + + (let ((print-length (unless no-truncate eval-expression-print-length)) + (print-level (unless no-truncate eval-expression-print-level)) + (eval-expression-print-maximum-character char-print-limit) + (deactivate-mark)) + (let ((out (if insert-value (current-buffer) t))) + (prog1 + (prin1 result out) + (let ((str (and char-print-limit + (eval-expression-print-format result)))) + (when str (princ str out)))))))) (defun edit-and-eval-command (prompt command) "Prompting with PROMPT, let user edit COMMAND and eval result. @@ -2309,14 +2302,12 @@ once. In special cases, when this function needs to be called more than once, it can set `minibuffer-default-add-done' to nil explicitly, overriding the setting of this variable to t in `goto-history-element'.") -(defvar minibuffer-default-add-done nil +(defvar-local minibuffer-default-add-done nil "When nil, add more elements to the end of the list of default values. The value nil causes `goto-history-element' to add more elements to the list of defaults when it reaches the end of this list. It does this by calling a function defined by `minibuffer-default-add-function'.") -(make-variable-buffer-local 'minibuffer-default-add-done) - (defun minibuffer-default-add-completions () "Return a list of all completions without the default value. This function is used to add all elements of the completion table to @@ -3480,13 +3471,12 @@ excessively long before answering the question." :group 'undo :version "22.1") -(defvar undo-extra-outer-limit nil +(defvar-local undo-extra-outer-limit nil "If non-nil, an extra level of size that's ok in an undo item. We don't ask the user about truncating the undo list until the current item gets bigger than this amount. This variable matters only if `undo-ask-before-discard' is non-nil.") -(make-variable-buffer-local 'undo-extra-outer-limit) ;; When the first undo batch in an undo list is longer than ;; undo-outer-limit, this function gets called to warn the user that diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 7f751ec3476..e43978f4137 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -5,15 +5,6 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: file, tags, tools -(defvar speedbar-version "1.0" - "The current version of speedbar.") -(make-obsolete-variable 'speedbar-version nil "28.1") -(defvar speedbar-incompatible-version "0.14beta4" - "This version of speedbar is incompatible with this version. -Due to massive API changes (removing the use of the word PATH) -this version is not backward compatible to 0.14 or earlier.") -(make-obsolete-variable 'speedbar-incompatible-version nil "28.1") - ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify @@ -4087,6 +4078,19 @@ See `speedbar-expand-image-button-alist' for details." (setq ia (cdr ia))))))) +;; Obsolete + +(defvar speedbar-version "1.0" + "The current version of speedbar.") +(make-obsolete-variable 'speedbar-version 'emacs-version "28.1") + +(defvar speedbar-incompatible-version "0.14beta4" + "This version of speedbar is incompatible with this version. +Due to massive API changes (removing the use of the word PATH) +this version is not backward compatible to 0.14 or earlier.") +(make-obsolete-variable 'speedbar-incompatible-version nil "28.1") + + (provide 'speedbar) ;; run load-time hooks diff --git a/lisp/startup.el b/lisp/startup.el index ec58418186c..ae0ac3cb933 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1394,7 +1394,7 @@ please check its value") (equal user-mail-address (let (mail-host-address) (ignore-errors - (eval (car (get 'user-mail-address 'standard-value)))))) + (custom--standard-value 'user-mail-address)))) (custom-reevaluate-setting 'user-mail-address)) ;; If parameter have been changed in the init file which influence diff --git a/lisp/subr.el b/lisp/subr.el index b5f7dfd5026..8559be6fe1b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1660,6 +1660,12 @@ The return value has the form (WIDTH . HEIGHT). POSITION should be a list of the form returned by `event-start' and `event-end'." (nth 9 position)) +(defun values--store-value (value) + "Store VALUE in the obsolete `values' variable." + (with-suppressed-warnings ((obsolete values)) + (push value values)) + value) + ;;;; Obsolescent names for functions. @@ -1699,13 +1705,13 @@ be a list of the form returned by `event-start' and `event-end'." ;;;; Obsolescence declarations for variables, and aliases. -(make-obsolete-variable 'define-key-rebound-commands nil "23.2") (make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1") (make-obsolete-variable 'deferred-action-list 'post-command-hook "24.1") (make-obsolete-variable 'deferred-action-function 'post-command-hook "24.1") (make-obsolete-variable 'redisplay-dont-pause nil "24.5") (make-obsolete 'window-redisplay-end-trigger nil "23.1") (make-obsolete 'set-window-redisplay-end-trigger nil "23.1") +(make-obsolete-variable 'operating-system-release nil "28.1") (make-obsolete 'run-window-configuration-change-hook nil "27.1") @@ -1726,6 +1732,10 @@ be a list of the form returned by `event-start' and `event-end'." (make-obsolete-variable 'load-dangerous-libraries "no longer used." "27.1") +;; We can't actually make `values' obsolete, because that will result +;; in warnings when using `values' in let-bindings. +;;(make-obsolete-variable 'values "no longer used" "28.1") + ;;;; Alternate names for functions - these are not being phased out. @@ -2233,9 +2243,13 @@ Affects only hooks run in the current buffer." ;; PUBLIC: find if the current mode derives from another. (defun provided-mode-derived-p (mode &rest modes) - "Non-nil if MODE is derived from one of MODES or their aliases. + "Non-nil if MODE is derived from one of MODES. Uses the `derived-mode-parent' property of the symbol to trace backwards. If you just want to check `major-mode', use `derived-mode-p'." + ;; If MODE is an alias, then look up the real mode function first. + (when-let ((alias (symbol-function mode))) + (when (symbolp alias) + (setq mode alias))) (while (and (not (memq mode modes)) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 7e556550daa..6720d82b471 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1308,8 +1308,7 @@ For more information, see the function `tab-switcher'." (setq buffer-read-only t) (current-buffer)))) -(defvar tab-switcher-column 3) -(make-variable-buffer-local 'tab-switcher-column) +(defvar-local tab-switcher-column 3) (defvar tab-switcher-mode-map (let ((map (make-keymap))) diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 9209f2d46ec..1bdddc2c83e 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -810,9 +810,7 @@ from the tab line." :version "27.1") ;;;###autoload -(defvar tab-line-exclude nil) -;;;###autoload -(make-variable-buffer-local 'tab-line-exclude) +(defvar-local tab-line-exclude nil) (defun tab-line-mode--turn-on () "Turn on `tab-line-mode'." diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index cd53d7b6ff4..89a71ac2b87 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -149,12 +149,11 @@ This information is useful, but it takes screen space away from file names." ;; So instead, we now keep the two pieces of data in separate buffers, and ;; use the new buffer-swap-text primitive when we need to change which data ;; is associated with "the" buffer. -(defvar tar-data-buffer nil "Buffer that holds the actual raw tar bytes.") -(make-variable-buffer-local 'tar-data-buffer) +(defvar-local tar-data-buffer nil + "Buffer that holds the actual raw tar bytes.") -(defvar tar-data-swapped nil +(defvar-local tar-data-swapped nil "If non-nil, `tar-data-buffer' indeed holds raw tar bytes.") -(make-variable-buffer-local 'tar-data-swapped) (defun tar-data-swapped-p () "Return non-nil if the tar-data is in `tar-data-buffer'." diff --git a/lisp/term.el b/lisp/term.el index 8a560e85d58..6beb17fb66f 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -683,8 +683,7 @@ Buffer local variable.") "Index of last matched history element.") (defvar term-matching-input-from-input-string "" "Input previously used to match input history.") -; This argument to set-process-filter disables reading from the process, -; assuming this is Emacs 19.20 or newer. +; This argument to set-process-filter disables reading from the process. (defvar term-pager-filter t) (put 'term-input-ring 'permanent-local t) @@ -2813,333 +2812,334 @@ See `term-prompt-regexp'." "[\032\e]") (defun term-emulate-terminal (proc str) - (with-current-buffer (process-buffer proc) - (let* ((i 0) funny - decoded-substring - save-point save-marker win - (inhibit-read-only t) - (buffer-undo-list t) - (selected (selected-window)) - last-win - (str-length (length str))) - (save-selected-window - - (when (marker-buffer term-pending-delete-marker) - ;; Delete text following term-pending-delete-marker. - (delete-region term-pending-delete-marker (process-mark proc)) - (set-marker term-pending-delete-marker nil)) - - (when (/= (point) (process-mark proc)) - (setq save-point (point-marker))) - - (setf term-vertical-motion - (if (eq (window-buffer) (current-buffer)) - 'vertical-motion - 'term-buffer-vertical-motion)) - (setq save-marker (copy-marker (process-mark proc))) - (goto-char (process-mark proc)) - - (save-restriction - ;; If the buffer is in line mode, and there is a partial - ;; input line, save the line (by narrowing to leave it - ;; outside the restriction ) until we're done with output. - (when (and (> (point-max) (process-mark proc)) - (term-in-line-mode)) - (narrow-to-region (point-min) (process-mark proc))) - - (when term-log-buffer - (princ str term-log-buffer)) - (when term-terminal-undecoded-bytes - (setq str (concat term-terminal-undecoded-bytes str)) - (setq str-length (length str)) - (setq term-terminal-undecoded-bytes nil)) - - (while (< i str-length) - (setq funny (string-match term-control-seq-regexp str i)) - (let ((ctl-params (and funny (match-string 1 str))) - (ctl-params-end (and funny (match-end 1))) - (ctl-end (if funny (match-end 0) - (setq funny (string-match term-control-seq-prefix-regexp str i)) - (if funny - (setq term-terminal-undecoded-bytes - (substring str funny)) - (setq funny str-length)) - ;; The control sequence ends somewhere - ;; past the end of this string. - (1+ str-length)))) - (when (> funny i) - (when term-do-line-wrapping - (term-down 1 t) - (term-move-to-column 0) - (setq term-do-line-wrapping nil)) - ;; Handle non-control data. Decode the string before - ;; counting characters, to avoid garbling of certain - ;; multibyte characters (bug#1006). - (setq decoded-substring - (decode-coding-string - (substring str i funny) - locale-coding-system t)) - ;; Check for multibyte characters that ends - ;; before end of string, and save it for - ;; next time. - (when (= funny str-length) - (let ((partial 0) - (count (length decoded-substring))) - (while (and (< partial count) - (eq (char-charset (aref decoded-substring - (- count 1 partial))) - 'eight-bit)) - (cl-incf partial)) - (when (> count partial 0) - (setq term-terminal-undecoded-bytes - (substring decoded-substring (- partial))) - (setq decoded-substring - (substring decoded-substring 0 (- partial))) - (cl-decf str-length partial) - (cl-decf funny partial)))) - - ;; Insert a string, check how many columns - ;; we moved, then delete that many columns - ;; following point if not eob nor insert-mode. - (let ((old-column (term-horizontal-column)) - (old-point (point)) - columns) - (unless term-suppress-hard-newline - (while (> (+ (length decoded-substring) old-column) - term-width) - (insert (substring decoded-substring 0 - (- term-width old-column))) - ;; Since we've enough text to fill the whole line, - ;; delete previous text regardless of - ;; `term-insert-mode's value. - (delete-region (point) (line-end-position)) - (term-down 1 t) - (term-move-columns (- (term-current-column))) - (add-text-properties (1- (point)) (point) - '(term-line-wrap t rear-nonsticky t)) - (setq decoded-substring - (substring decoded-substring (- term-width old-column))) - (setq old-column 0))) - (insert decoded-substring) - (setq term-current-column (current-column) - columns (- term-current-column old-column)) - (when (not (or (eobp) term-insert-mode)) - (let ((pos (point))) - (term-move-columns columns) - (delete-region pos (point)) - (setq term-current-column nil))) - ;; In insert mode if the current line - ;; has become too long it needs to be - ;; chopped off. - (when term-insert-mode - (let ((pos (point))) - (end-of-line) - (when (> (current-column) term-width) - (delete-region (- (point) (- (current-column) term-width)) - (point))) - (goto-char pos))) - - (put-text-property old-point (point) - 'font-lock-face term-current-face)) - ;; If the last char was written in last column, - ;; back up one column, but remember we did so. - ;; Thus we emulate xterm/vt100-style line-wrapping. - (when (eq (term-current-column) term-width) - (term-move-columns -1) - ;; We check after ctrl sequence handling if point - ;; was moved (and leave line-wrapping state if so). - (setq term-do-line-wrapping (point))) - (setq term-current-column nil) - (setq i funny)) - (pcase-exhaustive (and (<= ctl-end str-length) (aref str i)) - (?\t ;; TAB (terminfo: ht) - ;; The line cannot exceed term-width. TAB at - ;; the end of a line should not cause wrapping. - (let ((col (term-current-column))) - (term-move-to-column - (min (1- term-width) - (+ col 8 (- (mod col 8))))))) - (?\r ;; (terminfo: cr) - (term-vertical-motion 0) - (setq term-current-column term-start-line-column)) - (?\n ;; (terminfo: cud1, ind) - (unless (and term-kill-echo-list - (term-check-kill-echo-list)) - (term-down 1 t))) - (?\b ;; (terminfo: cub1) - (term-move-columns -1)) - (?\C-g ;; (terminfo: bel) - (beep t)) - (?\032 ; Emacs specific control sequence. - (funcall term-command-function - (decode-coding-string - (substring str (1+ i) - (- ctl-end - (if (eq (aref str (- ctl-end 2)) ?\r) - 2 1))) - locale-coding-system t))) - (?\e - (pcase (aref str (1+ i)) - (?\[ - ;; We only handle control sequences with a single - ;; "Final" byte (see [ECMA-48] section 5.4). - (when (eq ctl-params-end (1- ctl-end)) - (term-handle-ansi-escape - proc - (mapcar ;; We don't distinguish empty params - ;; from 0 (according to [ECMA-48] we - ;; should, but all commands we support - ;; default to 0 values anyway). - #'string-to-number - (split-string ctl-params ";")) - (aref str (1- ctl-end))))) - (?D ;; Scroll forward (apparently not documented in - ;; [ECMA-48], [ctlseqs] mentions it as C1 - ;; character "Index" though). - (term-handle-deferred-scroll) - (term-down 1 t)) - (?M ;; Scroll reversed (terminfo: ri, ECMA-48 - ;; "Reverse Linefeed"). - (if (or (< (term-current-row) term-scroll-start) - (>= (1- (term-current-row)) - term-scroll-start)) - ;; Scrolling up will not move outside - ;; the scroll region. - (term-down -1) - ;; Scrolling the scroll region is needed. - (term-down -1 t))) - (?7 ;; Save cursor (terminfo: sc, not in [ECMA-48], - ;; [ctlseqs] has it as "DECSC"). - (term-handle-deferred-scroll) - (setq term-saved-cursor - (list (term-current-row) - (term-horizontal-column) - term-ansi-current-bg-color - term-ansi-current-bold - term-ansi-current-color - term-ansi-current-invisible - term-ansi-current-reverse - term-ansi-current-underline - term-current-face))) - (?8 ;; Restore cursor (terminfo: rc, [ctlseqs] - ;; "DECRC"). - (when term-saved-cursor - (term-goto (nth 0 term-saved-cursor) - (nth 1 term-saved-cursor)) - (setq term-ansi-current-bg-color - (nth 2 term-saved-cursor) - term-ansi-current-bold - (nth 3 term-saved-cursor) - term-ansi-current-color - (nth 4 term-saved-cursor) - term-ansi-current-invisible - (nth 5 term-saved-cursor) - term-ansi-current-reverse - (nth 6 term-saved-cursor) - term-ansi-current-underline - (nth 7 term-saved-cursor) - term-current-face - (nth 8 term-saved-cursor)))) - (?c ;; \Ec - Reset (terminfo: rs1, [ctlseqs] "RIS"). - ;; This is used by the "clear" program. - (term-reset-terminal)) - (?A ;; An \eAnSiT sequence (Emacs specific). - (term-handle-ansi-terminal-messages - (substring str i ctl-end))))) - ;; Ignore NUL, Shift Out, Shift In. - ((or ?\0 #xE #xF 'nil) nil)) - ;; Leave line-wrapping state if point was moved. - (unless (eq term-do-line-wrapping (point)) - (setq term-do-line-wrapping nil)) - (if (term-handling-pager) - (progn - ;; Finish stuff to get ready to handle PAGER. - (if (> (% (current-column) term-width) 0) + (when (buffer-live-p (process-buffer proc)) + (with-current-buffer (process-buffer proc) + (let* ((i 0) funny + decoded-substring + save-point save-marker win + (inhibit-read-only t) + (buffer-undo-list t) + (selected (selected-window)) + last-win + (str-length (length str))) + (save-selected-window + + (when (marker-buffer term-pending-delete-marker) + ;; Delete text following term-pending-delete-marker. + (delete-region term-pending-delete-marker (process-mark proc)) + (set-marker term-pending-delete-marker nil)) + + (when (/= (point) (process-mark proc)) + (setq save-point (point-marker))) + + (setf term-vertical-motion + (if (eq (window-buffer) (current-buffer)) + 'vertical-motion + 'term-buffer-vertical-motion)) + (setq save-marker (copy-marker (process-mark proc))) + (goto-char (process-mark proc)) + + (save-restriction + ;; If the buffer is in line mode, and there is a partial + ;; input line, save the line (by narrowing to leave it + ;; outside the restriction ) until we're done with output. + (when (and (> (point-max) (process-mark proc)) + (term-in-line-mode)) + (narrow-to-region (point-min) (process-mark proc))) + + (when term-log-buffer + (princ str term-log-buffer)) + (when term-terminal-undecoded-bytes + (setq str (concat term-terminal-undecoded-bytes str)) + (setq str-length (length str)) + (setq term-terminal-undecoded-bytes nil)) + + (while (< i str-length) + (setq funny (string-match term-control-seq-regexp str i)) + (let ((ctl-params (and funny (match-string 1 str))) + (ctl-params-end (and funny (match-end 1))) + (ctl-end (if funny (match-end 0) + (setq funny (string-match term-control-seq-prefix-regexp str i)) + (if funny + (setq term-terminal-undecoded-bytes + (substring str funny)) + (setq funny str-length)) + ;; The control sequence ends somewhere + ;; past the end of this string. + (1+ str-length)))) + (when (> funny i) + (when term-do-line-wrapping + (term-down 1 t) + (term-move-to-column 0) + (setq term-do-line-wrapping nil)) + ;; Handle non-control data. Decode the string before + ;; counting characters, to avoid garbling of certain + ;; multibyte characters (bug#1006). + (setq decoded-substring + (decode-coding-string + (substring str i funny) + locale-coding-system t)) + ;; Check for multibyte characters that ends + ;; before end of string, and save it for + ;; next time. + (when (= funny str-length) + (let ((partial 0) + (count (length decoded-substring))) + (while (and (< partial count) + (eq (char-charset (aref decoded-substring + (- count 1 partial))) + 'eight-bit)) + (cl-incf partial)) + (when (> count partial 0) (setq term-terminal-undecoded-bytes - (substring str i)) - ;; We're at column 0. Goto end of buffer; to compensate, - ;; prepend a ?\r for later. This looks more consistent. - (if (zerop i) + (substring decoded-substring (- partial))) + (setq decoded-substring + (substring decoded-substring 0 (- partial))) + (cl-decf str-length partial) + (cl-decf funny partial)))) + + ;; Insert a string, check how many columns + ;; we moved, then delete that many columns + ;; following point if not eob nor insert-mode. + (let ((old-column (term-horizontal-column)) + (old-point (point)) + columns) + (unless term-suppress-hard-newline + (while (> (+ (length decoded-substring) old-column) + term-width) + (insert (substring decoded-substring 0 + (- term-width old-column))) + ;; Since we've enough text to fill the whole line, + ;; delete previous text regardless of + ;; `term-insert-mode's value. + (delete-region (point) (line-end-position)) + (term-down 1 t) + (term-move-columns (- (term-current-column))) + (add-text-properties (1- (point)) (point) + '(term-line-wrap t rear-nonsticky t)) + (setq decoded-substring + (substring decoded-substring (- term-width old-column))) + (setq old-column 0))) + (insert decoded-substring) + (setq term-current-column (current-column) + columns (- term-current-column old-column)) + (when (not (or (eobp) term-insert-mode)) + (let ((pos (point))) + (term-move-columns columns) + (delete-region pos (point)) + (setq term-current-column nil))) + ;; In insert mode if the current line + ;; has become too long it needs to be + ;; chopped off. + (when term-insert-mode + (let ((pos (point))) + (end-of-line) + (when (> (current-column) term-width) + (delete-region (- (point) (- (current-column) term-width)) + (point))) + (goto-char pos))) + + (put-text-property old-point (point) + 'font-lock-face term-current-face)) + ;; If the last char was written in last column, + ;; back up one column, but remember we did so. + ;; Thus we emulate xterm/vt100-style line-wrapping. + (when (eq (term-current-column) term-width) + (term-move-columns -1) + ;; We check after ctrl sequence handling if point + ;; was moved (and leave line-wrapping state if so). + (setq term-do-line-wrapping (point))) + (setq term-current-column nil) + (setq i funny)) + (pcase-exhaustive (and (<= ctl-end str-length) (aref str i)) + (?\t ;; TAB (terminfo: ht) + ;; The line cannot exceed term-width. TAB at + ;; the end of a line should not cause wrapping. + (let ((col (term-current-column))) + (term-move-to-column + (min (1- term-width) + (+ col 8 (- (mod col 8))))))) + (?\r ;; (terminfo: cr) + (term-vertical-motion 0) + (setq term-current-column term-start-line-column)) + (?\n ;; (terminfo: cud1, ind) + (unless (and term-kill-echo-list + (term-check-kill-echo-list)) + (term-down 1 t))) + (?\b ;; (terminfo: cub1) + (term-move-columns -1)) + (?\C-g ;; (terminfo: bel) + (beep t)) + (?\032 ; Emacs specific control sequence. + (funcall term-command-function + (decode-coding-string + (substring str (1+ i) + (- ctl-end + (if (eq (aref str (- ctl-end 2)) ?\r) + 2 1))) + locale-coding-system t))) + (?\e + (pcase (aref str (1+ i)) + (?\[ + ;; We only handle control sequences with a single + ;; "Final" byte (see [ECMA-48] section 5.4). + (when (eq ctl-params-end (1- ctl-end)) + (term-handle-ansi-escape + proc + (mapcar ;; We don't distinguish empty params + ;; from 0 (according to [ECMA-48] we + ;; should, but all commands we support + ;; default to 0 values anyway). + #'string-to-number + (split-string ctl-params ";")) + (aref str (1- ctl-end))))) + (?D ;; Scroll forward (apparently not documented in + ;; [ECMA-48], [ctlseqs] mentions it as C1 + ;; character "Index" though). + (term-handle-deferred-scroll) + (term-down 1 t)) + (?M ;; Scroll reversed (terminfo: ri, ECMA-48 + ;; "Reverse Linefeed"). + (if (or (< (term-current-row) term-scroll-start) + (>= (1- (term-current-row)) + term-scroll-start)) + ;; Scrolling up will not move outside + ;; the scroll region. + (term-down -1) + ;; Scrolling the scroll region is needed. + (term-down -1 t))) + (?7 ;; Save cursor (terminfo: sc, not in [ECMA-48], + ;; [ctlseqs] has it as "DECSC"). + (term-handle-deferred-scroll) + (setq term-saved-cursor + (list (term-current-row) + (term-horizontal-column) + term-ansi-current-bg-color + term-ansi-current-bold + term-ansi-current-color + term-ansi-current-invisible + term-ansi-current-reverse + term-ansi-current-underline + term-current-face))) + (?8 ;; Restore cursor (terminfo: rc, [ctlseqs] + ;; "DECRC"). + (when term-saved-cursor + (term-goto (nth 0 term-saved-cursor) + (nth 1 term-saved-cursor)) + (setq term-ansi-current-bg-color + (nth 2 term-saved-cursor) + term-ansi-current-bold + (nth 3 term-saved-cursor) + term-ansi-current-color + (nth 4 term-saved-cursor) + term-ansi-current-invisible + (nth 5 term-saved-cursor) + term-ansi-current-reverse + (nth 6 term-saved-cursor) + term-ansi-current-underline + (nth 7 term-saved-cursor) + term-current-face + (nth 8 term-saved-cursor)))) + (?c ;; \Ec - Reset (terminfo: rs1, [ctlseqs] "RIS"). + ;; This is used by the "clear" program. + (term-reset-terminal)) + (?A ;; An \eAnSiT sequence (Emacs specific). + (term-handle-ansi-terminal-messages + (substring str i ctl-end))))) + ;; Ignore NUL, Shift Out, Shift In. + ((or ?\0 #xE #xF 'nil) nil)) + ;; Leave line-wrapping state if point was moved. + (unless (eq term-do-line-wrapping (point)) + (setq term-do-line-wrapping nil)) + (if (term-handling-pager) + (progn + ;; Finish stuff to get ready to handle PAGER. + (if (> (% (current-column) term-width) 0) (setq term-terminal-undecoded-bytes - (concat "\r" (substring str i))) - (setq term-terminal-undecoded-bytes (substring str (1- i))) - (aset term-terminal-undecoded-bytes 0 ?\r)) - (goto-char (point-max))) - ;; FIXME: Use (add-function :override (process-filter proc) - (setq-local term-pager-old-filter (process-filter proc)) - ;; FIXME: Where is `term-pager-filter' set to a function?! - (set-process-filter proc term-pager-filter) - (setq i str-length)) - (setq i ctl-end))))) - - (when (>= (term-current-row) term-height) - (term-handle-deferred-scroll)) - - (set-marker (process-mark proc) (point)) - (when (stringp decoded-substring) - (term-watch-for-password-prompt decoded-substring)) - (when save-point - (goto-char save-point) - (set-marker save-point nil)) - - ;; Check for a pending filename-and-line number to display. - ;; We do this before scrolling, because we might create a new window. - (when (and term-pending-frame - (eq (window-buffer selected) (current-buffer))) - (term-display-line (car term-pending-frame) - (cdr term-pending-frame)) - (setq term-pending-frame nil)) - - ;; Scroll each window displaying the buffer but (by default) - ;; only if the point matches the process-mark we started with. - (setq win selected) - ;; Avoid infinite loop in strange case where minibuffer window - ;; is selected but not active. - (while (window-minibuffer-p win) - (setq win (next-window win nil t))) - (setq last-win win) - (while (progn - (setq win (next-window win nil t)) - (when (eq (window-buffer win) (process-buffer proc)) - (let ((scroll term-scroll-to-bottom-on-output)) - (select-window win) - (when (or (= (point) save-marker) - (eq scroll t) (eq scroll 'all) - ;; Maybe user wants point to jump to the end. - (and (eq selected win) - (or (eq scroll 'this) (not save-point))) - (and (eq scroll 'others) - (not (eq selected win)))) - (when term-scroll-snap-to-bottom - (goto-char term-home-marker) - (recenter 0)) - (goto-char (process-mark proc)) - (if (not (pos-visible-in-window-p (point) win)) - (recenter -1))) - ;; Optionally scroll so that the text - ;; ends at the bottom of the window. - (when (and term-scroll-show-maximum-output - (>= (point) (process-mark proc)) - (or term-scroll-snap-to-bottom - (not (pos-visible-in-window-p - (point-max) win)))) - (save-excursion - (goto-char (point-max)) - (recenter -1))))) - (not (eq win last-win)))) - - ;; Stolen from comint.el and adapted -mm - (when (> term-buffer-maximum-size 0) - (save-excursion - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (forward-line (- term-buffer-maximum-size)) - (beginning-of-line) - (delete-region (point-min) (point)))) - (set-marker save-marker nil))) - ;; This might be expensive, but we need it to handle something - ;; like `sleep 5 | less -c' in more-or-less real time. - (when (get-buffer-window (current-buffer)) - (redisplay)))) + (substring str i)) + ;; We're at column 0. Goto end of buffer; to compensate, + ;; prepend a ?\r for later. This looks more consistent. + (if (zerop i) + (setq term-terminal-undecoded-bytes + (concat "\r" (substring str i))) + (setq term-terminal-undecoded-bytes (substring str (1- i))) + (aset term-terminal-undecoded-bytes 0 ?\r)) + (goto-char (point-max))) + ;; FIXME: Use (add-function :override (process-filter proc) + (setq-local term-pager-old-filter (process-filter proc)) + ;; FIXME: Where is `term-pager-filter' set to a function?! + (set-process-filter proc term-pager-filter) + (setq i str-length)) + (setq i ctl-end))))) + + (when (>= (term-current-row) term-height) + (term-handle-deferred-scroll)) + + (set-marker (process-mark proc) (point)) + (when (stringp decoded-substring) + (term-watch-for-password-prompt decoded-substring)) + (when save-point + (goto-char save-point) + (set-marker save-point nil)) + + ;; Check for a pending filename-and-line number to display. + ;; We do this before scrolling, because we might create a new window. + (when (and term-pending-frame + (eq (window-buffer selected) (current-buffer))) + (term-display-line (car term-pending-frame) + (cdr term-pending-frame)) + (setq term-pending-frame nil)) + + ;; Scroll each window displaying the buffer but (by default) + ;; only if the point matches the process-mark we started with. + (setq win selected) + ;; Avoid infinite loop in strange case where minibuffer window + ;; is selected but not active. + (while (window-minibuffer-p win) + (setq win (next-window win nil t))) + (setq last-win win) + (while (progn + (setq win (next-window win nil t)) + (when (eq (window-buffer win) (process-buffer proc)) + (let ((scroll term-scroll-to-bottom-on-output)) + (select-window win) + (when (or (= (point) save-marker) + (eq scroll t) (eq scroll 'all) + ;; Maybe user wants point to jump to the end. + (and (eq selected win) + (or (eq scroll 'this) (not save-point))) + (and (eq scroll 'others) + (not (eq selected win)))) + (when term-scroll-snap-to-bottom + (goto-char term-home-marker) + (recenter 0)) + (goto-char (process-mark proc)) + (if (not (pos-visible-in-window-p (point) win)) + (recenter -1))) + ;; Optionally scroll so that the text + ;; ends at the bottom of the window. + (when (and term-scroll-show-maximum-output + (>= (point) (process-mark proc)) + (or term-scroll-snap-to-bottom + (not (pos-visible-in-window-p + (point-max) win)))) + (save-excursion + (goto-char (point-max)) + (recenter -1))))) + (not (eq win last-win)))) + + ;; Stolen from comint.el and adapted -mm + (when (> term-buffer-maximum-size 0) + (save-excursion + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (forward-line (- term-buffer-maximum-size)) + (beginning-of-line) + (delete-region (point-min) (point)))) + (set-marker save-marker nil))) + ;; This might be expensive, but we need it to handle something + ;; like `sleep 5 | less -c' in more-or-less real time. + (when (get-buffer-window (current-buffer)) + (redisplay))))) (defvar-local term-goto-process-mark t "Whether to reset point to the current process mark after this command. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 94e9d5c5828..af1e388c2a3 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -374,9 +374,8 @@ prompting. If file is a directory perform a `find-file' on it." (find-file f) (push-mark (+ (point) (cadr (insert-file-contents f))))))) -(defvar ns-select-overlay nil +(defvar-local ns-select-overlay nil "Overlay used to highlight areas in files requested by Nextstep apps.") -(make-variable-buffer-local 'ns-select-overlay) (defvar ns-input-line) ; nsterm.m diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index 50c00c95320..e66adb43e75 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -408,57 +408,43 @@ be in `artist-spray-chars', or spraying will behave strangely.") ;; Internal variables ;; -(defvar artist-mode nil - "Non-nil to enable `artist-mode' and nil to disable.") -(make-variable-buffer-local 'artist-mode) - (defvar artist-mode-name " Artist" "Name of Artist mode beginning with a space (appears in the mode-line).") -(defvar artist-curr-go 'pen-line +(defvar-local artist-curr-go 'pen-line "Current selected graphics operation.") -(make-variable-buffer-local 'artist-curr-go) -(defvar artist-line-char-set nil +(defvar-local artist-line-char-set nil "Boolean to tell whether user has set some char to use when drawing lines.") -(make-variable-buffer-local 'artist-line-char-set) -(defvar artist-line-char nil +(defvar-local artist-line-char nil "Char to use when drawing lines.") -(make-variable-buffer-local 'artist-line-char) -(defvar artist-fill-char-set nil +(defvar-local artist-fill-char-set nil "Boolean to tell whether user has set some char to use when filling.") -(make-variable-buffer-local 'artist-fill-char-set) -(defvar artist-fill-char nil +(defvar-local artist-fill-char nil "Char to use when filling.") -(make-variable-buffer-local 'artist-fill-char) -(defvar artist-erase-char ?\s +(defvar-local artist-erase-char ?\s "Char to use when erasing.") -(make-variable-buffer-local 'artist-erase-char) -(defvar artist-default-fill-char ?. +(defvar-local artist-default-fill-char ?. "Char to use when a fill-char is required but none is set.") -(make-variable-buffer-local 'artist-default-fill-char) ; This variable is not buffer local (defvar artist-copy-buffer nil "Copy buffer.") -(defvar artist-draw-region-min-y 0 +(defvar-local artist-draw-region-min-y 0 "Line-number for top-most visited line for draw operation.") -(make-variable-buffer-local 'artist-draw-region-min-y) -(defvar artist-draw-region-max-y 0 +(defvar-local artist-draw-region-max-y 0 "Line-number for bottom-most visited line for draw operation.") -(make-variable-buffer-local 'artist-draw-region-max-y) -(defvar artist-borderless-shapes nil +(defvar-local artist-borderless-shapes nil "When non-nil, draw shapes without border. The fill char is used instead, if it is set.") -(make-variable-buffer-local 'artist-borderless-shapes) (defvar artist-prev-next-op-alist nil "Assoc list for looking up next and/or previous draw operation. diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el index 1e22287d32e..ec21987bbf5 100644 --- a/lisp/textmodes/bib-mode.el +++ b/lisp/textmodes/bib-mode.el @@ -1,4 +1,4 @@ -;;; bib-mode.el --- major mode for editing bib files +;;; bib-mode.el --- major mode for editing bib files -*- lexical-binding: t -*- ;; Copyright (C) 1989, 2001-2021 Free Software Foundation, Inc. @@ -39,13 +39,11 @@ (defcustom bib-file "~/my-bibliography.bib" "Default name of file used by `addbib'." - :type 'file - :group 'bib) + :type 'file) (defcustom unread-bib-file "~/to-be-read.bib" "Default name of file used by `unread-bib' in Bib mode." - :type 'file - :group 'bib) + :type 'file) (defvar bib-mode-map (let ((map (make-sparse-keymap))) @@ -138,8 +136,7 @@ with the cdr.") (defcustom bib-auto-capitalize t "True to automatically capitalize appropriate fields in Bib mode." - :type 'boolean - :group 'bib) + :type 'boolean) (defconst bib-capitalized-fields "%[AETCBIJR]") diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 9186e520086..622853da456 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -71,9 +71,8 @@ "while") "Additional identifiers that appear in the form @foo in SCSS.") -(defvar css--at-ids css-at-ids +(defvar-local css--at-ids css-at-ids "List of at-rules for the current mode.") -(make-variable-buffer-local 'css--at-ids) (defconst css-bang-ids '("important") @@ -83,9 +82,8 @@ '("default" "global" "optional") "Additional identifiers that appear in the form !foo in SCSS.") -(defvar css--bang-ids css-bang-ids +(defvar-local css--bang-ids css-bang-ids "List of bang-rules for the current mode.") -(make-variable-buffer-local 'css--bang-ids) (defconst css-descriptor-ids '("ascent" "baseline" "bbox" "cap-height" "centerline" "definition-src" @@ -1374,9 +1372,8 @@ the string PROPERTY." "List of HTML tags. Used to provide completion of HTML tags in selectors.") -(defvar css--nested-selectors-allowed nil +(defvar-local css--nested-selectors-allowed nil "Non-nil if nested selectors are allowed in the current mode.") -(make-variable-buffer-local 'css--nested-selectors-allowed) (defvar css-class-list-function #'ignore "Called to provide completions of class names. diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el index 23a622992ad..f1a7517192f 100644 --- a/lisp/textmodes/dns-mode.el +++ b/lisp/textmodes/dns-mode.el @@ -1,4 +1,4 @@ -;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files +;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files -*- lexical-binding: t -*- ;; Copyright (C) 2000-2001, 2004-2021 Free Software Foundation, Inc. @@ -70,23 +70,19 @@ (defface dns-mode-control-entity '((t :inherit font-lock-keyword-face)) "Face used for DNS control entities, e.g. $ORIGIN." - :version "26.1" - :group 'dns-mode) + :version "26.1") (defface dns-mode-bad-control-entity '((t :inherit font-lock-warning-face)) "Face used for non-standard DNS control entities, e.g. $FOO." - :version "26.1" - :group 'dns-mode) + :version "26.1") (defface dns-mode-type '((t :inherit font-lock-type-face)) "Face used for DNS types, e.g., SOA." - :version "26.1" - :group 'dns-mode) + :version "26.1") (defface dns-mode-class '((t :inherit font-lock-constant-face)) "Face used for DNS classes, e.g., IN." - :version "26.1" - :group 'dns-mode) + :version "26.1") (defvar dns-mode-control-entity-face ''dns-mode-control-entity "Name of face used for control entities, e.g. $ORIGIN.") @@ -121,8 +117,7 @@ (,(regexp-opt dns-mode-types) 0 ,dns-mode-type-face)) "Font lock keywords used to highlight text in DNS master file mode." :version "26.1" - :type 'sexp - :group 'dns-mode) + :type 'sexp) (defcustom dns-mode-soa-auto-increment-serial t "Whether to increment the SOA serial number automatically. @@ -134,8 +129,7 @@ manually with \\[dns-mode-soa-increment-serial]." :type '(choice (const :tag "Always" t) (const :tag "Ask" ask) (const :tag "Never" nil)) - :safe 'symbolp - :group 'dns-mode) + :safe 'symbolp) ;; Syntax table. diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index 1aac96413e4..fe92d603065 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -165,10 +165,9 @@ execute malicious Lisp code, if that code came from an external source." :version "26.1" :group 'enriched) -(defvar enriched-old-bindings nil +(defvar-local enriched-old-bindings nil "Store old variable values that we change when entering mode. The value is a list of \(VAR VALUE VAR VALUE...).") -(make-variable-buffer-local 'enriched-old-bindings) ;; The next variable is buffer local if and only if Enriched mode is ;; enabled. The buffer local value records whether @@ -187,7 +186,6 @@ The value is a list of \(VAR VALUE VAR VALUE...).") (defvar enriched-mode-map (let ((map (make-sparse-keymap))) - (define-key map [remap move-beginning-of-line] 'beginning-of-line-text) (define-key map "\C-m" 'reindent-then-newline-and-indent) (define-key map [remap newline-and-indent] 'reindent-then-newline-and-indent) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index d8503168846..83dba7177ab 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -304,12 +304,11 @@ If this variable is nil, all regions are treated as small." (define-obsolete-variable-alias 'flyspell-generic-check-word-p 'flyspell-generic-check-word-predicate "25.1") -(defvar flyspell-generic-check-word-predicate nil +(defvar-local flyspell-generic-check-word-predicate nil "Function providing per-mode customization over which words are flyspelled. Returns t to continue checking, nil otherwise. Flyspell mode sets this variable to whatever is the `flyspell-mode-predicate' property of the major mode name.") -(make-variable-buffer-local 'flyspell-generic-check-word-predicate) ;;*--- mail mode -------------------------------------------------------*/ (put 'mail-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify) @@ -466,13 +465,10 @@ If this is set, also unbind `mouse-2'." :version "28.1") ;; dash character machinery -(defvar flyspell-consider-dash-as-word-delimiter-flag nil +(defvar-local flyspell-consider-dash-as-word-delimiter-flag nil "Non-nil means that the `-' char is considered as a word delimiter.") -(make-variable-buffer-local 'flyspell-consider-dash-as-word-delimiter-flag) -(defvar flyspell-dash-dictionary nil) -(make-variable-buffer-local 'flyspell-dash-dictionary) -(defvar flyspell-dash-local-dictionary nil) -(make-variable-buffer-local 'flyspell-dash-local-dictionary) +(defvar-local flyspell-dash-dictionary nil) +(defvar-local flyspell-dash-local-dictionary nil) ;;*---------------------------------------------------------------------*/ ;;* Highlighting */ @@ -714,14 +710,10 @@ has been used, the current word is not checked." ;;*---------------------------------------------------------------------*/ ;;* flyspell-word-cache ... */ ;;*---------------------------------------------------------------------*/ -(defvar flyspell-word-cache-start nil) -(defvar flyspell-word-cache-end nil) -(defvar flyspell-word-cache-word nil) -(defvar flyspell-word-cache-result '_) -(make-variable-buffer-local 'flyspell-word-cache-start) -(make-variable-buffer-local 'flyspell-word-cache-end) -(make-variable-buffer-local 'flyspell-word-cache-word) -(make-variable-buffer-local 'flyspell-word-cache-result) +(defvar-local flyspell-word-cache-start nil) +(defvar-local flyspell-word-cache-end nil) +(defvar-local flyspell-word-cache-word nil) +(defvar-local flyspell-word-cache-result '_) ;;*---------------------------------------------------------------------*/ ;;* The flyspell pre-hook, store the current position. In the */ @@ -827,8 +819,7 @@ before the current command." ;;* the post command hook, we will check, if the word at this */ ;;* position has to be spell checked. */ ;;*---------------------------------------------------------------------*/ -(defvar flyspell-changes nil) -(make-variable-buffer-local 'flyspell-changes) +(defvar-local flyspell-changes nil) ;;*---------------------------------------------------------------------*/ ;;* flyspell-after-change-function ... */ @@ -1894,14 +1885,10 @@ as returned by `ispell-parse-output'." ;;*---------------------------------------------------------------------*/ ;;* flyspell-auto-correct-cache ... */ ;;*---------------------------------------------------------------------*/ -(defvar flyspell-auto-correct-pos nil) -(defvar flyspell-auto-correct-region nil) -(defvar flyspell-auto-correct-ring nil) -(defvar flyspell-auto-correct-word nil) -(make-variable-buffer-local 'flyspell-auto-correct-pos) -(make-variable-buffer-local 'flyspell-auto-correct-region) -(make-variable-buffer-local 'flyspell-auto-correct-ring) -(make-variable-buffer-local 'flyspell-auto-correct-word) +(defvar-local flyspell-auto-correct-pos nil) +(defvar-local flyspell-auto-correct-region nil) +(defvar-local flyspell-auto-correct-ring nil) +(defvar-local flyspell-auto-correct-word nil) ;;*---------------------------------------------------------------------*/ ;;* flyspell-check-previous-highlighted-word ... */ diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 8d49a7c54c8..ea46270508e 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -351,9 +351,8 @@ If nil, the default personal dictionary for your spelling checker is used." :type 'boolean :group 'ispell) -(defvar ispell-local-dictionary-overridden nil +(defvar-local ispell-local-dictionary-overridden nil "Non-nil means the user has explicitly set this buffer's Ispell dictionary.") -(make-variable-buffer-local 'ispell-local-dictionary-overridden) (defcustom ispell-local-dictionary nil "If non-nil, the dictionary to be used for Ispell commands in this buffer. @@ -1748,7 +1747,7 @@ Note - substrings of other matches must come last (e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").") (put 'ispell-html-skip-alists 'risky-local-variable t) -(defvar ispell-local-pdict ispell-personal-dictionary +(defvar-local ispell-local-pdict ispell-personal-dictionary "A buffer local variable containing the current personal dictionary. If non-nil, the value must be a string, which is a file name. @@ -1758,18 +1757,15 @@ to calling \\[ispell-change-dictionary]. This variable is automatically set when defined in the file with either `ispell-pdict-keyword' or the local variable syntax.") -(make-variable-buffer-local 'ispell-local-pdict) ;;;###autoload(put 'ispell-local-pdict 'safe-local-variable 'stringp) (defvar ispell-buffer-local-name nil "Contains the buffer name if local word definitions were used. Ispell is then restarted because the local words could conflict.") -(defvar ispell-buffer-session-localwords nil +(defvar-local ispell-buffer-session-localwords nil "List of words accepted for session in this buffer.") -(make-variable-buffer-local 'ispell-buffer-session-localwords) - (defvar ispell-parser 'use-mode-name "Indicates whether ispell should parse the current buffer as TeX Code. Special value `use-mode-name' tries to guess using the name of `major-mode'. diff --git a/lisp/textmodes/less-css-mode.el b/lisp/textmodes/less-css-mode.el index 9cacc175ba9..24ccb3ce980 100644 --- a/lisp/textmodes/less-css-mode.el +++ b/lisp/textmodes/less-css-mode.el @@ -73,7 +73,6 @@ (require 'compile) (require 'css-mode) -(require 'derived) (eval-when-compile (require 'subr-x)) (defgroup less-css nil diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el index fe70e925b05..e7d852be3c8 100644 --- a/lisp/textmodes/nroff-mode.el +++ b/lisp/textmodes/nroff-mode.el @@ -316,7 +316,7 @@ otherwise off." (save-buffer)) (if viewbuf (kill-buffer viewbuf)) - (Man-getpage-in-background file))) + (Man-getpage-in-background (shell-quote-argument file)))) (provide 'nroff-mode) diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el index 6edd9aeb7ef..8f4f3c5a231 100644 --- a/lisp/textmodes/refill.el +++ b/lisp/textmodes/refill.el @@ -88,10 +88,9 @@ ;;; "Refilling paragraphs on changes." ;;; :group 'fill) -(defvar refill-ignorable-overlay nil +(defvar-local refill-ignorable-overlay nil "Portion of the most recently filled paragraph not needing filling. This is used to optimize refilling.") -(make-variable-buffer-local 'refill-ignorable-overlay) (defun refill-adjust-ignorable-overlay (overlay afterp beg end &optional len) "Adjust OVERLAY to not include the about-to-be-modified region." @@ -149,7 +148,7 @@ This is used to optimize refilling.") "Like `fill-paragraph' but don't delete whitespace at paragraph end." (refill-fill-paragraph-at (point) arg)) -(defvar refill-doit nil +(defvar-local refill-doit nil "Non-nil tells `refill-post-command-function' to do its processing. Set by `refill-after-change-function' in `after-change-functions' and unset by `refill-post-command-function' in `post-command-hook', and @@ -157,7 +156,6 @@ sometimes `refill-pre-command-function' in `pre-command-hook'. This ensures refilling is only done once per command that causes a change, regardless of the number of after-change calls from commands doing complex processing.") -(make-variable-buffer-local 'refill-doit) (defun refill-after-change-function (beg end len) "Function for `after-change-functions' which just sets `refill-doit'." diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 18341716e3a..2b31e7ed612 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -3627,10 +3627,7 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too." "customize the face `rst-definition' instead." "24.1") -;; XEmacs compatibility (?). -(defface rst-directive (if (boundp 'font-lock-builtin-face) - '((t :inherit font-lock-builtin-face)) - '((t :inherit font-lock-preprocessor-face))) +(defface rst-directive '((t :inherit font-lock-builtin-face)) "Face used for directives and roles." :version "24.1" :group 'rst-faces) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index c50c544cb54..7051f520b90 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -510,10 +510,12 @@ an optional alist of possible values." (with-no-warnings (defvar v2)) ; free for skeleton (defun sgml-comment-indent-new-line (&optional soft) - (let ((comment-start "-- ") - (comment-start-skip "\\(<!\\)?--[ \t]*") - (comment-end " --") - (comment-style 'plain)) + (if (ppss-comment-depth (syntax-ppss)) + (let ((comment-start "-- ") + (comment-start-skip "\\(<!\\)?--[ \t]*") + (comment-end " --") + (comment-style 'plain)) + (comment-indent-new-line soft)) (comment-indent-new-line soft))) (defun sgml-mode-facemenu-add-face-function (face _end) @@ -2290,19 +2292,17 @@ This takes effect when first loading the library.") nil t) (match-string-no-properties 1)))) -(defvar html--buffer-classes-cache nil +(defvar-local html--buffer-classes-cache nil "Cache for `html-current-buffer-classes'. When set, this should be a cons cell where the CAR is the buffer's tick counter (as produced by `buffer-modified-tick'), and the CDR is the list of class names found in the buffer.") -(make-variable-buffer-local 'html--buffer-classes-cache) -(defvar html--buffer-ids-cache nil +(defvar-local html--buffer-ids-cache nil "Cache for `html-current-buffer-ids'. When set, this should be a cons cell where the CAR is the buffer's tick counter (as produced by `buffer-modified-tick'), and the CDR is the list of class names found in the buffer.") -(make-variable-buffer-local 'html--buffer-ids-cache) (declare-function libxml-parse-html-region "xml.c" (start end &optional base-url discard-comments)) diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 071684d3c4d..06785e458b2 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -859,11 +859,10 @@ cell to cache and cache to cell.") "Non-nil inhibits auto fill paragraph when `table-with-cache-buffer' exits. This is always set to nil at the entry to `table-with-cache-buffer' before executing body forms.") -(defvar table-mode-indicator nil +(defvar-local table-mode-indicator nil "For mode line indicator") ;; This is not a real minor-mode but placed in the minor-mode-alist ;; so that we can show the indicator on the mode line handy. -(make-variable-buffer-local 'table-mode-indicator) (unless (assq table-mode-indicator minor-mode-alist) (push '(table-mode-indicator (table-fixed-width-mode " Fixed-Table" " Table")) minor-mode-alist)) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index ce665e61656..d5a79ad0ac5 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -2044,8 +2044,7 @@ In the tex shell buffer this command behaves like `comint-send-input'." (with-current-buffer buffer (setq default-directory directory)))) -(defvar tex-send-command-modified-tick 0) -(make-variable-buffer-local 'tex-send-command-modified-tick) +(defvar-local tex-send-command-modified-tick 0) (defun tex-shell-proc () (or (tex-shell-running) (error "No TeX subprocess"))) diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el index ed0a367d01d..fe052e32414 100644 --- a/lisp/textmodes/texinfmt.el +++ b/lisp/textmodes/texinfmt.el @@ -28,10 +28,12 @@ ;;; Emacs lisp functions to convert Texinfo files to Info files. (defvar texinfmt-version "2.42 of 7 Jul 2006") +(make-obsolete-variable 'texinfmt-version 'emacs-version "28.1") (defun texinfmt-version (&optional here) "Show the version of texinfmt.el in the minibuffer. If optional argument HERE is non-nil, insert info at point." + (declare (obsolete emacs-version "28.1")) (interactive "P") (let ((version-string (format-message "Version of `texinfmt.el': %s" texinfmt-version))) @@ -345,8 +347,8 @@ converted to Info is stored in a temporary buffer." (file-name-nondirectory (buffer-file-name input-buffer)))) (format-message "buffer `%s'" (buffer-name input-buffer))) - (format-message "\nusing `texinfmt.el' version ") - texinfmt-version + (format-message "\nusing `texinfmt.el' on Emacs version ") + emacs-version ".\n\n") ;; Now convert for real. @@ -489,8 +491,8 @@ if large. You can use `Info-split' to do this manually." (file-name-nondirectory (buffer-file-name input-buffer)))) (format-message "buffer `%s'" (buffer-name input-buffer))) - (format-message "\nusing `texinfmt.el' version ") - texinfmt-version + (format-message "\nusing `texinfmt.el' on Emacs version ") + emacs-version ".\n\n") ;; Return data for indices. (list outfile diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 1432ab6a300..ab9f7b9c7c0 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -169,8 +169,6 @@ both existing buffers and buffers that you subsequently create." (if enable-mode "enabled" "disabled")))) -(define-key facemenu-keymap "\eS" 'center-paragraph) - (defun center-paragraph () "Center each nonblank line in the paragraph at or after point. See `center-line' for more info." @@ -198,8 +196,6 @@ See `center-line' for more info." (center-line)) (forward-line 1))))) -(define-key facemenu-keymap "\es" 'center-line) - (defun center-line (&optional nlines) "Center the line point is on, within the width specified by `fill-column'. This means adjusting the indentation so that it equals diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el index 36aad84c0e6..d072ab16c3c 100644 --- a/lisp/textmodes/two-column.el +++ b/lisp/textmodes/two-column.el @@ -218,15 +218,13 @@ minus this value." ;; Markers seem to be the only buffer-id not affected by renaming a buffer. ;; This nevertheless loses when a buffer is killed. The variable-name is ;; required by `describe-mode'. -(defvar 2C-mode nil +(defvar-local 2C-mode nil "Marker to the associated buffer, if non-nil.") -(make-variable-buffer-local '2C-mode) (put '2C-mode 'permanent-local t) (setq minor-mode-alist (cons '(2C-mode " 2C") minor-mode-alist)) -(defvar 2C-autoscroll-start nil) -(make-variable-buffer-local '2C-autoscroll-start) +(defvar-local 2C-autoscroll-start nil) ;;;;; base functions ;;;;; diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 7d6558d8f78..465d097b615 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -148,36 +148,30 @@ this value can let another user see some of your images." :group 'thumbs) ;; Initialize some variable, for later use. -(defvar thumbs-current-tmp-filename nil +(defvar-local thumbs-current-tmp-filename nil "Temporary filename of current image.") -(make-variable-buffer-local 'thumbs-current-tmp-filename) -(defvar thumbs-current-image-filename nil +(defvar-local thumbs-current-image-filename nil "Filename of current image.") -(make-variable-buffer-local 'thumbs-current-image-filename) -(defvar thumbs-extra-images 1 +(defvar-local thumbs-extra-images 1 "Counter for showing extra images in thumbs buffer.") -(make-variable-buffer-local 'thumbs-extra-images) (put 'thumbs-extra-images 'permanent-local t) (defvar thumbs-current-image-size nil "Size of current image.") -(defvar thumbs-image-num nil +(defvar-local thumbs-image-num nil "Number of current image.") -(make-variable-buffer-local 'thumbs-image-num) -(defvar thumbs-buffer nil +(defvar-local thumbs-buffer nil "Name of buffer containing thumbnails associated with image.") -(make-variable-buffer-local 'thumbs-buffer) (defvar thumbs-current-dir nil "Current directory.") -(defvar thumbs-marked-list nil +(defvar-local thumbs-marked-list nil "List of marked files.") -(make-variable-buffer-local 'thumbs-marked-list) (put 'thumbs-marked-list 'permanent-local t) (defsubst thumbs-temp-dir () diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 6bda1ab0d50..57e5570d537 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -38,17 +38,14 @@ "Face used to highlight warnings in the tutorial." :group 'help) -(defvar tutorial--point-before-chkeys 0 +(defvar-local tutorial--point-before-chkeys 0 "Point before display of key changes.") -(make-variable-buffer-local 'tutorial--point-before-chkeys) -(defvar tutorial--point-after-chkeys 0 +(defvar-local tutorial--point-after-chkeys 0 "Point after display of key changes.") -(make-variable-buffer-local 'tutorial--point-after-chkeys) -(defvar tutorial--lang nil +(defvar-local tutorial--lang nil "Tutorial language.") -(make-variable-buffer-local 'tutorial--lang) (defvar tutorial--buffer nil "The selected tutorial buffer.") diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 61e07a0d9ca..8cebd4e79f6 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -461,8 +461,10 @@ Return the number of characters removed." ;; headers, then this means that we've already tried sending ;; credentials to the server, and they were wrong, so just give ;; up. - (when (assoc "Authorization" url-http-extra-headers) - (error "Wrong authorization used for %s" url)) + (let ((authorization (assoc "Authorization" url-http-extra-headers))) + (when (and authorization + (not (string-match "^NTLM " (cdr authorization)))) + (error "Wrong authorization used for %s" url))) ;; find strongest supported auth (dolist (this-auth auths) diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index 6493abfa056..8c836f8f64d 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -55,26 +55,19 @@ :group 'url) -(defvar url-current-object nil +(defvar-local url-current-object nil "A parsed representation of the current URL.") -(defvar url-current-mime-headers nil +(defvar-local url-current-mime-headers nil "A parsed representation of the MIME headers for the current URL.") -(defvar url-current-lastloc nil +(defvar-local url-current-lastloc nil "A parsed representation of the URL to be considered as the last location. Use of this value on outbound connections is subject to `url-privacy-level' and `url-lastloc-privacy-level'. This is never set by the url library, applications are expected to set this variable in buffers representing a displayed location.") -(mapc 'make-variable-buffer-local - '( - url-current-object - url-current-mime-headers - url-current-lastloc - )) - (defcustom url-honor-refresh-requests t "Whether to do automatic page reloads. These are done at the request of the document author or the server via diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el index ff3a2944a17..26fb6206c80 100644 --- a/lisp/vc/cvs-status.el +++ b/lisp/vc/cvs-status.el @@ -356,9 +356,8 @@ the list is a three-string list TAG, KIND, REV." (defvar font-lock-mode) ;; (defun cvs-refontify (beg end) -;; (when (and (boundp 'font-lock-mode) -;; font-lock-mode -;; (fboundp 'font-lock-fontify-region)) +;; (when (and font-lock-mode +;; (fboundp 'font-lock-fontify-region)) ;; (font-lock-fontify-region (1- beg) (1+ end)))) (defun cvs-status-trees () diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index e90eaa11565..fde9d4338f3 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -1230,35 +1230,30 @@ are ignored." Used for splitting difference regions into individual words.") ;; \240 is Unicode symbol for nonbreakable whitespace -(defvar ediff-whitespace " \n\t\f\r\240" +(defvar-local ediff-whitespace " \n\t\f\r\240" "Characters constituting white space. These characters are ignored when differing regions are split into words.") -(make-variable-buffer-local 'ediff-whitespace) -(defvar ediff-word-1 "-[:word:]_" +(defvar-local ediff-word-1 "-[:word:]_" "Characters that constitute words of type 1. More precisely, [ediff-word-1] is a regexp that matches type 1 words. See `ediff-forward-word' for more details.") -(make-variable-buffer-local 'ediff-word-1) -(defvar ediff-word-2 "0-9.," +(defvar-local ediff-word-2 "0-9.," "Characters that constitute words of type 2. More precisely, [ediff-word-2] is a regexp that matches type 2 words. See `ediff-forward-word' for more details.") -(make-variable-buffer-local 'ediff-word-2) -(defvar ediff-word-3 "`'?!:;\"{}[]()" +(defvar-local ediff-word-3 "`'?!:;\"{}[]()" "Characters that constitute words of type 3. More precisely, [ediff-word-3] is a regexp that matches type 3 words. See `ediff-forward-word' for more details.") -(make-variable-buffer-local 'ediff-word-3) -(defvar ediff-word-4 +(defvar-local ediff-word-4 (concat "^" ediff-word-1 ediff-word-2 ediff-word-3 ediff-whitespace) "Characters that constitute words of type 4. More precisely, [ediff-word-4] is a regexp that matches type 4 words. See `ediff-forward-word' for more details.") -(make-variable-buffer-local 'ediff-word-4) ;; Split region along word boundaries. Each word will be on its own line. ;; Output to buffer out-buffer. diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index 0865ac5ce41..3f33e6aae2e 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -80,13 +80,12 @@ that Ediff doesn't know about.") ;; so that `kill-all-local-variables' (called by major-mode setting ;; commands) won't destroy Ediff control variables. ;; -;; Plagiarized from `emerge-defvar-local' for XEmacs. +;; Plagiarized from `emerge-defvar-local'. (defmacro ediff-defvar-local (var value doc) "Defines VAR as a local variable." (declare (indent defun) (doc-string 3)) `(progn - (defvar ,var ,value ,doc) - (make-variable-buffer-local ',var) + (defvar-local ,var ,value ,doc) (put ',var 'permanent-local t))) @@ -798,13 +797,6 @@ to temp files in buffer jobs and when Ediff needs to find fine differences." (message "Pixmap not found for %S: %s" (face-name face) pixmap) (sit-for 1))))) -(defun ediff-hide-face (face) - (if (and (ediff-has-face-support-p) - (boundp 'add-to-list) - (boundp 'facemenu-unlisted-faces)) - (add-to-list 'facemenu-unlisted-faces face))) - - (defface ediff-current-diff-A '((((class color) (min-colors 88) (background light)) @@ -825,7 +817,6 @@ to temp files in buffer jobs and when Ediff needs to find fine differences." DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `ediff-current-diff-A' this variable represents.") -(ediff-hide-face ediff-current-diff-face-A) (defface ediff-current-diff-B '((((class color) (min-colors 88) (background light)) @@ -847,7 +838,6 @@ this variable represents.") this variable. Instead, use the customization widget to customize the actual face `ediff-current-diff-B' this variable represents.") -(ediff-hide-face ediff-current-diff-face-B) (defface ediff-current-diff-C '((((class color) (min-colors 88) (background light)) @@ -868,7 +858,6 @@ this variable represents.") DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `ediff-current-diff-C' this variable represents.") -(ediff-hide-face ediff-current-diff-face-C) (defface ediff-current-diff-Ancestor '((((class color) (min-colors 88) (background light)) @@ -891,7 +880,6 @@ this variable represents.") DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `ediff-current-diff-Ancestor' this variable represents.") -(ediff-hide-face ediff-current-diff-face-Ancestor) (defface ediff-fine-diff-A '((((class color) (min-colors 88) (background light)) @@ -912,7 +900,6 @@ this variable represents.") DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `ediff-fine-diff-A' this variable represents.") -(ediff-hide-face ediff-fine-diff-face-A) (defface ediff-fine-diff-B '((((class color) (min-colors 88) (background light)) @@ -933,7 +920,6 @@ this variable represents.") DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `ediff-fine-diff-B' this variable represents.") -(ediff-hide-face ediff-fine-diff-face-B) (defface ediff-fine-diff-C '((((class color) (min-colors 88) (background light)) @@ -957,7 +943,6 @@ this variable represents.") DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `ediff-fine-diff-C' this variable represents.") -(ediff-hide-face ediff-fine-diff-face-C) (defface ediff-fine-diff-Ancestor '((((class color) (min-colors 88) (background light)) @@ -982,7 +967,6 @@ ancestor buffer." DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `ediff-fine-diff-Ancestor' this variable represents.") -(ediff-hide-face ediff-fine-diff-face-Ancestor) ;; Some installs don't have stipple or Stipple. So, try them in turn. (defvar stipple-pixmap @@ -996,8 +980,10 @@ this variable represents.") (defface ediff-even-diff-A `((((type pc)) (:foreground "green3" :background "light grey" :extend t)) - (((class color) (min-colors 88)) - (:background "light grey" :extend t)) + (((class color) (min-colors 88) (background light)) + (:distant-foreground "Black" :background "light grey" :extend t)) + (((class color) (min-colors 88) (background dark)) + (:distant-foreground "White" :background "dark grey" :extend t)) (((class color) (min-colors 16)) (:foreground "Black" :background "light grey" :extend t)) (((class color)) @@ -1013,11 +999,12 @@ this variable represents.") DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `ediff-even-diff-A' this variable represents.") -(ediff-hide-face ediff-even-diff-face-A) (defface ediff-even-diff-B - `((((class color) (min-colors 88)) - (:background "Grey" :extend t)) + `((((class color) (min-colors 88) (background light)) + (:distant-foreground "Black" :background "Grey" :extend t)) + (((class color) (min-colors 88) (background dark)) + (:distant-foreground "White" :background "dim grey" :extend t)) (((class color) (min-colors 16)) (:foreground "White" :background "Grey" :extend t)) (((class color)) @@ -1032,13 +1019,14 @@ this variable represents.") DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `ediff-even-diff-B' this variable represents.") -(ediff-hide-face ediff-even-diff-face-B) (defface ediff-even-diff-C `((((type pc)) (:foreground "yellow3" :background "light grey" :extend t)) - (((class color) (min-colors 88)) - (:background "light grey" :extend t)) + (((class color) (min-colors 88) (background light)) + (:distant-foreground "Black" :background "light grey" :extend t)) + (((class color) (min-colors 88) (background dark)) + (:distant-foreground "White" :background "dark grey" :extend t)) (((class color) (min-colors 16)) (:foreground "Black" :background "light grey" :extend t)) (((class color)) @@ -1054,13 +1042,14 @@ this variable represents.") DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `ediff-even-diff-C' this variable represents.") -(ediff-hide-face ediff-even-diff-face-C) (defface ediff-even-diff-Ancestor `((((type pc)) (:foreground "cyan3" :background "light grey" :extend t)) - (((class color) (min-colors 88)) - (:background "Grey" :extend t)) + (((class color) (min-colors 88) (background light)) + (:distant-foreground "Black" :background "Grey" :extend t)) + (((class color) (min-colors 88) (background dark)) + (:distant-foreground "White" :background "dim grey" :extend t)) (((class color) (min-colors 16)) (:foreground "White" :background "Grey" :extend t)) (((class color)) @@ -1076,7 +1065,6 @@ this variable represents.") DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `ediff-even-diff-Ancestor' this variable represents.") -(ediff-hide-face ediff-even-diff-face-Ancestor) ;; Association between buffer types and even-diff-face symbols (defconst ediff-even-diff-face-alist @@ -1088,8 +1076,10 @@ this variable represents.") (defface ediff-odd-diff-A '((((type pc)) (:foreground "green3" :background "gray40" :extend t)) - (((class color) (min-colors 88)) - (:background "Grey" :extend t)) + (((class color) (min-colors 88) (background light)) + (:distant-foreground "Black" :background "Grey" :extend t)) + (((class color) (min-colors 88) (background dark)) + (:distant-foreground "White" :background "dim grey" :extend t)) (((class color) (min-colors 16)) (:foreground "White" :background "Grey" :extend t)) (((class color)) @@ -1104,14 +1094,14 @@ this variable represents.") DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `ediff-odd-diff-A' this variable represents.") -(ediff-hide-face ediff-odd-diff-face-A) - (defface ediff-odd-diff-B '((((type pc)) (:foreground "White" :background "gray40" :extend t)) - (((class color) (min-colors 88)) - (:background "light grey" :extend t)) + (((class color) (min-colors 88) (background light)) + (:distant-foreground "Black" :background "light grey" :extend t)) + (((class color) (min-colors 88) (background dark)) + (:distant-foreground "White" :background "dark grey" :extend t)) (((class color) (min-colors 16)) (:foreground "Black" :background "light grey" :extend t)) (((class color)) @@ -1126,13 +1116,14 @@ this variable represents.") DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `ediff-odd-diff-B' this variable represents.") -(ediff-hide-face ediff-odd-diff-face-B) (defface ediff-odd-diff-C '((((type pc)) (:foreground "yellow3" :background "gray40" :extend t)) - (((class color) (min-colors 88)) - (:background "Grey" :extend t)) + (((class color) (min-colors 88) (background light)) + (:distant-foreground "Black" :background "Grey" :extend t)) + (((class color) (min-colors 88) (background dark)) + (:distant-foreground "White" :background "dim grey" :extend t)) (((class color) (min-colors 16)) (:foreground "White" :background "Grey" :extend t)) (((class color)) @@ -1147,7 +1138,6 @@ this variable represents.") DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `ediff-odd-diff-C' this variable represents.") -(ediff-hide-face ediff-odd-diff-face-C) (defface ediff-odd-diff-Ancestor '((((class color) (min-colors 88)) @@ -1166,7 +1156,6 @@ this variable represents.") DO NOT CHANGE this variable. Instead, use the customization widget to customize the actual face object `ediff-odd-diff-Ancestor' this variable represents.") -(ediff-hide-face ediff-odd-diff-face-Ancestor) ;; Association between buffer types and odd-diff-face symbols (defconst ediff-odd-diff-face-alist @@ -1572,6 +1561,8 @@ This default should work without changes." (ediff-file-attributes filename 5)) +;;; Obsolete + (defun ediff-convert-standard-filename (fname) (declare (obsolete convert-standard-filename "28.1")) (convert-standard-filename fname)) @@ -1579,5 +1570,7 @@ This default should work without changes." (define-obsolete-function-alias 'ediff-with-syntax-table #'with-syntax-table "27.1") +(define-obsolete-function-alias 'ediff-hide-face #'ignore "28.1") + (provide 'ediff-init) ;;; ediff-init.el ends here diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index f955ba8283a..9909dcd5424 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -3998,8 +3998,8 @@ Mail anyway? (y or n) ") (define-obsolete-function-alias 'ediff-deactivate-mark #'deactivate-mark "27.1") (defun ediff-activate-mark () - (make-local-variable 'transient-mark-mode) - (setq mark-active 'ediff-util transient-mark-mode t)) + (setq mark-active 'ediff-util) + (setq-local transient-mark-mode t)) (define-obsolete-function-alias 'ediff-nuke-selective-display #'ignore "27.1") diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 3b09dfe5d2e..c66a4fb2d6a 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -173,8 +173,7 @@ Used in `smerge-diff-base-upper' and related functions." `((,smerge-command-prefix . ,smerge-basic-map)) "Keymap for `smerge-mode'.") -(defvar smerge-check-cache nil) -(make-variable-buffer-local 'smerge-check-cache) +(defvar-local smerge-check-cache nil) (defun smerge-check (n) (condition-case nil (let ((state (cons (point) (buffer-modified-tick)))) @@ -1411,7 +1410,7 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict." \\{smerge-mode-map}" :group 'smerge :lighter " SMerge" - (when (and (boundp 'font-lock-mode) font-lock-mode) + (when font-lock-mode (save-excursion (if smerge-mode (font-lock-add-keywords nil smerge-font-lock-keywords 'append) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index e4eff486f5e..d1385ea7784 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -860,9 +860,8 @@ If LIMIT is non-nil, show no more than this many entries." (vc-bzr-command "mv" nil 0 new old) (message "Renamed %s => %s" old new)) -(defvar vc-bzr-annotation-table nil +(defvar-local vc-bzr-annotation-table nil "Internal use.") -(make-variable-buffer-local 'vc-bzr-annotation-table) (defun vc-bzr-annotate-command (file buffer &optional revision) "Prepare BUFFER for `vc-annotate' on FILE. @@ -1077,49 +1076,49 @@ stream. Standard error output is discarded." (when (string-match ".+checkout of branch: \\(.+\\)$" str) (match-string 1 str))))) (concat - (propertize "Parent branch : " 'face 'font-lock-type-face) + (propertize "Parent branch : " 'face 'vc-dir-header) (propertize (if (string-match "parent branch: \\(.+\\)$" str) (match-string 1 str) "None") - 'face 'font-lock-variable-name-face) + 'face 'vc-dir-header-value) "\n" (when light-checkout (concat - (propertize "Light checkout root: " 'face 'font-lock-type-face) - (propertize light-checkout 'face 'font-lock-variable-name-face) + (propertize "Light checkout root: " 'face 'vc-dir-header) + (propertize light-checkout 'face 'vc-dir-header-value) "\n")) (when light-checkout-branch (concat - (propertize "Checkout of branch : " 'face 'font-lock-type-face) - (propertize light-checkout-branch 'face 'font-lock-variable-name-face) + (propertize "Checkout of branch : " 'face 'vc-dir-header) + (propertize light-checkout-branch 'face 'vc-dir-header-value) "\n")) (when pending-merge (concat - (propertize "Warning : " 'face 'font-lock-warning-face + (propertize "Warning : " 'face 'vc-dir-status-warning 'help-echo pending-merge-help-echo) (propertize "Pending merges, commit recommended before any other action" 'help-echo pending-merge-help-echo - 'face 'font-lock-warning-face) + 'face 'vc-dir-status-warning) "\n")) (if shelve (concat - (propertize "Shelves :\n" 'face 'font-lock-type-face + (propertize "Shelves :\n" 'face 'vc-dir-header 'help-echo shelve-help-echo) (mapconcat (lambda (x) (propertize x - 'face 'font-lock-variable-name-face + 'face 'vc-dir-header-value 'mouse-face 'highlight 'help-echo "mouse-3: Show shelve menu\nA: Apply and keep shelf\nP: Apply and remove shelf (pop)\nS: Snapshot to a shelf\nC-k: Delete shelf" 'keymap vc-bzr-shelve-map)) shelve "\n")) (concat - (propertize "Shelves : " 'face 'font-lock-type-face + (propertize "Shelves : " 'face 'vc-dir-header 'help-echo shelve-help-echo) (propertize "No shelved changes" 'help-echo shelve-help-echo - 'face 'font-lock-variable-name-face)))))) + 'face 'vc-dir-header-value)))))) ;; Follows vc-bzr-command, which uses vc-do-command from vc-dispatcher. (declare-function vc-resynch-buffer "vc-dispatcher" diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index a595cc9778b..0adb5328bc2 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -1047,29 +1047,29 @@ Query all files in DIR if files is nil." (file-error nil)))) (concat (cond (repo - (concat (propertize "Repository : " 'face 'font-lock-type-face) - (propertize repo 'face 'font-lock-variable-name-face))) + (concat (propertize "Repository : " 'face 'vc-dir-header) + (propertize repo 'face 'vc-dir-header-value))) (t "")) (cond (module - (concat (propertize "Module : " 'face 'font-lock-type-face) - (propertize module 'face 'font-lock-variable-name-face))) + (concat (propertize "Module : " 'face 'vc-dir-header) + (propertize module 'face 'vc-dir-header-value))) (t "")) (if (file-readable-p "CVS/Tag") (let ((tag (vc-cvs-file-to-string "CVS/Tag"))) (cond ((string-match "\\`T" tag) - (concat (propertize "Tag : " 'face 'font-lock-type-face) + (concat (propertize "Tag : " 'face 'vc-dir-header) (propertize (substring tag 1) - 'face 'font-lock-variable-name-face))) + 'face 'vc-dir-header-value))) ((string-match "\\`D" tag) - (concat (propertize "Date : " 'face 'font-lock-type-face) + (concat (propertize "Date : " 'face 'vc-dir-header) (propertize (substring tag 1) - 'face 'font-lock-variable-name-face))) + 'face 'vc-dir-header-value))) (t "")))) ;; In CVS, branch is a per-file property, not a per-directory property. ;; We can't really do this here without making dangerous assumptions. - ;;(propertize "Branch: " 'face 'font-lock-type-face) + ;;(propertize "Branch: " 'face 'vc-dir-header) ;;(propertize "ADD CODE TO PRINT THE BRANCH NAME\n" ;; 'face 'font-lock-warning-face) ))) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 9d0808c0435..a416474e16d 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -54,6 +54,42 @@ See `run-hooks'." :type 'hook :group 'vc) +(defface vc-dir-header '((t :inherit font-lock-type-face)) + "Face for headers in VC-dir buffers." + :group 'vc) + +(defface vc-dir-header-value '((t :inherit font-lock-variable-name-face)) + "Face for header values in VC-dir buffers." + :group 'vc) + +(defface vc-dir-directory '((t :inherit font-lock-comment-delimiter-face)) + "Face for directories in VC-dir buffers." + :group 'vc) + +(defface vc-dir-file '((t :inherit font-lock-function-name-face)) + "Face for files in VC-dir buffers." + :group 'vc) + +(defface vc-dir-mark-indicator '((t :inherit font-lock-type-face)) + "Face for mark indicators in VC-dir buffers." + :group 'vc) + +(defface vc-dir-status-warning '((t :inherit font-lock-warning-face)) + "Face for warning status in VC-dir buffers." + :group 'vc) + +(defface vc-dir-status-edited '((t :inherit font-lock-variable-name-face)) + "Face for edited status in VC-dir buffers." + :group 'vc) + +(defface vc-dir-status-up-to-date '((t :inherit font-lock-builtin-face)) + "Face for up-to-date status in VC-dir buffers." + :group 'vc) + +(defface vc-dir-status-ignored '((t :inherit shadow)) + "Face for ignored or empty values in VC-dir buffers." + :group 'vc) + ;; Used to store information for the files displayed in the directory buffer. ;; Each item displayed corresponds to one of these defstructs. (cl-defstruct (vc-dir-fileinfo @@ -1126,11 +1162,11 @@ It calls the `dir-extra-headers' backend method to display backend specific headers." (concat ;; First layout the common headers. - (propertize "VC backend : " 'face 'font-lock-type-face) - (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face) - (propertize "Working dir: " 'face 'font-lock-type-face) + (propertize "VC backend : " 'face 'vc-dir-header) + (propertize (format "%s\n" backend) 'face 'vc-dir-header-value) + (propertize "Working dir: " 'face 'vc-dir-header) (propertize (format "%s\n" (abbreviate-file-name dir)) - 'face 'font-lock-variable-name-face) + 'face 'vc-dir-header-value) ;; Then the backend specific ones. (vc-call-backend backend 'dir-extra-headers dir) "\n")) @@ -1386,9 +1422,9 @@ These are the commands available for use in the file status buffer: ;; backend specific headers. ;; XXX: change this to return nil before the release. (concat - (propertize "Extra : " 'face 'font-lock-type-face) + (propertize "Extra : " 'face 'vc-dir-header) (propertize "Please add backend specific headers here. It's easy!" - 'face 'font-lock-warning-face))) + 'face 'vc-dir-status-warning))) (defvar vc-dir-status-mouse-map (let ((map (make-sparse-keymap))) @@ -1414,21 +1450,23 @@ These are the commands available for use in the file status buffer: (insert (propertize (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? )) - 'face 'font-lock-type-face) + 'face 'vc-dir-mark-indicator) " " (propertize (format "%-20s" state) - 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face) - ((memq state '(missing conflict)) 'font-lock-warning-face) - ((eq state 'edited) 'font-lock-constant-face) - (t 'font-lock-variable-name-face)) + 'face (cond + ((eq state 'up-to-date) 'vc-dir-status-up-to-date) + ((memq state '(missing conflict needs-update unlocked-changes)) + 'vc-dir-status-warning) + ((eq state 'ignored) 'vc-dir-status-ignored) + (t 'vc-dir-status-edited)) 'mouse-face 'highlight 'keymap vc-dir-status-mouse-map) " " (propertize (format "%s" filename) 'face - (if isdir 'font-lock-comment-delimiter-face 'font-lock-function-name-face) + (if isdir 'vc-dir-directory 'vc-dir-file) 'help-echo (if isdir "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu" diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index 6b17f2afe74..2573964c42c 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -531,8 +531,7 @@ ARG and NO-CONFIRM are passed on to `revert-buffer'." (revert-buffer arg no-confirm t)) (vc-restore-buffer-context context))) -(defvar vc-mode-line-hook nil) -(make-variable-buffer-local 'vc-mode-line-hook) +(defvar-local vc-mode-line-hook nil) (put 'vc-mode-line-hook 'permanent-local t) (defvar view-old-buffer-read-only) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 94fac3a83b8..25ae26d746a 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -462,7 +462,7 @@ or an empty string if none." (eq 0 (logand ?\111 (logxor old-perm new-perm)))) " " (if (eq 0 (logand ?\111 old-perm)) "+x" "-x")) - 'face 'font-lock-type-face)) + 'face 'vc-dir-header)) (defun vc-git-dir-printer (info) "Pretty-printer for the vc-dir-fileinfo structure." @@ -474,20 +474,21 @@ or an empty string if none." (insert " " (propertize (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? )) - 'face 'font-lock-type-face) + 'face 'vc-dir-mark-indicator) " " (propertize (format "%-12s" state) - 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face) - ((eq state 'missing) 'font-lock-warning-face) - (t 'font-lock-variable-name-face)) + 'face (cond ((eq state 'up-to-date) 'vc-dir-status-up-to-date) + ((memq state '(missing conflict)) 'vc-dir-status-warning) + ((eq state 'ignored) 'vc-dir-status-ignored) + (t 'vc-dir-status-edited)) 'mouse-face 'highlight 'keymap vc-dir-status-mouse-map) " " (vc-git-permissions-as-string old-perm new-perm) " " (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info)) - 'face (if isdir 'font-lock-comment-delimiter-face - 'font-lock-function-name-face) + 'face (if isdir 'vc-dir-directory + 'vc-dir-file) 'help-echo (if isdir "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu" @@ -784,7 +785,7 @@ or an empty string if none." (mapconcat (lambda (x) (propertize x - 'face 'font-lock-variable-name-face + 'face 'vc-dir-header-value 'mouse-face 'highlight 'vc-git-hideable all-hideable 'help-echo vc-git-stash-list-help @@ -800,7 +801,7 @@ or an empty string if none." (mapconcat (lambda (x) (propertize x - 'face 'font-lock-variable-name-face + 'face 'vc-dir-header-value 'mouse-face 'highlight 'invisible t 'vc-git-hideable t @@ -810,33 +811,32 @@ or an empty string if none." (propertize "\n" 'invisible t 'vc-git-hideable t)))))))) - ;; FIXME: maybe use a different face when nothing is stashed. (concat - (propertize "Branch : " 'face 'font-lock-type-face) + (propertize "Branch : " 'face 'vc-dir-header) (propertize branch - 'face 'font-lock-variable-name-face) + 'face 'vc-dir-header-value) (when remote-url (concat "\n" - (propertize "Remote : " 'face 'font-lock-type-face) + (propertize "Remote : " 'face 'vc-dir-header) (propertize remote-url - 'face 'font-lock-variable-name-face))) + 'face 'vc-dir-header-value))) ;; For now just a heading, key bindings can be added later for various bisect actions (when (file-exists-p (expand-file-name ".git/BISECT_START" (vc-git-root dir))) - (propertize "\nBisect : in progress" 'face 'font-lock-warning-face)) + (propertize "\nBisect : in progress" 'face 'vc-dir-status-warning)) (when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root dir))) - (propertize "\nRebase : in progress" 'face 'font-lock-warning-face)) + (propertize "\nRebase : in progress" 'face 'vc-dir-status-warning)) (if stash-list (concat - (propertize "\nStash : " 'face 'font-lock-type-face) + (propertize "\nStash : " 'face 'vc-dir-header) stash-button stash-string) (concat - (propertize "\nStash : " 'face 'font-lock-type-face) + (propertize "\nStash : " 'face 'vc-dir-header) (propertize "Nothing stashed" 'help-echo vc-git-stash-shared-help 'keymap vc-git-stash-shared-map - 'face 'font-lock-variable-name-face)))))) + 'face 'vc-dir-header-value)))))) (defun vc-git-branches () "Return the existing branches, as a list of strings. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 1d163a64ab2..adb0fce8759 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1403,8 +1403,8 @@ This runs the command \"hg summary\"." (cons (capitalize (match-string 1)) (match-string 2)) (cons "" (buffer-substring (point) (line-end-position)))))) (concat - (propertize (format "%-11s: " (car entry)) 'face 'font-lock-type-face) - (propertize (cdr entry) 'face 'font-lock-variable-name-face))) + (propertize (format "%-11s: " (car entry)) 'face 'vc-dir-header) + (propertize (cdr entry) 'face 'vc-dir-header-value))) result) (forward-line)) (nreverse result)) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index da5471107d2..22becc91cd1 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -239,8 +239,8 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." (concat (cond (repo (concat - (propertize "Repository : " 'face 'font-lock-type-face) - (propertize repo 'face 'font-lock-variable-name-face))) + (propertize "Repository : " 'face 'vc-dir-header) + (propertize repo 'face 'vc-dir-header-value))) (t ""))))) (defun vc-svn-working-revision (file) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index bc9f11202b1..00976a07d42 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1549,6 +1549,9 @@ After check-out, runs the normal hook `vc-checkout-hook'." (vc-call-backend backend 'mark-resolved files) ;; FIXME: Is this TRTD? Might not be. `((vc-state . edited))) + ;; Recompute mode lines. + (dolist (file files) + (vc-mode-line file backend)) (message (substitute-command-keys "Conflicts have been resolved in %s. \ diff --git a/lisp/vcursor.el b/lisp/vcursor.el index e699df4842d..595a25381ab 100644 --- a/lisp/vcursor.el +++ b/lisp/vcursor.el @@ -38,7 +38,7 @@ ;; or t), which means that copying from the vcursor will be turned ;; off after any operation not involving the vcursor, but the ;; vcursor itself will be left alone. -;; - works on dumb terminals with Emacs 19.29 and later +;; - works on dumb terminals ;; - new keymap vcursor-map for binding to a prefix key ;; - vcursor-compare-windows substantially improved ;; - vcursor-execute-{key,command} much better about using the @@ -50,11 +50,7 @@ ;; ============ ;; ;; Virtual cursor commands. I got this idea from the old BBC micro. -;; You need Emacs 19 or 20 and a window system for the best effects. -;; For character terminals, at least Emacs 19.29 is required -;; (special behavior for the overlay property -;; "before-string" must be implemented). Search for "dumb terminals" -;; for more information. +;; You need a window system for the best effects. ;; ;; This is much easier to use than the instructions are to read. ;; First, you need to let vcursor define some keys: setting diff --git a/lisp/view.el b/lisp/view.el index 5a2f2fadfc3..026c1ece304 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -96,38 +96,31 @@ interactive command; otherwise the help message is not shown." :version "22.1") ;;;###autoload -(defvar view-mode nil +(defvar-local view-mode nil "Non-nil if View mode is enabled. Don't change this variable directly, you must change it by one of the functions that enable or disable view mode.") -;;;###autoload -(make-variable-buffer-local 'view-mode) (defcustom view-mode-hook nil "Normal hook run when starting to view a buffer or file." :type 'hook :group 'view) -(defvar view-old-buffer-read-only nil) -(make-variable-buffer-local 'view-old-buffer-read-only) +(defvar-local view-old-buffer-read-only nil) -(defvar view-old-Helper-return-blurb) -(make-variable-buffer-local 'view-old-Helper-return-blurb) +(defvar-local view-old-Helper-return-blurb nil) -(defvar view-page-size nil +(defvar-local view-page-size nil "Default number of lines to scroll by View page commands. If nil that means use the window size.") -(make-variable-buffer-local 'view-page-size) -(defvar view-half-page-size nil +(defvar-local view-half-page-size nil "Default number of lines to scroll by View half page commands. If nil that means use half the window size.") -(make-variable-buffer-local 'view-half-page-size) -(defvar view-last-regexp nil) -(make-variable-buffer-local 'view-last-regexp) ; Global is better??? +(defvar-local view-last-regexp nil) ; Global is better??? -(defvar view-return-to-alist nil +(defvar-local view-return-to-alist nil "What to do with used windows and where to go when finished viewing buffer. This is local in each buffer being viewed. It is added to by `view-mode-enter' when starting to view a buffer and @@ -136,18 +129,16 @@ subtracted from by `view-mode-exit' when finished viewing the buffer. See RETURN-TO-ALIST argument of function `view-mode-exit' for the format of `view-return-to-alist'.") (make-obsolete-variable - 'view-return-to-alist "this variable is no more used." "24.1") -(make-variable-buffer-local 'view-return-to-alist) + 'view-return-to-alist "this variable is no longer used." "24.1") (put 'view-return-to-alist 'permanent-local t) -(defvar view-exit-action nil +(defvar-local view-exit-action nil "If non-nil, a function called when finished viewing. The function should take one argument (a buffer). Commands like \\[view-file] and \\[view-file-other-window] may set this to bury or kill the viewed buffer. Observe that the buffer viewed might not appear in any window at the time this function is called.") -(make-variable-buffer-local 'view-exit-action) (defvar view-no-disable-on-exit nil "If non-nil, View mode \"exit\" commands don't actually disable View mode. @@ -155,10 +146,9 @@ Instead, these commands just switch buffers or windows. This is set in certain buffers by specialized features such as help commands that use View mode automatically.") -(defvar view-overlay nil +(defvar-local view-overlay nil "Overlay used to display where a search operation found its match. This is local in each buffer, once it is used.") -(make-variable-buffer-local 'view-overlay) ;; Define keymap inside defvar to make it easier to load changes. ;; Some redundant "less"-like key bindings below have been commented out. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 68a0d3d2356..de2b5d4a7c8 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1019,9 +1019,8 @@ button end points." Recommended as a parent keymap for modes using widgets. Note that such modes will need to require wid-edit.") -(defvar widget-global-map global-map +(defvar-local widget-global-map global-map "Keymap used for events a widget does not handle itself.") -(make-variable-buffer-local 'widget-global-map) (defvar widget-field-keymap (let ((map (copy-keymap widget-keymap))) @@ -1326,13 +1325,11 @@ When not inside a field, signal an error." ;;; Setting up the buffer. -(defvar widget-field-new nil +(defvar-local widget-field-new nil "List of all newly created editable fields in the buffer.") -(make-variable-buffer-local 'widget-field-new) -(defvar widget-field-list nil +(defvar-local widget-field-list nil "List of all editable fields in the buffer.") -(make-variable-buffer-local 'widget-field-list) (defun widget-at (&optional pos) "The button or field at POS (default, point)." @@ -1359,13 +1356,11 @@ When not inside a field, signal an error." (widget-clear-undo) (widget-add-change)) -(defvar widget-field-last nil) -;; Last field containing point. -(make-variable-buffer-local 'widget-field-last) +(defvar-local widget-field-last nil + "Last field containing point.") -(defvar widget-field-was nil) -;; The widget data before the change. -(make-variable-buffer-local 'widget-field-was) +(defvar-local widget-field-was nil + "The widget data before the change.") (defun widget-field-at (pos) "Return the widget field at POS, or nil if none." diff --git a/lisp/window.el b/lisp/window.el index d5876914201..2d0a73b426d 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1500,7 +1500,7 @@ otherwise." (window-pixel-height window) (window-total-height window round)))) -(defvar window-size-fixed nil +(defvar-local window-size-fixed nil "Non-nil in a buffer means windows displaying the buffer are fixed-size. If the value is `height', then only the window's height is fixed. If the value is `width', then only the window's width is fixed. @@ -1509,7 +1509,6 @@ Any other non-nil value fixes both the width and the height. Emacs won't change the size of any window displaying that buffer, unless it has no other choice (like when deleting a neighboring window).") -(make-variable-buffer-local 'window-size-fixed) (defun window--preservable-size (window &optional horizontal) "Return height of WINDOW as `window-preserve-size' would preserve it. @@ -5753,11 +5752,10 @@ nil (i.e. any), `height' or `width'." '((height . width) (width . height)))))))) ;;; A different solution to balance-windows. -(defvar window-area-factor 1 +(defvar-local window-area-factor 1 "Factor by which the window area should be over-estimated. This is used by `balance-windows-area'. Changing this globally has no effect.") -(make-variable-buffer-local 'window-area-factor) (defun balance-windows-area-adjust (window delta horizontal pixelwise) "Wrapper around `window-resize' with error checking. @@ -9580,8 +9578,7 @@ buffers displaying right to left text." ;; status is undone only when explicitly programmed, not when a buffer ;; is reverted or a mode function is called. -(defvar window-group-start-function nil) -(make-variable-buffer-local 'window-group-start-function) +(defvar-local window-group-start-function nil) (put 'window-group-start-function 'permanent-local t) (defun window-group-start (&optional window) "Return position at which display currently starts in the group of @@ -9594,8 +9591,7 @@ This is updated by redisplay or by calling `set-window*-start'." (funcall window-group-start-function window) (window-start window))) -(defvar window-group-end-function nil) -(make-variable-buffer-local 'window-group-end-function) +(defvar-local window-group-end-function nil) (put 'window-group-end-function 'permanent-local t) (defun window-group-end (&optional window update) "Return position at which display currently ends in the group of @@ -9614,8 +9610,7 @@ if it isn't already recorded." (funcall window-group-end-function window update) (window-end window update))) -(defvar set-window-group-start-function nil) -(make-variable-buffer-local 'set-window-group-start-function) +(defvar-local set-window-group-start-function nil) (put 'set-window-group-start-function 'permanent-local t) (defun set-window-group-start (window pos &optional noforce) "Make display in the group of windows containing WINDOW start at @@ -9629,8 +9624,7 @@ overriding motion of point in order to display at this exact start." (funcall set-window-group-start-function window pos noforce) (set-window-start window pos noforce))) -(defvar recenter-window-group-function nil) -(make-variable-buffer-local 'recenter-window-group-function) +(defvar-local recenter-window-group-function nil) (put 'recenter-window-group-function 'permanent-local t) (defun recenter-window-group (&optional arg) "Center point in the group of windows containing the selected window @@ -9656,8 +9650,7 @@ and redisplay normally--don't erase and redraw the frame." (funcall recenter-window-group-function arg) (recenter arg))) -(defvar pos-visible-in-window-group-p-function nil) -(make-variable-buffer-local 'pos-visible-in-window-group-p-function) +(defvar-local pos-visible-in-window-group-p-function nil) (put 'pos-visible-in-window-group-p-function 'permanent-local t) (defun pos-visible-in-window-group-p (&optional pos window partially) "Return non-nil if position POS is currently on the frame in the @@ -9687,8 +9680,7 @@ POS, ROWH is the visible height of that row, and VPOS is the row number (funcall pos-visible-in-window-group-p-function pos window partially) (pos-visible-in-window-p pos window partially))) -(defvar selected-window-group-function nil) -(make-variable-buffer-local 'selected-window-group-function) +(defvar-local selected-window-group-function nil) (put 'selected-window-group-function 'permanent-local t) (defun selected-window-group () "Return the list of windows in the group containing the selected window. @@ -9698,8 +9690,7 @@ result is a list containing only the selected window." (funcall selected-window-group-function) (list (selected-window)))) -(defvar move-to-window-group-line-function nil) -(make-variable-buffer-local 'move-to-window-group-line-function) +(defvar-local move-to-window-group-line-function nil) (put 'move-to-window-group-line-function 'permanent-local t) (defun move-to-window-group-line (arg) "Position point relative to the current group of windows. @@ -9742,13 +9733,16 @@ cycling order is middle -> top -> bottom." :group 'windows) (defun recenter-top-bottom (&optional arg) - "Move current buffer line to the specified window line. -With no prefix argument, successive calls place point according -to the cycling order defined by `recenter-positions'. - -A prefix argument is handled like `recenter': - With numeric prefix ARG, move current line to window-line ARG. - With plain `C-u', move current line to window center." + "Scroll the window so that current line is in the middle of the window. +Successive invocations scroll the window in a cyclical order to put +the current line at certain places within the window, as determined by +`recenter-positions'. By default, the second invocation puts the +current line at the top-most window line, the third invocation puts it +on the bottom-most window line, and then the order is reused in a +cyclical manner. + +With numeric prefix ARG, move current line ARG lines below the window top. +With plain \\[universal-argument], move current line to window center." (interactive "P") (cond (arg (recenter arg t)) ; Always respect ARG. @@ -9774,6 +9768,19 @@ A prefix argument is handled like `recenter': (define-key global-map [?\C-l] 'recenter-top-bottom) +(defun recenter-other-window (&optional arg) + "Call `recenter-top-bottom' in the other window. + +A prefix argument is handled like `recenter': + With numeric prefix ARG, move current line to window-line ARG. + With plain `C-u', move current line to window center." + (interactive "P") + (with-selected-window (other-window-for-scrolling) + (recenter-top-bottom arg) + (pulse-momentary-highlight-one-line (point)))) + +(define-key global-map [?\S-\M-\C-l] 'recenter-other-window) + (defun move-to-window-line-top-bottom (&optional arg) "Position point relative to window. diff --git a/lisp/woman.el b/lisp/woman.el index 0e4c1c10fca..9a03d30bb7f 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1078,9 +1078,8 @@ Set by `.ns' request; reset by any output or `.rs' request") ;; Could end with "\\( +\\|$\\)" instead of " *" "Regexp to match a ?roff request plus trailing white space.") -(defvar woman-imenu-done nil +(defvar-local woman-imenu-done nil "Buffer-local: set to true if function `woman-imenu' has been called.") -(make-variable-buffer-local 'woman-imenu-done) ;; From imenu.el -- needed when reformatting a file in its old buffer. ;; The latest buffer index used to update the menu bar menu. @@ -2115,7 +2114,7 @@ No external programs are used." (interactive) ; mainly for testing (WoMan-log-begin) (run-hooks 'woman-pre-format-hook) - (and (boundp 'font-lock-mode) font-lock-mode (font-lock-mode -1)) + (and font-lock-mode (font-lock-mode -1)) ;; (fundamental-mode) (let ((start-time (current-time)) time) |