Merge remote-tracking branch 'origin/scratch/lexical-gnus' into trunk
This commit is contained in:
Stefan Monnier
commit
11abc4aef4
101 changed files with 2494 additions and 2667 deletions
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
@ -3025,6 +3023,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
|
||||
|
|
@ -4326,74 +4326,69 @@ 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)))
|
||||
(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")
|
||||
|
||||
;;;
|
||||
;;; Gnus article mode
|
||||
|
|
@ -4721,8 +4716,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 +5002,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 +5076,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 +5168,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 +5208,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))))
|
||||
(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)
|
||||
(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 +5311,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 +5337,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 +5437,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)))))
|
||||
(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-internally (&optional 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 +5768,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 +6152,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 +6173,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 +6195,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 +7156,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 +7281,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 +7355,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 +7623,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 +7889,16 @@ 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
|
||||
(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 +7992,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 +8089,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 +8105,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 +8318,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 +8522,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 +8531,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 +8592,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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
@ -476,20 +477,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 +517,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 +529,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 +1375,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 +1386,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 +1511,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 +1559,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 +1583,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)
|
||||
|
|
@ -1608,7 +1627,7 @@ Some value are bound so the form can use them."
|
|||
(cons 'unread (if (numberp (car entry)) (car entry) 0))
|
||||
(cons 'total (if active (1+ (- (cdr active) (car active))) 0))
|
||||
(cons 'mailp (apply
|
||||
'append
|
||||
#'append
|
||||
(mapcar
|
||||
(lambda (x)
|
||||
(memq x (assoc
|
||||
|
|
@ -1735,7 +1754,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 +1902,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 +1950,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 +1961,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 +2004,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 +2070,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 +2533,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 +2819,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 +2938,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 +2997,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 +3007,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 +3130,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 +3138,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 +3386,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 +4280,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 +4339,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 +4506,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 +4628,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 +4698,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 +4760,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 +4822,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)
|
||||
|
|
|
|||
|
|
@ -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)))))))))
|
||||
'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)
|
||||
(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."
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
(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 (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."
|
||||
(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-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 (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-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)))
|
||||
(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-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 (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-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 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-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 (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)))
|
||||
(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-expunge-group (group gnus-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."
|
||||
(defun gnus-request-post (command-method)
|
||||
"Post the current buffer using COMMAND-METHOD."
|
||||
(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-post)
|
||||
(nth 1 gnus-command-method))))
|
||||
|
||||
(defun gnus-request-expunge-group (group command-method)
|
||||
"Expunge GROUP, which is removing articles that have been marked as deleted."
|
||||
(let ((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))))
|
||||
'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 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)))))
|
||||
(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))))
|
||||
(let ((gnus-command-method command-method))
|
||||
(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))
|
||||
(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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
"\\|")
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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.")
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -123,8 +123,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 +132,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 +144,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 +159,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 +167,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 +197,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 +206,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 +226,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 +246,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 +261,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 +291,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 +300,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 +336,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 +345,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 +367,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 +375,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 +383,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 +907,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)
|
||||
|
|
@ -1859,7 +1826,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 +1861,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 +1874,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)))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -644,7 +640,14 @@ 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
|
||||
`((indentation . ,indentation)
|
||||
(visible . ,visible)
|
||||
(name . ,name)
|
||||
(level . ,level)
|
||||
(number-of-groups . ,number-of-groups)
|
||||
(total-number-of-articles . ,total-number-of-articles)
|
||||
(entries . ,entries))))
|
||||
(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)))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
(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)
|
||||
(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)))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -3501,7 +3501,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 +3724,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)))
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -2195,10 +2195,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 +3174,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 +3198,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 +3675,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 +3992,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 +4066,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"))
|
||||
|
|
@ -4555,7 +4557,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 +4628,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 +4944,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 +4952,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 +5004,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 +5396,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 +6063,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 +6080,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 +6105,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 +6571,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 +6585,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 +6614,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 +6970,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 +7055,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 +7089,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 +8368,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)))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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"))))))
|
||||
|
||||
|
|
@ -346,8 +346,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 +558,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 +622,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 +795,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 +906,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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
;;;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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: ")
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)))))))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
(require 'bbdb nil 'noerror)
|
||||
(require 'bbdb-com nil 'noerror)
|
||||
|
||||
(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))
|
||||
(declare-function bbdb-records "bbdb" ())
|
||||
(declare-function bbdb-gethash "bbdb" (key &optional predicate))
|
||||
(declare-function bbdb-create-internal "bbdb-com" (&rest spec))
|
||||
|
||||
(add-hook 'bbdb-change-hook 'spam-clear-cache-BBDB)
|
||||
;; when the BBDB changes, we want to clear out our cache
|
||||
(defun spam-clear-cache-BBDB (&rest _immaterial)
|
||||
(spam-clear-cache 'spam-use-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")))))))
|
||||
(when (featurep 'bbdb-com)
|
||||
(add-hook 'bbdb-change-hook #'spam-clear-cache-BBDB))
|
||||
|
||||
(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-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-unregister-routine (articles)
|
||||
(spam-BBDB-register-routine articles t))
|
||||
(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)))
|
||||
|
||||
(defsubst spam-exists-in-BBDB-p (net)
|
||||
(when (and (stringp net) (not (zerop (length net))))
|
||||
(bbdb-records)
|
||||
(bbdb-gethash (downcase net))))
|
||||
(defun spam-BBDB-unregister-routine (articles)
|
||||
(spam-BBDB-register-routine articles t))
|
||||
|
||||
(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)))))))
|
||||
(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))
|
||||
(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)
|
||||
(add-hook 'spam-unload-hook #'spam-unload-hook)
|
||||
|
||||
;;}}}
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
||||
|
|
|
|||
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Reference in a new issue