summaryrefslogtreecommitdiff
path: root/lisp/gnus
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/gnus')
-rw-r--r--lisp/gnus/gnus-agent.el6
-rw-r--r--lisp/gnus/gnus-art.el3
-rw-r--r--lisp/gnus/gnus-cloud.el4
-rw-r--r--lisp/gnus/gnus-group.el2
-rw-r--r--lisp/gnus/gnus-html.el6
-rw-r--r--lisp/gnus/gnus-score.el10
-rw-r--r--lisp/gnus/gnus-srvr.el6
-rw-r--r--lisp/gnus/gnus.el447
-rw-r--r--lisp/gnus/message.el2
-rw-r--r--lisp/gnus/nndiary.el2
-rw-r--r--lisp/gnus/nnmail.el2
-rw-r--r--lisp/gnus/nnmaildir.el2
-rw-r--r--lisp/gnus/score-mode.el2
13 files changed, 180 insertions, 314 deletions
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index daf578180f2..6e7cc57a4cc 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -1513,7 +1513,7 @@ downloaded into the agent."
(let* ((fetched-articles (list nil))
(tail-fetched-articles fetched-articles)
(dir (gnus-agent-group-pathname group))
- (date (time-to-days (current-time)))
+ (date (time-to-days nil))
(case-fold-search t)
pos crosses
(file-name-coding-system nnmail-pathname-coding-system))
@@ -3089,7 +3089,7 @@ FORCE is equivalent to setting the expiration predicates to true."
(nov-entries-deleted 0)
(info (gnus-get-info group))
(alist gnus-agent-article-alist)
- (day (- (time-to-days (current-time))
+ (day (- (time-to-days nil)
(gnus-agent-find-parameter group 'agent-days-until-old)))
(specials (if (and alist
(not force))
@@ -3824,7 +3824,7 @@ has been fetched."
;; be expired later.
(gnus-agent-load-alist group)
(gnus-agent-save-alist group (list article)
- (time-to-days (current-time))))))
+ (time-to-days nil)))))
(defun gnus-agent-regenerate-group (group &optional reread)
"Regenerate GROUP.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index c130dc1b6c6..97aa878ab63 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -3628,8 +3628,7 @@ possible values."
(defun article-lapsed-string (time &optional max-segments)
;; If the date is seriously mangled, the timezone functions are
;; liable to bug out, so we ignore all errors.
- (let* ((now (current-time))
- (real-time (time-subtract now time))
+ (let* ((real-time (time-subtract nil time))
(real-sec (and real-time
(+ (* (float (car real-time)) 65536)
(cadr real-time))))
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index 5ea2d691f15..c57576cf3c7 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -219,7 +219,7 @@ easy interactive way to set this from the Server buffer."
Use old data if FORCE-OLDER is not nil."
(let* ((contents (plist-get elem :contents))
(date (or (plist-get elem :timestamp) "0"))
- (now (gnus-cloud-timestamp (current-time)))
+ (now (gnus-cloud-timestamp nil))
(newer (string-lessp date now))
(group-info (gnus-get-info group)))
(if (and contents
@@ -486,7 +486,7 @@ Otherwise, returns the Gnus Cloud data chunks."
(gnus-method-to-server
(gnus-find-method-for-group (gnus-info-group info))))
- (push `(:type :newsrc-data :name ,(gnus-info-group info) :contents ,info :timestamp ,(gnus-cloud-timestamp (current-time)))
+ (push `(:type :newsrc-data :name ,(gnus-info-group info) :contents ,info :timestamp ,(gnus-cloud-timestamp nil))
infos)))
infos))
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 996e8266105..89f17316cf1 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -4565,7 +4565,7 @@ or `gnus-group-catchup-group-hook'."
"Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."
(let* ((time (or (gnus-group-timestamp group)
(list 0 0)))
- (delta (time-subtract (current-time) time)))
+ (delta (time-subtract nil time)))
(+ (* (nth 0 delta) 65536.0)
(nth 1 delta))))
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index 6d529558f73..7fa36359f67 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -99,11 +99,7 @@ fit these criteria."
(not (file-exists-p (url-cache-create-filename url))))
(t (let ((cache-time (url-is-cached url)))
(if cache-time
- (time-less-p
- (time-add
- cache-time
- ttl)
- (current-time))
+ (time-less-p (time-add cache-time ttl) nil)
t)))))
;;;###autoload
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 11a45dda9ad..bc11aa528fa 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -1238,7 +1238,7 @@ If FORMAT, also format the current score file."
(or (not decay)
(gnus-decay-scores alist decay)))
(gnus-score-set 'touched '(t) alist)
- (gnus-score-set 'decay (list (time-to-days (current-time))) alist))
+ (gnus-score-set 'decay (list (time-to-days nil)) alist))
;; We do not respect eval and files atoms from global score
;; files.
(when (and files (not global))
@@ -2731,8 +2731,10 @@ GROUP using BNews sys file syntax."
(insert (car sfiles))
(goto-char (point-min))
;; First remove the suffix itself.
- (when (re-search-forward (concat "." score-regexp) nil t)
- (replace-match "" t t)
+ (when (re-search-forward score-regexp nil t)
+ (unless (= (match-end 0) (match-beginning 0)) ; non-empty suffix
+ (replace-match "" t t)
+ (delete-char -1)) ; remove the "." before the suffix
(goto-char (point-min))
(if (looking-at (regexp-quote kill-dir))
;; If the file name was just "SCORE", `klen' is one character
@@ -3060,7 +3062,7 @@ If ADAPT, return the home adaptive file instead."
(defun gnus-decay-scores (alist day)
"Decay non-permanent scores in ALIST."
- (let ((times (- (time-to-days (current-time)) day))
+ (let ((times (- (time-to-days nil) day))
kill entry updated score n)
(unless (zerop times) ;Done decays today already?
(while (setq entry (pop alist))
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 82056cf1653..8a91973e388 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -452,7 +452,8 @@ The following commands are available:
(if server (error "No such server: %s" server)
(error "No server on the current line")))
(unless (assoc server gnus-server-alist)
- (error "Read-only server %s" server))
+ (error "Server %s must be deleted from your configuration files"
+ server))
(gnus-dribble-touch)
(let ((buffer-read-only nil))
(gnus-delete-line))
@@ -642,7 +643,8 @@ The following commands are available:
(unless server
(error "No server on current line"))
(unless (assoc server gnus-server-alist)
- (error "This server can't be edited"))
+ (error "Server %s must be edited in your configuration files"
+ server))
(let ((info (cdr (assoc server gnus-server-alist))))
(gnus-close-server info)
(gnus-edit-form
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 8c0846be9f7..01e75120434 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-2017 Free Software
;; Foundation, Inc.
@@ -29,7 +29,7 @@
(run-hooks 'gnus-load-hook)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'wid-edit)
(require 'mm-util)
(require 'nnheader)
@@ -335,21 +335,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))
@@ -365,20 +350,13 @@ be set in `.emacs' instead."
(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")
+(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-2-empty
'((((class color)
@@ -395,20 +373,13 @@ be set in `.emacs' instead."
(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")
+(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-3-empty
'((((class color)
@@ -425,20 +396,13 @@ be set in `.emacs' instead."
(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")
+(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-4-empty
'((((class color)
@@ -455,20 +419,13 @@ be set in `.emacs' instead."
(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")
+(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-5-empty
'((((class color)
@@ -485,20 +442,13 @@ be set in `.emacs' instead."
(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")
+(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-6-empty
'((((class color)
@@ -515,20 +465,13 @@ be set in `.emacs' instead."
(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")
+(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-low-empty
'((((class color)
@@ -545,20 +488,13 @@ be set in `.emacs' instead."
(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")
+(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-mail-1-empty
'((((class color)
@@ -568,27 +504,20 @@ 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")
+(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-2-empty
'((((class color)
@@ -598,27 +527,20 @@ 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")
+(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-3-empty
'((((class color)
@@ -635,20 +557,13 @@ be set in `.emacs' instead."
(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")
+(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-low-empty
'((((class color)
@@ -665,6 +580,14 @@ be set in `.emacs' instead."
(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)
+;; 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")
+
;; Summary mode faces.
(defface gnus-summary-selected '((t (:underline t)))
@@ -683,15 +606,23 @@ be set in `.emacs' instead."
(put 'gnus-summary-cancelled-face 'face-alias 'gnus-summary-cancelled)
(put 'gnus-summary-cancelled-face 'obsolete-face "22.1")
-(defface gnus-summary-high-ticked
+(defface gnus-summary-normal-ticked
'((((class color)
(background dark))
- (:foreground "pink" :bold t))
+ (:foreground "pink"))
(((class color)
(background light))
- (:foreground "firebrick" :bold t))
+ (:foreground "firebrick"))
(t
- (:bold t)))
+ ()))
+ "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-ticked
+ '((t (:inherit gnus-summary-normal-ticked :bold t)))
"Face used for high interest ticked articles."
:group 'gnus-summary)
;; backward-compatibility alias
@@ -699,44 +630,30 @@ be set in `.emacs' instead."
(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)))
+ '((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-ticked-face 'face-alias 'gnus-summary-low-ticked)
(put 'gnus-summary-low-ticked-face 'obsolete-face "22.1")
-(defface gnus-summary-normal-ticked
+(defface gnus-summary-normal-ancient
'((((class color)
(background dark))
- (:foreground "pink"))
+ (:foreground "SkyBlue"))
(((class color)
(background light))
- (:foreground "firebrick"))
+ (:foreground "RoyalBlue"))
(t
()))
- "Face used for normal interest ticked articles."
+ "Face used for normal interest ancient 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")
+(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-ancient
- '((((class color)
- (background dark))
- (:foreground "SkyBlue" :bold t))
- (((class color)
- (background light))
- (:foreground "RoyalBlue" :bold t))
- (t
- (:bold t)))
+ '((t (:inherit gnus-summary-normal-ancient :bold t)))
"Face used for high interest ancient articles."
:group 'gnus-summary)
;; backward-compatibility alias
@@ -744,42 +661,28 @@ be set in `.emacs' instead."
(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)))
+ '((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-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)
- (background dark))
- (:foreground "SkyBlue"))
- (((class color)
- (background light))
- (:foreground "RoyalBlue"))
- (t
- ()))
- "Face used for normal interest ancient articles."
+(defface gnus-summary-normal-undownloaded
+ '((((class color)
+ (background light))
+ (:foreground "cyan4" :bold nil))
+ (((class color) (background dark))
+ (:foreground "LightGray" :bold nil))
+ (t (:inverse-video t)))
+ "Face used for normal interest uncached 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")
+(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-undownloaded
- '((((class color)
- (background light))
- (:bold t :foreground "cyan4"))
- (((class color) (background dark))
- (:bold t :foreground "LightGray"))
- (t (:inverse-video t :bold t)))
+ '((t (:inherit gnus-summary-normal-undownloaded :bold t)))
"Face used for high interest uncached articles."
:group 'gnus-summary)
;; backward-compatibility alias
@@ -787,34 +690,24 @@ be set in `.emacs' instead."
(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)))
+ '((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-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)
- (background light))
- (:foreground "cyan4" :bold nil))
- (((class color) (background dark))
- (:foreground "LightGray" :bold nil))
- (t (:inverse-video t)))
- "Face used for normal interest uncached articles."
+(defface gnus-summary-normal-unread
+ '((t
+ ()))
+ "Face used for normal interest unread 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")
+(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-unread
- '((t
- (:bold t)))
+ '((t (:inherit gnus-summary-normal-unread :bold t)))
"Face used for high interest unread articles."
:group 'gnus-summary)
;; backward-compatibility alias
@@ -822,34 +715,30 @@ be set in `.emacs' instead."
(put 'gnus-summary-high-unread-face 'obsolete-face "22.1")
(defface gnus-summary-low-unread
- '((t
- (:italic t)))
+ '((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-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
+(defface gnus-summary-normal-read
'((((class color)
(background dark))
- (:foreground "PaleGreen"
- :bold t))
+ (:foreground "PaleGreen"))
(((class color)
(background light))
- (:foreground "DarkGreen"
- :bold t))
+ (:foreground "DarkGreen"))
(t
- (:bold t)))
+ ()))
+ "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)
;; backward-compatibility alias
@@ -857,37 +746,13 @@ be set in `.emacs' instead."
(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)))
+ '((t (:inherit gnus-summary-normal-read :italic t)))
"Face used for low interest read 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)
- (background dark))
- (:foreground "PaleGreen"))
- (((class color)
- (background light))
- (:foreground "DarkGreen"))
- (t
- ()))
- "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")
-
;;;
;;; Gnus buffers
@@ -1106,12 +971,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 +2343,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 +2351,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 +2421,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 +2458,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 +2623,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
@@ -3179,9 +3046,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 +3101,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 +3122,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 +3214,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 +3332,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 +3442,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 +3849,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 +3891,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 +4139,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 +4252,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)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 690311e36a5..f6777c5e884 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -4390,7 +4390,7 @@ This function could be useful in `message-setup-hook'."
(if (string= encoded bog)
""
(format " (%s)" encoded))))))
- (error "Bogus address"))))))))
+ (user-error "Bogus address"))))))))
(custom-add-option 'message-setup-hook 'message-check-recipients)
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index 2589fa80893..ca4dca4189d 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -1532,7 +1532,7 @@ all. This may very well take some time.")
;; past. A permanent schedule never expires.
(and sched
(setq sched (nndiary-last-occurrence sched))
- (time-less-p sched (current-time))))
+ (time-less-p sched nil)))
;; else
(nnheader-report 'nndiary "Could not read file %s" file)
nil)
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index db5415cf9f7..ad58d292082 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1883,7 +1883,7 @@ If TIME is nil, then return the cutoff time for oldness instead."
(setq days (days-to-time days))
;; Compare the time with the current time.
(if (null time)
- (time-subtract (current-time) days)
+ (time-subtract nil days)
(ignore-errors (time-less-p days (time-since time)))))))))
(declare-function gnus-group-mark-article-read "gnus-group" (group article))
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 272240f5a9f..708a3426af1 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -814,7 +814,7 @@ This variable is set by `nnmaildir-request-article'.")
(when (or isnew nattr)
(dolist (file (funcall ls ndir nil "\\`[^.]" 'nosort))
(setq x (concat ndir file))
- (and (time-less-p (nth 5 (file-attributes x)) (current-time))
+ (and (time-less-p (nth 5 (file-attributes x)) nil)
(rename-file x (concat cdir (nnmaildir--ensure-suffix file)))))
(setf (nnmaildir--grp-new group) nattr))
(setq cattr (nth 5 (file-attributes cdir)))
diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el
index 098ecd5dc3d..3e7428493e4 100644
--- a/lisp/gnus/score-mode.el
+++ b/lisp/gnus/score-mode.el
@@ -85,7 +85,7 @@ This mode is an extended emacs-lisp mode.
(defun gnus-score-edit-insert-date ()
"Insert date in numerical format."
(interactive)
- (princ (time-to-days (current-time)) (current-buffer)))
+ (princ (time-to-days nil) (current-buffer)))
(defun gnus-score-pretty-print ()
"Format the current score file."
generated by cgit v1.2.3 (git 2.39.1) at 2025-06-28 20:29:58 +0000