(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))))
(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."
;;; 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)
(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))
(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)))
+(defmacro gnus--\,@ (exp)
+ (declare (debug t))
+ `(progn ,@(eval exp t)))
+
+(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")
\f
;;;
;;; Gnus article mode
(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"))
(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)
`(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)
(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
;; 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.
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."
(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")))
,@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)))
(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)
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)
;; 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"))
(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."
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."
(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
The variables bound and their default values are described by
the `mail-source-keyword-map' variable."
+ (declare (indent 1) (debug (sexp body)))
`(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))
(defun mail-source-set-1 (source)
(let* ((type (pop source))
(defmacro mail-source-bind-common (source &rest body)
"Return a `let' form that binds all common variables.
See `mail-source-bind'."
+ (declare (indent 1) (debug (sexp body)))
`(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))
-
(defun mail-source-value (value)
"Return the value of VALUE."
(cond
(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
(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.
;;; 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)
(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))
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)))
(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 nnoo-register-function (func)
(let ((funcs (nthcdr 3 (assoc (nnoo-backend func)
(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)))
(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
(setq vars (cdr vars)))))))
(defmacro nnoo-map-functions (backend &rest maps)
+ (declare (indent 1))
`(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)
projects / emacs.git / commitdiff