summaryrefslogtreecommitdiff
path: root/lisp/gnus/gnus.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/gnus/gnus.el')
-rw-r--r--lisp/gnus/gnus.el492
1 files changed, 123 insertions, 369 deletions
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 4af818d9165..1ac02b4531c 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1,4 +1,4 @@
-;;; gnus.el --- a newsreader for GNU Emacs
+;;; gnus.el --- a newsreader for GNU Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1987-1990, 1993-1998, 2000-2018 Free Software
;; Foundation, Inc.
@@ -29,10 +29,11 @@
(run-hooks 'gnus-load-hook)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'wid-edit)
(require 'mm-util)
(require 'nnheader)
+(require 'seq)
;; These are defined afterwards with gnus-define-group-parameter
(defvar gnus-ham-process-destinations)
@@ -335,21 +336,6 @@ be set in `.emacs' instead."
;; We define these group faces here to avoid the display
;; update forced when creating new faces.
-(defface gnus-group-news-1
- '((((class color)
- (background dark))
- (:foreground "PaleTurquoise" :bold t))
- (((class color)
- (background light))
- (:foreground "ForestGreen" :bold t))
- (t
- ()))
- "Level 1 newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-1-face 'face-alias 'gnus-group-news-1)
-(put 'gnus-group-news-1-face 'obsolete-face "22.1")
-
(defface gnus-group-news-1-empty
'((((class color)
(background dark))
@@ -361,24 +347,11 @@ be set in `.emacs' instead."
()))
"Level 1 empty newsgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-1-empty-face 'face-alias 'gnus-group-news-1-empty)
-(put 'gnus-group-news-1-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-2
- '((((class color)
- (background dark))
- (:foreground "turquoise" :bold t))
- (((class color)
- (background light))
- (:foreground "CadetBlue4" :bold t))
- (t
- ()))
- "Level 2 newsgroup face."
+(defface gnus-group-news-1
+ '((t (:inherit gnus-group-news-1-empty :bold t)))
+ "Level 1 newsgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-2-face 'face-alias 'gnus-group-news-2)
-(put 'gnus-group-news-2-face 'obsolete-face "22.1")
(defface gnus-group-news-2-empty
'((((class color)
@@ -391,24 +364,11 @@ be set in `.emacs' instead."
()))
"Level 2 empty newsgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-2-empty-face 'face-alias 'gnus-group-news-2-empty)
-(put 'gnus-group-news-2-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-3
- '((((class color)
- (background dark))
- (:bold t))
- (((class color)
- (background light))
- (:bold t))
- (t
- ()))
- "Level 3 newsgroup face."
+(defface gnus-group-news-2
+ '((t (:inherit gnus-group-news-2-empty :bold t)))
+ "Level 2 newsgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-3-face 'face-alias 'gnus-group-news-3)
-(put 'gnus-group-news-3-face 'obsolete-face "22.1")
(defface gnus-group-news-3-empty
'((((class color)
@@ -421,24 +381,11 @@ be set in `.emacs' instead."
()))
"Level 3 empty newsgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-3-empty-face 'face-alias 'gnus-group-news-3-empty)
-(put 'gnus-group-news-3-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-4
- '((((class color)
- (background dark))
- (:bold t))
- (((class color)
- (background light))
- (:bold t))
- (t
- ()))
- "Level 4 newsgroup face."
+(defface gnus-group-news-3
+ '((t (:inherit gnus-group-news-3-empty :bold t)))
+ "Level 3 newsgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-4-face 'face-alias 'gnus-group-news-4)
-(put 'gnus-group-news-4-face 'obsolete-face "22.1")
(defface gnus-group-news-4-empty
'((((class color)
@@ -451,24 +398,11 @@ be set in `.emacs' instead."
()))
"Level 4 empty newsgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-4-empty-face 'face-alias 'gnus-group-news-4-empty)
-(put 'gnus-group-news-4-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-5
- '((((class color)
- (background dark))
- (:bold t))
- (((class color)
- (background light))
- (:bold t))
- (t
- ()))
- "Level 5 newsgroup face."
+(defface gnus-group-news-4
+ '((t (:inherit gnus-group-news-4-empty :bold t)))
+ "Level 4 newsgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-5-face 'face-alias 'gnus-group-news-5)
-(put 'gnus-group-news-5-face 'obsolete-face "22.1")
(defface gnus-group-news-5-empty
'((((class color)
@@ -481,24 +415,11 @@ be set in `.emacs' instead."
()))
"Level 5 empty newsgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-5-empty-face 'face-alias 'gnus-group-news-5-empty)
-(put 'gnus-group-news-5-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-6
- '((((class color)
- (background dark))
- (:bold t))
- (((class color)
- (background light))
- (:bold t))
- (t
- ()))
- "Level 6 newsgroup face."
+(defface gnus-group-news-5
+ '((t (:inherit gnus-group-news-5-empty :bold t)))
+ "Level 5 newsgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-6-face 'face-alias 'gnus-group-news-6)
-(put 'gnus-group-news-6-face 'obsolete-face "22.1")
(defface gnus-group-news-6-empty
'((((class color)
@@ -511,24 +432,11 @@ be set in `.emacs' instead."
()))
"Level 6 empty newsgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-6-empty-face 'face-alias 'gnus-group-news-6-empty)
-(put 'gnus-group-news-6-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-low
- '((((class color)
- (background dark))
- (:foreground "DarkTurquoise" :bold t))
- (((class color)
- (background light))
- (:foreground "DarkGreen" :bold t))
- (t
- ()))
- "Low level newsgroup face."
+(defface gnus-group-news-6
+ '((t (:inherit gnus-group-news-6-empty :bold t)))
+ "Level 6 newsgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-low-face 'face-alias 'gnus-group-news-low)
-(put 'gnus-group-news-low-face 'obsolete-face "22.1")
(defface gnus-group-news-low-empty
'((((class color)
@@ -541,24 +449,11 @@ be set in `.emacs' instead."
()))
"Low level empty newsgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-low-empty-face 'face-alias 'gnus-group-news-low-empty)
-(put 'gnus-group-news-low-empty-face 'obsolete-face "22.1")
-(defface gnus-group-mail-1
- '((((class color)
- (background dark))
- (:foreground "#e1ffe1" :bold t))
- (((class color)
- (background light))
- (:foreground "DeepPink3" :bold t))
- (t
- (:bold t)))
- "Level 1 mailgroup face."
+(defface gnus-group-news-low
+ '((t (:inherit gnus-group-news-low-empty :bold t)))
+ "Low level newsgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-1-face 'face-alias 'gnus-group-mail-1)
-(put 'gnus-group-mail-1-face 'obsolete-face "22.1")
(defface gnus-group-mail-1-empty
'((((class color)
@@ -568,27 +463,14 @@ be set in `.emacs' instead."
(background light))
(:foreground "DeepPink3"))
(t
- (:italic t :bold t)))
+ (:italic t)))
"Level 1 empty mailgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-1-empty-face 'face-alias 'gnus-group-mail-1-empty)
-(put 'gnus-group-mail-1-empty-face 'obsolete-face "22.1")
-(defface gnus-group-mail-2
- '((((class color)
- (background dark))
- (:foreground "DarkSeaGreen1" :bold t))
- (((class color)
- (background light))
- (:foreground "HotPink3" :bold t))
- (t
- (:bold t)))
- "Level 2 mailgroup face."
+(defface gnus-group-mail-1
+ '((t (:inherit gnus-group-mail-1-empty :bold t)))
+ "Level 1 mailgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-2-face 'face-alias 'gnus-group-mail-2)
-(put 'gnus-group-mail-2-face 'obsolete-face "22.1")
(defface gnus-group-mail-2-empty
'((((class color)
@@ -598,27 +480,14 @@ be set in `.emacs' instead."
(background light))
(:foreground "HotPink3"))
(t
- (:bold t)))
+ (:italic t)))
"Level 2 empty mailgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-2-empty-face 'face-alias 'gnus-group-mail-2-empty)
-(put 'gnus-group-mail-2-empty-face 'obsolete-face "22.1")
-(defface gnus-group-mail-3
- '((((class color)
- (background dark))
- (:foreground "aquamarine1" :bold t))
- (((class color)
- (background light))
- (:foreground "magenta4" :bold t))
- (t
- (:bold t)))
- "Level 3 mailgroup face."
+(defface gnus-group-mail-2
+ '((t (:inherit gnus-group-mail-2-empty :bold t)))
+ "Level 2 mailgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-3-face 'face-alias 'gnus-group-mail-3)
-(put 'gnus-group-mail-3-face 'obsolete-face "22.1")
(defface gnus-group-mail-3-empty
'((((class color)
@@ -631,24 +500,11 @@ be set in `.emacs' instead."
()))
"Level 3 empty mailgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-3-empty-face 'face-alias 'gnus-group-mail-3-empty)
-(put 'gnus-group-mail-3-empty-face 'obsolete-face "22.1")
-(defface gnus-group-mail-low
- '((((class color)
- (background dark))
- (:foreground "aquamarine2" :bold t))
- (((class color)
- (background light))
- (:foreground "DeepPink4" :bold t))
- (t
- (:bold t)))
- "Low level mailgroup face."
+(defface gnus-group-mail-3
+ '((t (:inherit gnus-group-mail-3-empty :bold t)))
+ "Level 3 mailgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-low-face 'face-alias 'gnus-group-mail-low)
-(put 'gnus-group-mail-low-face 'obsolete-face "22.1")
(defface gnus-group-mail-low-empty
'((((class color)
@@ -661,57 +517,23 @@ be set in `.emacs' instead."
(:bold t)))
"Low level empty mailgroup face."
:group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-low-empty-face 'face-alias 'gnus-group-mail-low-empty)
-(put 'gnus-group-mail-low-empty-face 'obsolete-face "22.1")
+
+(defface gnus-group-mail-low
+ '((t (:inherit gnus-group-mail-low-empty :bold t)))
+ "Low level mailgroup face."
+ :group 'gnus-group)
;; Summary mode faces.
(defface gnus-summary-selected '((t (:underline t)))
"Face used for selected articles."
:group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-selected-face 'face-alias 'gnus-summary-selected)
-(put 'gnus-summary-selected-face 'obsolete-face "22.1")
(defface gnus-summary-cancelled
'((((class color))
(:foreground "yellow" :background "black")))
"Face used for canceled articles."
:group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-cancelled-face 'face-alias 'gnus-summary-cancelled)
-(put 'gnus-summary-cancelled-face 'obsolete-face "22.1")
-
-(defface gnus-summary-high-ticked
- '((((class color)
- (background dark))
- (:foreground "pink" :bold t))
- (((class color)
- (background light))
- (:foreground "firebrick" :bold t))
- (t
- (:bold t)))
- "Face used for high interest ticked articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-high-ticked-face 'face-alias 'gnus-summary-high-ticked)
-(put 'gnus-summary-high-ticked-face 'obsolete-face "22.1")
-
-(defface gnus-summary-low-ticked
- '((((class color)
- (background dark))
- (:foreground "pink" :italic t))
- (((class color)
- (background light))
- (:foreground "firebrick" :italic t))
- (t
- (:italic t)))
- "Face used for low interest ticked articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-low-ticked-face 'face-alias 'gnus-summary-low-ticked)
-(put 'gnus-summary-low-ticked-face 'obsolete-face "22.1")
(defface gnus-summary-normal-ticked
'((((class color)
@@ -724,39 +546,16 @@ be set in `.emacs' instead."
()))
"Face used for normal interest ticked articles."
:group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-normal-ticked-face 'face-alias 'gnus-summary-normal-ticked)
-(put 'gnus-summary-normal-ticked-face 'obsolete-face "22.1")
-(defface gnus-summary-high-ancient
- '((((class color)
- (background dark))
- (:foreground "SkyBlue" :bold t))
- (((class color)
- (background light))
- (:foreground "RoyalBlue" :bold t))
- (t
- (:bold t)))
- "Face used for high interest ancient articles."
+(defface gnus-summary-high-ticked
+ '((t (:inherit gnus-summary-normal-ticked :bold t)))
+ "Face used for high interest ticked articles."
:group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-high-ancient-face 'face-alias 'gnus-summary-high-ancient)
-(put 'gnus-summary-high-ancient-face 'obsolete-face "22.1")
-(defface gnus-summary-low-ancient
- '((((class color)
- (background dark))
- (:foreground "SkyBlue" :italic t))
- (((class color)
- (background light))
- (:foreground "RoyalBlue" :italic t))
- (t
- (:italic t)))
- "Face used for low interest ancient articles."
+(defface gnus-summary-low-ticked
+ '((t (:inherit gnus-summary-normal-ticked :italic t)))
+ "Face used for low interest ticked articles."
:group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-low-ancient-face 'face-alias 'gnus-summary-low-ancient)
-(put 'gnus-summary-low-ancient-face 'obsolete-face "22.1")
(defface gnus-summary-normal-ancient
'((((class color)
@@ -769,35 +568,16 @@ be set in `.emacs' instead."
()))
"Face used for normal interest ancient articles."
:group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-normal-ancient-face 'face-alias 'gnus-summary-normal-ancient)
-(put 'gnus-summary-normal-ancient-face 'obsolete-face "22.1")
-(defface gnus-summary-high-undownloaded
- '((((class color)
- (background light))
- (:bold t :foreground "cyan4"))
- (((class color) (background dark))
- (:bold t :foreground "LightGray"))
- (t (:inverse-video t :bold t)))
- "Face used for high interest uncached articles."
+(defface gnus-summary-high-ancient
+ '((t (:inherit gnus-summary-normal-ancient :bold t)))
+ "Face used for high interest ancient articles."
:group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-high-undownloaded-face 'face-alias 'gnus-summary-high-undownloaded)
-(put 'gnus-summary-high-undownloaded-face 'obsolete-face "22.1")
-(defface gnus-summary-low-undownloaded
- '((((class color)
- (background light))
- (:italic t :foreground "cyan4" :bold nil))
- (((class color) (background dark))
- (:italic t :foreground "LightGray" :bold nil))
- (t (:inverse-video t :italic t)))
- "Face used for low interest uncached articles."
+(defface gnus-summary-low-ancient
+ '((t (:inherit gnus-summary-normal-ancient :italic t)))
+ "Face used for low interest ancient articles."
:group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-low-undownloaded-face 'face-alias 'gnus-summary-low-undownloaded)
-(put 'gnus-summary-low-undownloaded-face 'obsolete-face "22.1")
(defface gnus-summary-normal-undownloaded
'((((class color)
@@ -808,70 +588,32 @@ be set in `.emacs' instead."
(t (:inverse-video t)))
"Face used for normal interest uncached articles."
:group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-normal-undownloaded-face 'face-alias 'gnus-summary-normal-undownloaded)
-(put 'gnus-summary-normal-undownloaded-face 'obsolete-face "22.1")
-(defface gnus-summary-high-unread
- '((t
- (:bold t)))
- "Face used for high interest unread articles."
+(defface gnus-summary-high-undownloaded
+ '((t (:inherit gnus-summary-normal-undownloaded :bold t)))
+ "Face used for high interest uncached articles."
:group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-high-unread-face 'face-alias 'gnus-summary-high-unread)
-(put 'gnus-summary-high-unread-face 'obsolete-face "22.1")
-(defface gnus-summary-low-unread
- '((t
- (:italic t)))
- "Face used for low interest unread articles."
+(defface gnus-summary-low-undownloaded
+ '((t (:inherit gnus-summary-normal-undownloaded :italic t)))
+ "Face used for low interest uncached articles."
:group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-low-unread-face 'face-alias 'gnus-summary-low-unread)
-(put 'gnus-summary-low-unread-face 'obsolete-face "22.1")
(defface gnus-summary-normal-unread
'((t
()))
"Face used for normal interest unread articles."
:group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-normal-unread-face 'face-alias 'gnus-summary-normal-unread)
-(put 'gnus-summary-normal-unread-face 'obsolete-face "22.1")
-(defface gnus-summary-high-read
- '((((class color)
- (background dark))
- (:foreground "PaleGreen"
- :bold t))
- (((class color)
- (background light))
- (:foreground "DarkGreen"
- :bold t))
- (t
- (:bold t)))
- "Face used for high interest read articles."
+(defface gnus-summary-high-unread
+ '((t (:inherit gnus-summary-normal-unread :bold t)))
+ "Face used for high interest unread articles."
:group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-high-read-face 'face-alias 'gnus-summary-high-read)
-(put 'gnus-summary-high-read-face 'obsolete-face "22.1")
-(defface gnus-summary-low-read
- '((((class color)
- (background dark))
- (:foreground "PaleGreen"
- :italic t))
- (((class color)
- (background light))
- (:foreground "DarkGreen"
- :italic t))
- (t
- (:italic t)))
- "Face used for low interest read articles."
+(defface gnus-summary-low-unread
+ '((t (:inherit gnus-summary-normal-unread :italic t)))
+ "Face used for low interest unread articles."
:group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-low-read-face 'face-alias 'gnus-summary-low-read)
-(put 'gnus-summary-low-read-face 'obsolete-face "22.1")
(defface gnus-summary-normal-read
'((((class color)
@@ -884,10 +626,23 @@ be set in `.emacs' instead."
()))
"Face used for normal interest read articles."
:group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-normal-read-face 'face-alias 'gnus-summary-normal-read)
-(put 'gnus-summary-normal-read-face 'obsolete-face "22.1")
+(defface gnus-summary-high-read
+ '((t (:inherit gnus-summary-normal-read :bold t)))
+ "Face used for high interest read articles."
+ :group 'gnus-summary)
+
+(defface gnus-summary-low-read
+ '((t (:inherit gnus-summary-normal-read :italic t)))
+ "Face used for low interest read articles."
+ :group 'gnus-summary)
+
+;;; Base gnus-mode
+
+(define-derived-mode gnus-mode special-mode nil
+ "Base mode from which all other gnus modes derive.
+This does nothing but derive from `special-mode', and should not
+be used directly.")
;;;
;;; Gnus buffers
@@ -946,9 +701,6 @@ be set in `.emacs' instead."
()))
"Face for the splash screen."
:group 'gnus-start)
-;; backward-compatibility alias
-(put 'gnus-splash-face 'face-alias 'gnus-splash)
-(put 'gnus-splash-face 'obsolete-face "22.1")
(defun gnus-splash ()
(save-excursion
@@ -1006,6 +758,7 @@ be set in `.emacs' instead."
(cdr (assq gnus-logo-color-style gnus-logo-color-alist))
"Colors used for the Gnus logo.")
+(defvar image-load-path)
(declare-function image-size "image.c" (spec &optional pixels frame))
(defun gnus-group-startup-message (&optional x y)
@@ -1106,12 +859,11 @@ be set in `.emacs' instead."
(cons (car list) (list :type type :data data)))
list)))
-(eval-when (load)
- (let ((command (format "%s" this-command)))
- (when (string-match "gnus" command)
- (if (string-match "gnus-other-frame" command)
- (gnus-get-buffer-create gnus-group-buffer)
- (gnus-splash)))))
+(let ((command (format "%s" this-command)))
+ (when (string-match "gnus" command)
+ (if (eq 'gnus-other-frame this-command)
+ (gnus-get-buffer-create gnus-group-buffer)
+ (gnus-splash))))
;;; Do the rest.
@@ -2479,7 +2231,7 @@ Disabling the agent may result in noticeable loss of performance."
:group 'gnus-agent
:type 'boolean)
-(defcustom gnus-other-frame-function 'gnus
+(defcustom gnus-other-frame-function #'gnus
"Function called by the command `gnus-other-frame' when starting Gnus."
:group 'gnus-start
:type '(choice (function-item gnus)
@@ -2487,7 +2239,9 @@ Disabling the agent may result in noticeable loss of performance."
(function-item gnus-slave)
(function-item gnus-slave-no-server)))
-(defcustom gnus-other-frame-resume-function 'gnus-group-get-new-news
+(declare-function gnus-group-get-new-news "gnus-group")
+
+(defcustom gnus-other-frame-resume-function #'gnus-group-get-new-news
"Function called by the command `gnus-other-frame' when resuming Gnus."
:version "24.4"
:group 'gnus-start
@@ -2555,7 +2309,7 @@ a string, be sure to use a valid format, see RFC 2616."
)
(defvar gnus-agent-target-move-group-header "X-Gnus-Agent-Move-To")
(defvar gnus-draft-meta-information-header "X-Draft-From")
-(defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
+(defvar gnus-group-get-parameter-function #'gnus-group-get-parameter)
(defvar gnus-original-article-buffer " *Original Article*")
(defvar gnus-newsgroup-name nil)
(defvar gnus-ephemeral-servers nil)
@@ -2592,7 +2346,9 @@ a string, be sure to use a valid format, see RFC 2616."
(defvar gnus-group-history nil)
(defvar gnus-server-alist nil
- "List of available servers.")
+ "Servers created by Gnus, or via the server buffer.
+Servers defined in the user's config files do not appear here.
+This variable is persisted in the user's .newsrc.eld file.")
(defcustom gnus-cache-directory
(nnheader-concat gnus-directory "cache/")
@@ -2755,7 +2511,6 @@ gnus-registry.el will populate this if it's loaded.")
(nthcdr 3 package)
(cdr package)))))
'(("info" :interactive t Info-goto-node)
- ("pp" pp-to-string)
("qp" quoted-printable-decode-region quoted-printable-decode-string)
("ps-print" ps-print-preprint)
("message" :interactive t
@@ -2902,7 +2657,6 @@ gnus-registry.el will populate this if it's loaded.")
gnus-check-reasonable-setup)
("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article
gnus-dup-enter-articles)
- ("gnus-range" gnus-copy-sequence)
("gnus-eform" gnus-edit-form)
("gnus-logic" gnus-score-advanced)
("gnus-undo" gnus-undo-mode gnus-undo-register)
@@ -3016,7 +2770,7 @@ See Info node `(gnus)Formatting Variables'."
(defun gnus-suppress-keymap (keymap)
(suppress-keymap keymap)
- (let ((keys `([delete] "\177" "\M-u"))) ;[mouse-2]
+ (let ((keys '([delete] "\177" "\M-u"))) ;[mouse-2]
(while keys
(define-key keymap (pop keys) 'undefined))))
@@ -3179,9 +2933,9 @@ with a `subscribed' parameter."
(or (gnus-group-fast-parameter group 'to-address)
(gnus-group-fast-parameter group 'to-list))))
(when address
- (add-to-list 'addresses address))))
+ (cl-pushnew address addresses :test #'equal))))
(when addresses
- (list (mapconcat 'regexp-quote addresses "\\|")))))
+ (list (mapconcat #'regexp-quote addresses "\\|")))))
(defmacro gnus-string-or (&rest strings)
"Return the first element of STRINGS that is a non-blank string.
@@ -3234,6 +2988,8 @@ If ARG, insert string at point."
minor least)
(format "%d.%02d%02d" major minor least))))))
+(defvar gnus-info-buffer)
+
(defun gnus-info-find-node (&optional nodename)
"Find Info documentation of Gnus."
(interactive)
@@ -3253,7 +3009,7 @@ If ARG, insert string at point."
(defvar gnus-current-prefix-symbols nil
"List of current prefix symbols.")
-(defun gnus-interactive (string &optional params)
+(defun gnus-interactive (string)
"Return a list that can be fed to `interactive'.
See `interactive' for full documentation.
@@ -3345,9 +3101,9 @@ g -- Group name."
(setq out (delq 'gnus-prefix-nil out))
(nreverse out)))
-(defun gnus-symbolic-argument (&optional arg)
+(defun gnus-symbolic-argument ()
"Read a symbolic argument and a command, and then execute command."
- (interactive "P")
+ (interactive)
(let* ((in-command (this-command-keys))
(command in-command)
gnus-current-prefix-symbols
@@ -3463,16 +3219,15 @@ that that variable is buffer-local to the summary buffers."
(throw 'server-name (car name-method))))
gnus-server-method-cache))
- (mapc
- (lambda (server-alist)
- (mapc (lambda (name-method)
- (when (gnus-methods-equal-p (cdr name-method) method)
- (unless (member name-method gnus-server-method-cache)
- (push name-method gnus-server-method-cache))
- (throw 'server-name (car name-method))))
- server-alist))
- (list gnus-server-alist
- gnus-predefined-server-alist))
+ (dolist (server-alist
+ (list gnus-server-alist
+ gnus-predefined-server-alist))
+ (mapc (lambda (name-method)
+ (when (gnus-methods-equal-p (cdr name-method) method)
+ (unless (member name-method gnus-server-method-cache)
+ (push name-method gnus-server-method-cache))
+ (throw 'server-name (car name-method))))
+ server-alist))
(let* ((name (if (member (cadr method) '(nil ""))
(format "%s" (car method))
@@ -3574,26 +3329,26 @@ that that variable is buffer-local to the summary buffers."
(let ((p1 (copy-sequence (cddr m1)))
(p2 (copy-sequence (cddr m2)))
e1 e2)
- (block nil
+ (cl-block nil
(while (setq e1 (pop p1))
(unless (setq e2 (assq (car e1) p2))
;; The parameter doesn't exist in p2.
- (return nil))
+ (cl-return nil))
(setq p2 (delq e2 p2))
(unless (equal e1 e2)
(if (not (and (stringp (cadr e1))
(stringp (cadr e2))))
- (return nil)
+ (cl-return nil)
;; Special-case string parameter comparison so that we
;; can uniquify them.
(let ((s1 (cadr e1))
(s2 (cadr e2)))
- (when (string-match "/$" s1)
+ (when (string-match "/\\'" s1)
(setq s1 (directory-file-name s1)))
- (when (string-match "/$" s2)
+ (when (string-match "/\\'" s2)
(setq s2 (directory-file-name s2)))
(unless (equal s1 s2)
- (return nil))))))
+ (cl-return nil))))))
;; If p2 now is empty, they were equal.
(null p2))))
@@ -3981,8 +3736,7 @@ If SCORE is nil, add 1 to the score of GROUP."
"Collapse GROUP name LEVELS.
Select methods are stripped and any remote host name is stripped down to
just the host name."
- (let* ((name "")
- (foreign "")
+ (let* ((foreign "")
(depth 0)
(skip 1)
(levels (or levels
@@ -4024,13 +3778,13 @@ just the host name."
gsep "."))
(setq levels (- glen levels))
(dolist (g glist)
- (push (if (>= (decf levels) 0)
+ (push (if (>= (cl-decf levels) 0)
(if (zerop (length g))
""
(substring g 0 1))
g)
res))
- (concat foreign (mapconcat 'identity (nreverse res) gsep))))))
+ (concat foreign (mapconcat #'identity (nreverse res) gsep))))))
(defun gnus-narrow-to-body ()
"Narrow to the body of an article."
@@ -4272,7 +4026,7 @@ Allow completion over sensible values."
gnus-server-alist))
(method
(gnus-completing-read
- prompt (mapcar 'car servers)
+ prompt (mapcar #'car servers)
t nil 'gnus-method-history)))
(cond
((equal method "")
@@ -4385,13 +4139,13 @@ current display is used."
(progn (switch-to-buffer gnus-group-buffer)
(funcall gnus-other-frame-resume-function arg))
(funcall gnus-other-frame-function arg)
- (add-hook 'gnus-exit-gnus-hook 'gnus-delete-gnus-frame)
+ (add-hook 'gnus-exit-gnus-hook #'gnus-delete-gnus-frame)
;; One might argue that `gnus-delete-gnus-frame' should not be called
;; from `gnus-suspend-gnus-hook', but, on the other hand, one might
;; argue that it should. No matter what you think, for the sake of
;; those who want it to be called from it, please keep (defun
;; gnus-delete-gnus-frame) even if you remove the next `add-hook'.
- (add-hook 'gnus-suspend-gnus-hook 'gnus-delete-gnus-frame)))))
+ (add-hook 'gnus-suspend-gnus-hook #'gnus-delete-gnus-frame)))))
;;;###autoload
(defun gnus (&optional arg dont-connect slave)
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-22 17:10:12 +0000