diff options
Diffstat (limited to 'lisp/gnus/gnus-util.el')
| -rw-r--r-- | lisp/gnus/gnus-util.el | 160 |
1 files changed, 49 insertions, 111 deletions
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index de3c854ca56..3c7c948c2b5 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,16 +1055,16 @@ 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 @@ -1197,6 +1140,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 +1163,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 +1205,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 +1213,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 +1234,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 +1295,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 +1353,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 +1383,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 +1407,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 +1449,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 +1506,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 +1532,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 +1566,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 +1582,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 +1685,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))) |