diff options
Diffstat (limited to 'lisp/gnus')
104 files changed, 1607 insertions, 1687 deletions
diff --git a/lisp/gnus/ChangeLog.1 b/lisp/gnus/ChangeLog.1 index 30fd75f14e9..333da55bd82 100644 --- a/lisp/gnus/ChangeLog.1 +++ b/lisp/gnus/ChangeLog.1 @@ -3702,7 +3702,7 @@ * gnus.el: Quassia Gnus v0.1 is released. - Copyright (C) 1997-2018 Free Software Foundation, Inc. + Copyright (C) 1997-2019 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2 index b49a8661a72..bc507d59dc3 100644 --- a/lisp/gnus/ChangeLog.2 +++ b/lisp/gnus/ChangeLog.2 @@ -18538,7 +18538,7 @@ See ChangeLog.1 for earlier changes. - Copyright (C) 2000-2002, 2004-2018 Free Software Foundation, Inc. + Copyright (C) 2000-2002, 2004-2019 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/lisp/gnus/ChangeLog.3 b/lisp/gnus/ChangeLog.3 index f98a6dc2c35..3bd9f897290 100644 --- a/lisp/gnus/ChangeLog.3 +++ b/lisp/gnus/ChangeLog.3 @@ -26325,7 +26325,7 @@ See ChangeLog.2 for earlier changes. - Copyright (C) 2004-2018 Free Software Foundation, Inc. + Copyright (C) 2004-2019 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/lisp/gnus/canlock.el b/lisp/gnus/canlock.el index 0bd47cdde9a..7edc91a2a46 100644 --- a/lisp/gnus/canlock.el +++ b/lisp/gnus/canlock.el @@ -1,6 +1,6 @@ ;;; canlock.el --- functions for Cancel-Lock feature -;; Copyright (C) 1998-1999, 2001-2018 Free Software Foundation, Inc. +;; Copyright (C) 1998-1999, 2001-2019 Free Software Foundation, Inc. ;; Author: Katsumi Yamaoka <yamaoka@jpl.org> ;; Keywords: news, cancel-lock, hmac, sha1, rfc2104 diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el index 6286c535ca2..2fdc34e3e18 100644 --- a/lisp/gnus/deuglify.el +++ b/lisp/gnus/deuglify.el @@ -1,6 +1,6 @@ ;;; deuglify.el --- deuglify broken Outlook (Express) articles -;; Copyright (C) 2001-2018 Free Software Foundation, Inc. +;; Copyright (C) 2001-2019 Free Software Foundation, Inc. ;; Author: Raymond Scholz <rscholz@zonix.de> ;; Thomas Steffen diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index 224299bbb9b..6e324f9cb5f 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -1,6 +1,6 @@ ;;; gmm-utils.el --- Utility functions for Gnus, Message and MML -;; Copyright (C) 2006-2018 Free Software Foundation, Inc. +;; Copyright (C) 2006-2019 Free Software Foundation, Inc. ;; Author: Reiner Steib <reiner.steib@gmx.de> ;; Keywords: news diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 28d8ac6d975..9f7d2c9df7d 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -1,6 +1,6 @@ ;;; gnus-agent.el --- unplugged support for Gnus -;; Copyright (C) 1997-2018 Free Software Foundation, Inc. +;; Copyright (C) 1997-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; This file is part of GNU Emacs. @@ -225,7 +225,9 @@ NOTES: (defvar gnus-agent-overview-buffer nil) (defvar gnus-category-predicate-cache nil) (defvar gnus-category-group-cache nil) -(defvar gnus-agent-spam-hashtb nil) +(defvar gnus-agent-spam-hashtb nil + "Cache of message subjects for spam messages. +Actually a hash table holding subjects mapped to t.") (defvar gnus-agent-file-name nil) (defvar gnus-agent-file-coding-system 'raw-text) (defvar gnus-agent-file-loading-cache nil) @@ -274,7 +276,7 @@ NOTES: (defmacro gnus-agent-with-refreshed-group (group &rest body) "Performs the body then updates the group's line in the group buffer. Automatically blocks multiple updates due to recursion." -`(prog1 (let ((gnus-agent-inhibit-update-total-fetched-for t)) ,@body) + `(prog1 (let ((gnus-agent-inhibit-update-total-fetched-for t)) ,@body) (when (and gnus-agent-need-update-total-fetched-for (not gnus-agent-inhibit-update-total-fetched-for)) (with-current-buffer gnus-group-buffer @@ -309,9 +311,10 @@ buffer. Automatically blocks multiple updates due to recursion." (defun gnus-agent-cat-set-property (category property value) (if value (setcdr (or (assq property category) - (let ((cell (cons property nil))) + (let ((cell (cons property nil))) (setcdr category (cons cell (cdr category))) - cell)) value) + cell)) + value) (let ((category category)) (while (cond ((eq property (caadr category)) (setcdr category (cddr category)) @@ -376,7 +379,8 @@ manipulated as follows: (setcdr (or (assq 'agent-groups category) (let ((cell (cons 'agent-groups nil))) (setcdr category (cons cell (cdr category))) - cell)) new-g)) + cell)) + new-g)) (t (let ((groups groups)) (while groups @@ -393,7 +397,8 @@ manipulated as follows: (setcdr (or (assq 'agent-groups category) (let ((cell (cons 'agent-groups nil))) (setcdr category (cons cell (cdr category))) - cell)) groups)))))) + cell)) + groups)))))) (defsubst gnus-agent-cat-make (name &optional default-agent-predicate) (list name `(agent-predicate . ,(or default-agent-predicate 'false)))) @@ -642,8 +647,8 @@ minor mode in all Gnus buffers." (defun gnus-agent-queue-setup (&optional group-name) "Make sure the queue group exists. Optional arg GROUP-NAME allows another group to be specified." - (unless (gnus-gethash (format "nndraft:%s" (or group-name "queue")) - gnus-newsrc-hashtb) + (unless (gethash (format "nndraft:%s" (or group-name "queue")) + gnus-newsrc-hashtb) (gnus-request-create-group (or group-name "queue") '(nndraft "")) (let ((gnus-level-default-subscribed 1)) (gnus-subscribe-group (format "nndraft:%s" (or group-name "queue")) @@ -1330,11 +1335,11 @@ downloaded into the agent." (when (re-search-forward (concat "^" (regexp-quote group) " ") nil t) (save-excursion - (setq oactive-max (read (current-buffer)) ;; max + (setq oactive-max (read (current-buffer)) ;; max oactive-min (read (current-buffer)))) ;; min (gnus-delete-line))) (when active - (insert (format "%S %d %d y\n" (intern group) + (insert (format "%s %d %d y\n" group (max (or oactive-max (cdr active)) (cdr active)) (min (or oactive-min (car active)) (car active)))) (goto-char (point-max)) @@ -1555,11 +1560,8 @@ downloaded into the agent." (skip-chars-forward " ") (setq crosses nil) (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) *") - (push (cons (buffer-substring (match-beginning 1) - (match-end 1)) - (string-to-number - (buffer-substring (match-beginning 2) - (match-end 2)))) + (push (cons (match-string 1) + (string-to-number (match-string 2))) crosses) (goto-char (match-end 0))) (gnus-agent-crosspost crosses (caar pos) date))) @@ -2161,7 +2163,10 @@ doesn't exist, to valid the overview buffer." (gnus-agent-update-view-total-fetched-for group nil))) -(defvar gnus-agent-article-local nil) +;; FIXME: Why would this be a hash table? Wouldn't a simple alist or +;; something suffice? +(defvar gnus-agent-article-local nil + "Hashtable holding information about a group.") (defvar gnus-agent-article-local-times nil) (defvar gnus-agent-file-loading-local nil) @@ -2173,12 +2178,12 @@ article counts for each of the method's subscribed groups." (zerop gnus-agent-article-local-times) (not (gnus-methods-equal-p gnus-command-method - (symbol-value (intern "+method" gnus-agent-article-local))))) + (gethash "+method" gnus-agent-article-local)))) (setq gnus-agent-article-local (gnus-cache-file-contents (gnus-agent-lib-file "local") 'gnus-agent-file-loading-local - 'gnus-agent-read-and-cache-local)) + #'gnus-agent-read-and-cache-local)) (when gnus-agent-article-local-times (cl-incf gnus-agent-article-local-times))) gnus-agent-article-local)) @@ -2188,14 +2193,15 @@ article counts for each of the method's subscribed groups." gnus-agent-article-local. If that variable had `dirty' (also known as modified) original contents, they are first saved to their own file." (if (and gnus-agent-article-local - (symbol-value (intern "+dirty" gnus-agent-article-local))) + (gethash "+dirty" gnus-agent-article-local)) (gnus-agent-save-local)) (gnus-agent-read-local file)) (defun gnus-agent-read-local (file) "Load FILE and do a `read' there." - (let ((my-obarray (gnus-make-hashtable (count-lines (point-min) - (point-max)))) + (let ((hashtb (gnus-make-hashtable + (count-lines (point-min) + (point-max)))) (line 1)) (with-temp-buffer (condition-case nil @@ -2204,7 +2210,8 @@ modified) original contents, they are first saved to their own file." (file-error)) (goto-char (point-min)) - ;; Skip any comments at the beginning of the file (the only place where they may appear) + ;; Skip any comments at the beginning of the file (the only + ;; place where they may appear) (while (= (following-char) ?\;) (forward-line 1) (setq line (1+ line))) @@ -2214,33 +2221,32 @@ modified) original contents, they are first saved to their own file." (let (group min max - (cur (current-buffer)) - (obarray my-obarray)) + (cur (current-buffer))) (setq group (read cur) min (read cur) max (read cur)) - (when (stringp group) - (setq group (intern group my-obarray))) + (unless (stringp group) + (setq group (symbol-name group))) ;; NOTE: The '+ 0' ensure that min and max are both numerics. - (set group (cons (+ 0 min) (+ 0 max)))) + (puthash group (cons (+ 0 min) (+ 0 max)) hashtb)) (error (gnus-message 3 "Warning - invalid agent local: %s on line %d: %s" file line (error-message-string err)))) (forward-line 1) (setq line (1+ line)))) - (set (intern "+dirty" my-obarray) nil) - (set (intern "+method" my-obarray) gnus-command-method) - my-obarray)) + (puthash "+dirty" nil hashtb) + (puthash "+method" gnus-command-method hashtb) + hashtb)) (defun gnus-agent-save-local (&optional force) "Save gnus-agent-article-local under it method's agent.lib directory." - (let ((my-obarray gnus-agent-article-local)) - (when (and my-obarray - (or force (symbol-value (intern "+dirty" my-obarray)))) - (let* ((gnus-command-method (symbol-value (intern "+method" my-obarray))) + (let ((hashtb gnus-agent-article-local)) + (when (and hashtb + (or force (gethash "+dirty" hashtb))) + (let* ((gnus-command-method (gethash "+method" hashtb)) ;; NOTE: gnus-command-method is used within gnus-agent-lib-file. (dest (gnus-agent-lib-file "local"))) (gnus-make-directory (gnus-agent-lib-file "")) @@ -2248,31 +2254,30 @@ modified) original contents, they are first saved to their own file." (let ((coding-system-for-write gnus-agent-file-coding-system) (file-name-coding-system nnmail-pathname-coding-system)) (with-temp-file dest - (let ((gnus-command-method (symbol-value (intern "+method" my-obarray))) + ;; FIXME: Why are we letting this again? + (let ((gnus-command-method (gethash "+method" hashtb)) print-level print-length (standard-output (current-buffer))) - (mapatoms (lambda (symbol) - (cond ((not (boundp symbol)) - nil) - ((member (symbol-name symbol) '("+dirty" "+method")) - nil) - (t - (let ((range (symbol-value symbol))) - (when range - (prin1 symbol) - (princ " ") - (princ (car range)) - (princ " ") - (princ (cdr range)) - (princ "\n")))))) - my-obarray)))))))) + (maphash (lambda (group active) + (cond ((null active) + nil) + ((member group '("+dirty" "+method")) + nil) + (t + (when active + (prin1 group) + (princ " ") + (princ (car active)) + (princ " ") + (princ (cdr active)) + (princ "\n"))))) + hashtb)))))))) (defun gnus-agent-get-local (group &optional gmane method) (let* ((gmane (or gmane (gnus-group-real-name group))) (gnus-command-method (or method (gnus-find-method-for-group group))) (local (gnus-agent-load-local)) - (symb (intern gmane local)) - (minmax (and (boundp symb) (symbol-value symb)))) + (minmax (gethash gmane local))) (unless minmax ;; Bind these so that gnus-agent-load-alist doesn't change the ;; current alist (i.e. gnus-agent-article-alist) @@ -2291,24 +2296,23 @@ modified) original contents, they are first saved to their own file." (let* ((gmane (or gmane (gnus-group-real-name group))) (gnus-command-method (or method (gnus-find-method-for-group group))) (local (or local (gnus-agent-load-local))) - (symb (intern gmane local)) - (minmax (and (boundp symb) (symbol-value symb)))) + (minmax (gethash gmane local))) (if (cond ((and minmax (or (not (eq min (car minmax))) (not (eq max (cdr minmax)))) min max) - (setcar minmax min) - (setcdr minmax max) + (setcar (gethash gmane local) min) + (setcdr (gethash gmane local) max) t) (minmax nil) ((and min max) - (set symb (cons min max)) + (puthash gmane (cons min max) local) t) (t - (unintern symb local))) - (set (intern "+dirty" local) t)))) + (remhash gmane local))) + (puthash "+dirty" t local)))) (defun gnus-agent-article-name (article group) (expand-file-name article @@ -2878,8 +2882,8 @@ The following commands are available: nil (let ((string (gnus-simplify-subject (mail-header-subject gnus-headers)))) (prog1 - (gnus-gethash string gnus-agent-spam-hashtb) - (gnus-sethash string t gnus-agent-spam-hashtb))))) + (gethash string gnus-agent-spam-hashtb) + (puthash string t gnus-agent-spam-hashtb))))) (defun gnus-agent-short-p () "Say whether an article is short or not." @@ -2935,7 +2939,7 @@ The following commands are available: 'or) ((memq (car predicate) gnus-category-not) 'not)) - ,@(mapcar 'gnus-category-make-function-1 (cdr predicate)))) + ,@(mapcar #'gnus-category-make-function-1 (cdr predicate)))) (t (error "Unknown predicate type: %s" predicate)))) @@ -2961,7 +2965,7 @@ return read articles, nil when it is known to always return read articles, and t_nil when the function may return both read and unread articles." (let ((func (car function)) - (args (mapcar 'gnus-function-implies-unread-1 (cdr function)))) + (args (mapcar #'gnus-function-implies-unread-1 (cdr function)))) (cond ((eq func 'and) (cond ((memq t args) ; if any argument returns only unread articles ;; then that argument constrains the result to only unread articles. @@ -3007,13 +3011,13 @@ articles." (unless gnus-category-group-cache (setq gnus-category-group-cache (gnus-make-hashtable 1000)) (let ((cs gnus-category-alist) - groups cat) - (while (setq cat (pop cs)) + groups) + (dolist (cat cs) (setq groups (gnus-agent-cat-groups cat)) - (while groups - (gnus-sethash (pop groups) cat gnus-category-group-cache))))) - (or (gnus-gethash group gnus-category-group-cache) - (assq 'default gnus-category-alist))) + (dolist (g groups) + (puthash g cat gnus-category-group-cache))))) + (gethash group gnus-category-group-cache + (assq 'default gnus-category-alist))) (defvar gnus-agent-expire-current-dirs) (defvar gnus-agent-expire-stats) @@ -3053,7 +3057,7 @@ FORCE is equivalent to setting the expiration predicates to true." (count-lines (point-min) (point-max)))))) (save-excursion (gnus-agent-expire-group-1 - group overview (gnus-gethash-safe group orig) + group overview (gethash group orig) articles force)))) (kill-buffer overview)))) (gnus-message 4 "%s" (gnus-agent-expire-done-message))))) @@ -3147,38 +3151,37 @@ FORCE is equivalent to setting the expiration predicates to true." (nov-file (concat dir ".overview")) (cnt 0) (completed -1) - dlist - type) - - ;; The normal article alist contains elements that look like - ;; (article# . fetch_date) I need to combine other - ;; information with this list. For example, a flag indicating - ;; that a particular article MUST BE KEPT. To do this, I'm - ;; going to transform the elements to look like (article# - ;; fetch_date keep_flag NOV_entry_position) Later, I'll reverse - ;; the process to generate the expired article alist. - - ;; Convert the alist elements to (article# fetch_date nil - ;; nil). - (setq dlist (mapcar (lambda (e) - (list (car e) (cdr e) nil nil)) alist)) - - ;; Convert the keep lists to elements that look like (article# - ;; nil keep_flag nil) then append it to the expanded dlist - ;; These statements are sorted by ascending precedence of the - ;; keep_flag. - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'unread nil)) - unreads))) - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'marked nil)) - marked))) - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'special nil)) - specials))) + type + + ;; The normal article alist contains elements that look like + ;; (article# . fetch_date) I need to combine other + ;; information with this list. For example, a flag indicating + ;; that a particular article MUST BE KEPT. To do this, I'm + ;; going to transform the elements to look like (article# + ;; fetch_date keep_flag NOV_entry_position) Later, I'll reverse + ;; the process to generate the expired article alist. + (dlist + (nconc + ;; Convert the alist elements to (article# fetch_date nil nil). + (mapcar (lambda (e) + (list (car e) (cdr e) nil nil)) + alist) + + ;; Convert the keep lists to elements that look like (article# + ;; nil keep_flag nil) then append it to the expanded dlist + ;; These statements are sorted by ascending precedence of the + ;; keep_flag. + (mapcar (lambda (e) + (list e nil 'unread nil)) + unreads) + + (mapcar (lambda (e) + (list e nil 'marked nil)) + marked) + + (mapcar (lambda (e) + (list e nil 'special nil)) + specials)))) (set-buffer overview) (erase-buffer) @@ -3387,7 +3390,7 @@ article alist" type) actions)) (when actions (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s" decoded article-number - (mapconcat 'identity actions ", "))))) + (mapconcat #'identity actions ", "))))) (t (gnus-agent-message 10 "gnus-agent-expire: %s:%d: Article kept as \ @@ -3471,9 +3474,7 @@ articles in every agentized group? ")) (count-lines (point-min) (point-max)))))) (dolist (expiring-group (gnus-groups-from-server gnus-command-method)) - (let* ((active - (gnus-gethash-safe expiring-group orig))) - + (let ((active (gethash expiring-group orig))) (when active (save-excursion (gnus-agent-expire-group-1 @@ -3503,83 +3504,80 @@ articles in every agentized group? ")) (defun gnus-agent-expire-unagentized-dirs () (when (and gnus-agent-expire-unagentized-dirs (boundp 'gnus-agent-expire-current-dirs)) - (let* ((keep (gnus-make-hashtable)) - (file-name-coding-system nnmail-pathname-coding-system)) - - (gnus-sethash gnus-agent-directory t keep) + (let ((file-name-coding-system nnmail-pathname-coding-system) + ;; Another hash table that could just be a list. + (keep (gnus-make-hashtable 20)) + to-remove) + (puthash gnus-agent-directory t keep) (dolist (dir gnus-agent-expire-current-dirs) (when (and (stringp dir) (file-directory-p dir)) - (while (not (gnus-gethash dir keep)) - (gnus-sethash dir t keep) + (while (not (gethash dir keep)) + (puthash dir t keep) (setq dir (file-name-directory (directory-file-name dir)))))) - (let* (to-remove - checker - (checker - (function - (lambda (d) - "Given a directory, check it and its subdirectories for - membership in the keep hash. If it isn't found, add - it to to-remove." - (let ((files (directory-files d)) - file) - (while (setq file (pop files)) - (cond ((equal file ".") ; Ignore self - nil) - ((equal file "..") ; Ignore parent - nil) - ((equal file ".overview") - ;; Directory must contain .overview to be - ;; agent's cache of a group. - (let ((d (file-name-as-directory d)) - r) - ;; Search ancestor's for last directory NOT - ;; found in keep hash. - (while (not (gnus-gethash - (setq d (file-name-directory d)) keep)) - (setq r d - d (directory-file-name d))) - ;; if ANY ancestor was NOT in keep hash and - ;; it's not already in to-remove, add it to - ;; to-remove. - (if (and r - (not (member r to-remove))) - (push r to-remove)))) - ((file-directory-p (setq file (nnheader-concat d file))) - (funcall checker file))))))))) - (funcall checker (expand-file-name gnus-agent-directory)) - - (when (and to-remove - (or gnus-expert-user - (gnus-y-or-n-p - "gnus-agent-expire has identified local directories that are\ + (cl-labels ((checker + (d) + ;; Given a directory, check it and its subdirectories + ;; for membership in the keep list. If it isn't found, + ;; add it to to-remove. + (let ((files (directory-files d)) + file) + (while (setq file (pop files)) + (cond ((equal file ".") ; Ignore self + nil) + ((equal file "..") ; Ignore parent + nil) + ((equal file ".overview") + ;; Directory must contain .overview to be + ;; agent's cache of a group. + (let ((d (file-name-as-directory d)) + r) + ;; Search ancestors for last directory NOT + ;; found in keep. + (while (not (gethash (setq d (file-name-directory d)) keep)) + (setq r d + d (directory-file-name d))) + ;; if ANY ancestor was NOT in keep hash and + ;; it's not already in to-remove, add it to + ;; to-remove. + (if (and r + (not (member r to-remove))) + (push r to-remove)))) + ((file-directory-p (setq file (nnheader-concat d file))) + (checker file))))))) + (checker (expand-file-name gnus-agent-directory))) + + (when (and to-remove + (or gnus-expert-user + (gnus-y-or-n-p + "gnus-agent-expire has identified local directories that are\ not currently required by any agentized group. Do you wish to consider\ deleting them?"))) - (while to-remove - (let ((dir (pop to-remove))) - (if (or gnus-expert-user - (gnus-y-or-n-p (format "Delete %s? " dir))) - (let* (delete-recursive - files f - (delete-recursive - (function - (lambda (f-or-d) - (ignore-errors - (if (file-directory-p f-or-d) - (condition-case nil - (delete-directory f-or-d) - (file-error - (setq files (directory-files f-or-d)) - (while files - (setq f (pop files)) - (or (member f '("." "..")) - (funcall delete-recursive - (nnheader-concat - f-or-d f)))) - (delete-directory f-or-d))) - (delete-file f-or-d))))))) - (funcall delete-recursive dir)))))))))) + (while to-remove + (let ((dir (pop to-remove))) + (if (or gnus-expert-user + (gnus-y-or-n-p (format "Delete %s? " dir))) + (let* (delete-recursive + files f + (delete-recursive + (function + (lambda (f-or-d) + (ignore-errors + (if (file-directory-p f-or-d) + (condition-case nil + (delete-directory f-or-d) + (file-error + (setq files (directory-files f-or-d)) + (while files + (setq f (pop files)) + (or (member f '("." "..")) + (funcall delete-recursive + (nnheader-concat + f-or-d f)))) + (delete-directory f-or-d))) + (delete-file f-or-d))))))) + (funcall delete-recursive dir))))))))) ;;;###autoload (defun gnus-agent-batch () @@ -3625,7 +3623,7 @@ If CACHED-HEADER is nil, articles are only excluded if the article itself has been fetched." ;; Logically equivalent to: (gnus-sorted-difference articles (mapcar - ;; 'car gnus-agent-article-alist)) + ;; #'car gnus-agent-article-alist)) ;; Functionally, I don't need to construct a temp list using mapcar. @@ -4097,8 +4095,8 @@ agent has fetched." ;; if null, gnus-agent-group-pathname will calc method. (let* ((gnus-command-method method) (path (or path (gnus-agent-group-pathname group))) - (entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb) - (gnus-sethash path (make-list 3 0) + (entry (or (gethash path gnus-agent-total-fetched-hashtb) + (puthash path (make-list 3 0) gnus-agent-total-fetched-hashtb))) (file-name-coding-system nnmail-pathname-coding-system)) (when (file-exists-p path) @@ -4128,7 +4126,7 @@ agent has fetched." (cl-incf (nth 2 entry) delta)))))) (defun gnus-agent-update-view-total-fetched-for - (group agent-over &optional method path) + (group agent-over &optional method path) "Update, or set, the total disk space used by the .agentview and .overview files. These files are calculated separately as they can be modified." @@ -4138,9 +4136,9 @@ modified." ;; if null, gnus-agent-group-pathname will calc method. (let* ((gnus-command-method method) (path (or path (gnus-agent-group-pathname group))) - (entry (or (gnus-gethash path gnus-agent-total-fetched-hashtb) - (gnus-sethash path (make-list 3 0) - gnus-agent-total-fetched-hashtb))) + (entry (or (gethash path gnus-agent-total-fetched-hashtb) + (puthash path (make-list 3 0) + gnus-agent-total-fetched-hashtb))) (file-name-coding-system nnmail-pathname-coding-system) (size (or (file-attribute-size (file-attributes (nnheader-concat @@ -4155,12 +4153,13 @@ modified." "Get the total disk space used by the specified GROUP." (unless (equal group "dummy.group") (unless gnus-agent-total-fetched-hashtb - (setq gnus-agent-total-fetched-hashtb (gnus-make-hashtable 1024))) + (setq gnus-agent-total-fetched-hashtb + (gnus-make-hashtable 1000))) ;; if null, gnus-agent-group-pathname will calc method. (let* ((gnus-command-method method) (path (gnus-agent-group-pathname group)) - (entry (gnus-gethash path gnus-agent-total-fetched-hashtb))) + (entry (gethash path gnus-agent-total-fetched-hashtb))) (if entry (apply '+ entry) (let ((gnus-agent-inhibit-update-total-fetched-for (not no-inhibit))) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 28ee174597b..baa8a244c07 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1,6 +1,6 @@ ;;; gnus-art.el --- article mode commands for Gnus -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -3540,18 +3540,11 @@ possible values." (concat "Date: " (message-make-date time))) ;; Convert to Universal Time. ((eq type 'ut) - (concat "Date: " - (substring - (message-make-date - (let* ((e (parse-time-string date)) - (tm (apply 'encode-time e)) - (ms (car tm)) - (ls (- (cadr tm) (car (current-time-zone time))))) - (cond ((< ls 0) (list (1- ms) (+ ls 65536))) - ((> ls 65535) (list (1+ ms) (- ls 65536))) - (t (list ms ls))))) - 0 -5) - "UT")) + (let ((system-time-locale "C")) + (format-time-string + "Date: %a, %d %b %Y %T UT" + (encode-time (parse-time-string date)) + t))) ;; Get the original date from the article. ((eq type 'original) (concat "Date: " (if (string-match "\n+$" date) @@ -3569,13 +3562,7 @@ possible values." (concat "Date: " (format-time-string format time))))) ;; ISO 8601. ((eq type 'iso8601) - (let ((tz (car (current-time-zone time)))) - (concat - "Date: " - (format-time-string "%Y%m%dT%H%M%S" time) - (format "%s%02d%02d" - (if (> tz 0) "+" "-") (/ (abs tz) 3600) - (/ (% (abs tz) 3600) 60))))) + (format-time-string "Date: %Y%m%dT%H%M%S%z" time)) ;; Do a lapsed format. ((eq type 'lapsed) (concat "Date: " (article-lapsed-string time))) @@ -3623,18 +3610,14 @@ 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* ((real-time (time-subtract nil time)) - (real-sec (and real-time - (+ (* (float (car real-time)) 65536) - (cadr real-time)))) - (sec (and real-time (abs real-sec))) + (let* ((real-time (time-since time)) + (real-sec (float-time real-time)) + (sec (abs real-sec)) (segments 0) num prev) (unless max-segments (setq max-segments (length article-time-units))) (cond - ((null real-time) - "Unknown") ((zerop sec) "Now") (t @@ -7393,9 +7376,8 @@ groups." :group 'gnus-article-buttons :type 'regexp) -;; Regexp suggested by Felix Wiemann in <87oeuomcz9.fsf@news2.ososo.de> (defcustom gnus-button-valid-localpart-regexp - "[a-z0-9$%(*-=?[_][^<>\")!;:,{}\n\t @]*" + "[-a-z0-9$%(*+./=?[_][^<>\")!;:,{}\n\t @]*" "Regular expression that matches a localpart of mail addresses or MIDs." :version "22.1" :group 'gnus-article-buttons @@ -7491,7 +7473,7 @@ must return `mid', `mail', `invalid' or `ask'." (2.0 . "^[A-Z][a-z][A-Z][a-z][a-z][^a-z]")) ;; ^[A-Z][a-z]{4,4} "An alist of (RATE . REGEXP) pairs for `gnus-button-mid-or-mail-heuristic'. -A negative RATE indicates a message IDs, whereas a positive indicates a mail +A negative RATE indicates a message ID, whereas a positive indicates a mail address. The REGEXP is processed with `case-fold-search' set to nil." :version "22.1" :group 'gnus-article-buttons @@ -7500,7 +7482,7 @@ address. The REGEXP is processed with `case-fold-search' set to nil." (defun gnus-button-mid-or-mail-heuristic (mid-or-mail) "Guess whether MID-OR-MAIL is a message ID or a mail address. -Returns `mid' if MID-OR-MAIL is a message IDs, `mail' if it's a mail +Returns `mid' if MID-OR-MAIL is a message ID, `mail' if it's a mail address, `ask' if unsure and `invalid' if the string is invalid." (let ((case-fold-search nil) (list gnus-button-mid-or-mail-heuristic-alist) diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index ad25f805ca1..4e2723e8d27 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -1,6 +1,6 @@ ;;; gnus-async.el --- asynchronous support for Gnus -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -84,7 +84,6 @@ that was fetched." (defvar gnus-async-article-alist nil) (defvar gnus-async-article-semaphore '(nil)) (defvar gnus-async-fetch-list nil) -(defvar gnus-async-hashtb nil) (defvar gnus-async-current-prefetch-group nil) (defvar gnus-async-current-prefetch-article nil) (defvar gnus-async-timer nil) @@ -127,14 +126,11 @@ that was fetched." (defun gnus-async-close () (gnus-kill-buffer gnus-async-prefetch-article-buffer) (gnus-kill-buffer gnus-async-prefetch-headers-buffer) - (setq gnus-async-hashtb nil - gnus-async-article-alist nil + (setq gnus-async-article-alist nil gnus-async-header-prefetched nil)) (defun gnus-async-set-buffer () - (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t) - (unless gnus-async-hashtb - (setq gnus-async-hashtb (gnus-make-hashtable 1023)))) + (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t)) (defun gnus-async-halt-prefetch () "Stop prefetching." @@ -242,13 +238,10 @@ that was fetched." (when gnus-async-post-fetch-function (funcall gnus-async-post-fetch-function summary)))) (gnus-async-with-semaphore - (setq - gnus-async-article-alist - (cons (list (intern (format "%s-%d" group article) - gnus-async-hashtb) - mark (point-max-marker) - group article) - gnus-async-article-alist)))) + (push (list (format "%s-%d" group article) + mark (point-max-marker) + group article) + gnus-async-article-alist))) (if (not (gnus-buffer-live-p summary)) (gnus-async-with-semaphore (setq gnus-async-fetch-list nil)) @@ -314,8 +307,7 @@ that was fetched." (set-marker (caddr entry) nil)) (gnus-async-with-semaphore (setq gnus-async-article-alist - (delq entry gnus-async-article-alist)) - (unintern (car entry) gnus-async-hashtb))) + (delete entry gnus-async-article-alist)))) (defun gnus-async-prefetch-remove-group (group) "Remove all articles belonging to GROUP from the prefetch buffer." @@ -331,9 +323,8 @@ that was fetched." "Return the entry for ARTICLE in GROUP if it has been prefetched." (let ((entry (save-excursion (gnus-async-set-buffer) - (assq (intern-soft (format "%s-%d" group article) - gnus-async-hashtb) - gnus-async-article-alist)))) + (assoc (format "%s-%d" group article) + gnus-async-article-alist)))) ;; Perhaps something has emptied the buffer? (if (and entry (= (cadr entry) (caddr entry))) @@ -342,7 +333,7 @@ that was fetched." (set-marker (cadr entry) nil) (set-marker (caddr entry) nil)) (setq gnus-async-article-alist - (delq entry gnus-async-article-alist)) + (delete entry gnus-async-article-alist)) nil) entry))) diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el index 95cb1ca5ecc..c5a0e3ec4f0 100644 --- a/lisp/gnus/gnus-bcklg.el +++ b/lisp/gnus/gnus-bcklg.el @@ -1,6 +1,6 @@ ;;; gnus-bcklg.el --- backlog functions for Gnus -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -22,17 +22,16 @@ ;;; Commentary: +;; The backlog caches the text of a certain number of read articles in +;; a separate buffer, so they can be retrieved quickly if the user +;; opens them again. Also see `gnus-keep-backlog'. + ;;; Code: (require 'gnus) -;;; -;;; Buffering of read articles. -;;; - (defvar gnus-backlog-buffer " *Gnus Backlog*") -(defvar gnus-backlog-articles nil) -(defvar gnus-backlog-hashtb nil) +(defvar gnus-backlog-articles '()) (defun gnus-backlog-buffer () "Return the backlog buffer." @@ -42,11 +41,6 @@ (setq buffer-read-only t) (get-buffer gnus-backlog-buffer)))) -(defun gnus-backlog-setup () - "Initialize backlog variables." - (unless gnus-backlog-hashtb - (setq gnus-backlog-hashtb (gnus-make-hashtable 1024)))) - (gnus-add-shutdown 'gnus-backlog-shutdown 'gnus) (defun gnus-backlog-shutdown () @@ -54,46 +48,42 @@ (interactive) (when (get-buffer gnus-backlog-buffer) (gnus-kill-buffer gnus-backlog-buffer)) - (setq gnus-backlog-hashtb nil - gnus-backlog-articles nil)) + (setq gnus-backlog-articles nil)) (defun gnus-backlog-enter-article (group number buffer) (when (and (numberp number) (not (gnus-virtual-group-p group))) - (gnus-backlog-setup) - (let ((ident (intern (concat group ":" (int-to-string number)) - gnus-backlog-hashtb)) + (let ((ident (format "%s:%d" group number)) b) - (if (memq ident gnus-backlog-articles) - () ; It's already kept. - ;; Remove the oldest article, if necessary. - (and (numberp gnus-keep-backlog) - (>= (length gnus-backlog-articles) gnus-keep-backlog) - (gnus-backlog-remove-oldest-article)) - (push ident gnus-backlog-articles) - ;; Insert the new article. - (with-current-buffer (gnus-backlog-buffer) - (let (buffer-read-only) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (setq b (point)) - (insert-buffer-substring buffer) - ;; Tag the beginning of the article with the ident. - (if (> (point-max) b) - (put-text-property b (1+ b) 'gnus-backlog ident) - (gnus-error 3 "Article %d is blank" number)))))))) + (unless (member ident gnus-backlog-articles) ; It's already kept. + ;; Remove the oldest article, if necessary. + (and (numberp gnus-keep-backlog) + (>= (length gnus-backlog-articles) gnus-keep-backlog) + (gnus-backlog-remove-oldest-article)) + (push ident gnus-backlog-articles) + ;; Insert the new article. + (with-current-buffer (gnus-backlog-buffer) + (let (buffer-read-only) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (setq b (point)) + (insert-buffer-substring buffer) + ;; Tag the beginning of the article with the ident. + (if (> (point-max) b) + (put-text-property b (1+ b) 'gnus-backlog ident) + (gnus-error 3 "Article %d is blank" number)))))))) (defun gnus-backlog-remove-oldest-article () (with-current-buffer (gnus-backlog-buffer) (goto-char (point-min)) - (if (zerop (buffer-size)) - () ; The buffer is empty. + (unless (zerop (buffer-size)) ; The buffer is empty. (let ((ident (get-text-property (point) 'gnus-backlog)) buffer-read-only) ;; Remove the ident from the list of articles. (when ident - (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) + (setq gnus-backlog-articles + (delete ident gnus-backlog-articles))) ;; Delete the article itself. (delete-region (point) (next-single-property-change @@ -102,42 +92,40 @@ (defun gnus-backlog-remove-article (group number) "Remove article NUMBER in GROUP from the backlog." (when (numberp number) - (gnus-backlog-setup) - (let ((ident (intern (concat group ":" (int-to-string number)) - gnus-backlog-hashtb)) - beg end) - (when (memq ident gnus-backlog-articles) + (let ((ident (format "%s:%d" group number)) + beg) + (when (member ident gnus-backlog-articles) ;; It was in the backlog. (with-current-buffer (gnus-backlog-buffer) - (let (buffer-read-only) - (when (setq beg (text-property-any - (point-min) (point-max) 'gnus-backlog - ident)) - ;; Find the end (i. e., the beginning of the next article). - (setq end - (next-single-property-change - (1+ beg) 'gnus-backlog (current-buffer) (point-max))) - (delete-region beg end) - ;; Return success. - t)) - (setq gnus-backlog-articles (delq ident gnus-backlog-articles))))))) + (save-excursion + (let (buffer-read-only) + (goto-char (point-min)) + (when (setq beg (gnus-text-property-search + 'gnus-backlog ident)) + ;; Find the end (i. e., the beginning of the next article). + (goto-char + (next-single-property-change + (1+ beg) 'gnus-backlog (current-buffer) (point-max))) + (delete-region beg (point)) + ;; Return success. + t))) + (setq gnus-backlog-articles + (delete ident gnus-backlog-articles))))))) (defun gnus-backlog-request-article (group number &optional buffer) (when (and (numberp number) (not (gnus-virtual-group-p group))) - (gnus-backlog-setup) - (let ((ident (intern (concat group ":" (int-to-string number)) - gnus-backlog-hashtb)) + (let ((ident (format "%s:%d" group number)) beg end) - (when (memq ident gnus-backlog-articles) + (when (member ident gnus-backlog-articles) ;; It was in the backlog. (with-current-buffer (gnus-backlog-buffer) - (if (not (setq beg (text-property-any - (point-min) (point-max) 'gnus-backlog - ident))) + (if (not (setq beg (gnus-text-property-search + 'gnus-backlog ident))) ;; It wasn't in the backlog after all. (ignore - (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) + (setq gnus-backlog-articles + (delete ident gnus-backlog-articles))) ;; Find the end (i. e., the beginning of the next article). (setq end (next-single-property-change diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 0d718e24cb9..cc0a52f0158 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -1,6 +1,6 @@ ;;; gnus-bookmark.el --- Bookmarks in Gnus -;; Copyright (C) 2006-2018 Free Software Foundation, Inc. +;; Copyright (C) 2006-2019 Free Software Foundation, Inc. ;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Keywords: news diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index a16b61a3bd1..5e6483d1053 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -1,6 +1,6 @@ ;;; gnus-cache.el --- cache interface for Gnus -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -272,7 +272,7 @@ it's not cached." (defun gnus-cache-possibly-alter-active (group active) "Alter the ACTIVE info for GROUP to reflect the articles in the cache." (when gnus-cache-active-hashtb - (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) + (let ((cache-active (gethash group gnus-cache-active-hashtb))) (when cache-active (when (< (car cache-active) (car active)) (setcar active (car cache-active))) @@ -522,7 +522,7 @@ system for example was used.") (gnus-delete-line))) (unless (setq gnus-newsgroup-cached (delq article gnus-newsgroup-cached)) - (gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb) + (remhash gnus-newsgroup-name gnus-cache-active-hashtb) (setq gnus-cache-active-altered t)) (gnus-summary-update-secondary-mark article) t))) @@ -542,8 +542,8 @@ system for example was used.") (progn (gnus-cache-update-active group (car articles) t) (gnus-cache-update-active group (car (last articles)))) - (when (gnus-gethash group gnus-cache-active-hashtb) - (gnus-sethash group nil gnus-cache-active-hashtb) + (when (gethash group gnus-cache-active-hashtb) + (remhash group gnus-cache-active-hashtb) (setq gnus-cache-active-altered t))) articles))) @@ -666,13 +666,16 @@ $ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" ;; Mark the active hashtb as unaltered. (setq gnus-cache-active-altered nil))) +;; FIXME: Why is there a `gnus-cache-possibly-alter-active', +;; `gnus-cache-possibly-update-active', and +;; `gnus-cache-update-active'? Do we really need all three? (defun gnus-cache-possibly-update-active (group active) "Update active info bounds of GROUP with ACTIVE if necessary. The update is performed if ACTIVE contains a higher or lower bound than the current." (let ((lower t) (higher t)) (if gnus-cache-active-hashtb - (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) + (let ((cache-active (gethash group gnus-cache-active-hashtb))) (when cache-active (unless (< (car active) (car cache-active)) (setq lower nil)) @@ -687,10 +690,10 @@ than the current." (defun gnus-cache-update-active (group number &optional low) "Update the upper bound of the active info of GROUP to NUMBER. If LOW, update the lower bound instead." - (let ((active (gnus-gethash group gnus-cache-active-hashtb))) + (let ((active (gethash group gnus-cache-active-hashtb))) (if (null active) ;; We just create a new active entry for this group. - (gnus-sethash group (cons number number) gnus-cache-active-hashtb) + (puthash group (cons number number) gnus-cache-active-hashtb) ;; Update the lower or upper bound. (if low (setcar active number) @@ -734,10 +737,10 @@ If LOW, update the lower bound instead." ;; FIXME: this is kind of a workaround. The active file should ;; be updated at the time articles are cached. It will make ;; `gnus-cache-unified-group-names' needless. - (gnus-sethash (or (cdr (assoc group gnus-cache-unified-group-names)) - group) - (cons (car nums) (car (last nums))) - gnus-cache-active-hashtb)) + (puthash (or (cdr (assoc group gnus-cache-unified-group-names)) + group) + (cons (car nums) (car (last nums))) + gnus-cache-active-hashtb)) ;; Go through all the other files. (dolist (file alphs) (when (and (file-directory-p file) @@ -798,13 +801,13 @@ supported." (unless gnus-cache-active-hashtb (gnus-cache-read-active)) (let* ((old-group-hash-value - (gnus-gethash old-group gnus-cache-active-hashtb)) + (gethash old-group gnus-cache-active-hashtb)) (new-group-hash-value - (gnus-gethash new-group gnus-cache-active-hashtb)) + (gethash new-group gnus-cache-active-hashtb)) (delta (or old-group-hash-value new-group-hash-value))) - (gnus-sethash new-group old-group-hash-value gnus-cache-active-hashtb) - (gnus-sethash old-group nil gnus-cache-active-hashtb) + (puthash new-group old-group-hash-value gnus-cache-active-hashtb) + (puthash old-group nil gnus-cache-active-hashtb) (if no-save (setq gnus-cache-active-altered delta) @@ -826,8 +829,8 @@ supported." (let ((no-save gnus-cache-active-hashtb)) (unless gnus-cache-active-hashtb (gnus-cache-read-active)) - (let* ((group-hash-value (gnus-gethash group gnus-cache-active-hashtb))) - (gnus-sethash group nil gnus-cache-active-hashtb) + (let* ((group-hash-value (gethash group gnus-cache-active-hashtb))) + (remhash group gnus-cache-active-hashtb) (if no-save (setq gnus-cache-active-altered group-hash-value) @@ -849,9 +852,9 @@ supported." (when gnus-cache-total-fetched-hashtb (gnus-cache-with-refreshed-group group - (let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb) - (gnus-sethash group (make-vector 2 0) - gnus-cache-total-fetched-hashtb))) + (let* ((entry (or (gethash group gnus-cache-total-fetched-hashtb) + (puthash group (make-vector 2 0) + gnus-cache-total-fetched-hashtb))) size) (if file @@ -874,8 +877,8 @@ supported." (when gnus-cache-total-fetched-hashtb (gnus-cache-with-refreshed-group group - (let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb) - (gnus-sethash group (make-list 2 0) + (let* ((entry (or (gethash group gnus-cache-total-fetched-hashtb) + (puthash group (make-list 2 0) gnus-cache-total-fetched-hashtb))) (file-name-coding-system nnmail-pathname-coding-system) (size (or (file-attribute-size (file-attributes @@ -888,22 +891,21 @@ supported." (defun gnus-cache-rename-group-total-fetched-for (old-group new-group) "Record of disk space used by OLD-GROUP now associated with NEW-GROUP." (when gnus-cache-total-fetched-hashtb - (let ((entry (gnus-gethash old-group gnus-cache-total-fetched-hashtb))) - (gnus-sethash new-group entry gnus-cache-total-fetched-hashtb) - (gnus-sethash old-group nil gnus-cache-total-fetched-hashtb)))) + (let ((entry (gethash old-group gnus-cache-total-fetched-hashtb))) + (puthash new-group entry gnus-cache-total-fetched-hashtb) + (remhash old-group gnus-cache-total-fetched-hashtb)))) (defun gnus-cache-delete-group-total-fetched-for (group) "Delete record of disk space used by GROUP being deleted." (when gnus-cache-total-fetched-hashtb - (gnus-sethash group nil gnus-cache-total-fetched-hashtb))) + (remhash group gnus-cache-total-fetched-hashtb))) (defun gnus-cache-total-fetched-for (group &optional no-inhibit) "Get total disk space used by the cache for the specified GROUP." (unless (equal group "dummy.group") (unless gnus-cache-total-fetched-hashtb - (setq gnus-cache-total-fetched-hashtb (gnus-make-hashtable 1024))) - - (let* ((entry (gnus-gethash group gnus-cache-total-fetched-hashtb))) + (setq gnus-cache-total-fetched-hashtb (gnus-make-hashtable 1000))) + (let* ((entry (gethash group gnus-cache-total-fetched-hashtb))) (if entry (apply '+ entry) (let ((gnus-cache-inhibit-update-total-fetched-for (not no-inhibit))) diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index b48815bc0a7..7e431e79fc7 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -1,6 +1,6 @@ ;;; gnus-cite.el --- parse citations in articles for Gnus -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Per Abhiddenware @@ -92,7 +92,7 @@ The first regexp group should match the Supercite attribution." ;; -----Original Message----- ;; From: ... ;; To: ... -;; Sent: ... [date, in non-RFC-2822 format] +;; Sent: ... [date, in non-RFC-822-or-later format] ;; Subject: ... ;; ;; Cited message, with no prefixes @@ -1128,7 +1128,7 @@ Returns nil if there is no such line before LIMIT, t otherwise." (let ((cdepth (min (length (apply 'concat (split-string (match-string-no-properties 0) - "[ \t [:alnum:]]+"))) + "[\t [:alnum:]]+"))) gnus-message-max-citation-depth)) (mlist (make-list (* (1+ gnus-message-max-citation-depth) 2) nil)) (start (point-at-bol)) diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el index 1aa8e71ae1e..485f815d9b9 100644 --- a/lisp/gnus/gnus-cloud.el +++ b/lisp/gnus/gnus-cloud.el @@ -1,6 +1,6 @@ ;;; gnus-cloud.el --- storing and retrieving data via IMAP -;; Copyright (C) 2014-2018 Free Software Foundation, Inc. +;; Copyright (C) 2014-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: mail diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el index f4c0aa73327..d56066e6168 100644 --- a/lisp/gnus/gnus-cus.el +++ b/lisp/gnus/gnus-cus.el @@ -1,6 +1,6 @@ ;;; gnus-cus.el --- customization commands for Gnus -;; Copyright (C) 1996, 1999-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1999-2019 Free Software Foundation, Inc. ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: news diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index e9138f0ef08..aabf23924a0 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -1,6 +1,6 @@ ;;; gnus-delay.el --- Delayed posting of articles -;; Copyright (C) 2001-2018 Free Software Foundation, Inc. +;; Copyright (C) 2001-2019 Free Software Foundation, Inc. ;; Author: Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE> ;; Keywords: mail, news, extensions @@ -98,19 +98,15 @@ DELAY is a string, giving the length of the time. Possible values are: (setq hour (string-to-number (match-string 1 delay)) minute (string-to-number (match-string 2 delay))) ;; Use current time, except... - (setq deadline (apply 'vector (decode-time))) + (setq deadline (decode-time)) ;; ... for minute and hour. - (aset deadline 1 minute) - (aset deadline 2 hour) - ;; Convert to seconds. - (setq deadline (float-time (apply 'encode-time - (append deadline nil)))) + (setq deadline (apply #'encode-time (car deadline) minute hour + (nthcdr 3 deadline))) ;; If this time has passed already, add a day. - (when (< deadline (float-time)) - (setq deadline (+ 86400 deadline))) ; 86400 secs/day + (when (time-less-p deadline nil) + (setq deadline (time-add 86400 deadline))) ; 86400 secs/day ;; Convert seconds to date header. - (setq deadline (message-make-date - (seconds-to-time deadline)))) + (setq deadline (message-make-date deadline))) ((string-match "\\([0-9]+\\)\\s-*\\([mhdwMY]\\)" delay) (setq num (match-string 1 delay)) (setq unit (match-string 2 delay)) @@ -128,8 +124,7 @@ DELAY is a string, giving the length of the time. Possible values are: (setq delay (* num 60 60))) (t (setq delay (* num 60)))) - (setq deadline (message-make-date - (seconds-to-time (+ (float-time) delay))))) + (setq deadline (message-make-date (time-add nil delay)))) (t (error "Malformed delay `%s'" delay))) (message-add-header (format "%s: %s" gnus-delay-header deadline))) (set-buffer-modified-p t) @@ -164,11 +159,8 @@ DELAY is a string, giving the length of the time. Possible values are: nil t) (progn (setq deadline (nnheader-header-value)) - (setq deadline (apply 'encode-time - (parse-time-string deadline))) - (setq deadline (time-since deadline)) - (when (and (>= (nth 0 deadline) 0) - (>= (nth 1 deadline) 0)) + (setq deadline (encode-time (parse-time-string deadline))) + (unless (time-less-p nil deadline) (message "Sending delayed article %d" article) (gnus-draft-send article group) (message "Sending delayed article %d...done" article))) diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index 2405c705651..6c5e0b7f5d0 100644 --- a/lisp/gnus/gnus-demon.el +++ b/lisp/gnus/gnus-demon.el @@ -1,6 +1,6 @@ ;;; gnus-demon.el --- daemonic Gnus behavior -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -93,7 +93,7 @@ Emacs has been idle for IDLE `gnus-demon-timestep's." (defun gnus-demon-idle-since () "Return the number of seconds since when Emacs is idle." - (float-time (or (current-idle-time) '(0 0 0)))) + (float-time (or (current-idle-time) 0))) (defun gnus-demon-run-callback (func &optional idle time special) "Run FUNC if Emacs has been idle for longer than IDLE seconds. @@ -192,11 +192,9 @@ marked with SPECIAL." (elt nowParts 6) (elt nowParts 7) (elt nowParts 8))) - ;; calculate number of seconds between NOW and THEN - (diff (+ (* 65536 (- (car then) (car now))) - (- (cadr then) (cadr now))))) - ;; return number of timesteps in the number of seconds - (round (/ diff gnus-demon-timestep)))) + (diff (float-time (time-subtract then now)))) + ;; Return number of timesteps in the number of seconds. + (round diff gnus-demon-timestep))) (gnus-add-shutdown 'gnus-demon-cancel 'gnus) diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index b8ad4248d97..ceb0d4a30da 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -1,6 +1,6 @@ ;;; gnus-diary.el --- Wrapper around the NNDiary Gnus back end -;; Copyright (C) 1999-2018 Free Software Foundation, Inc. +;; Copyright (C) 1999-2019 Free Software Foundation, Inc. ;; Author: Didier Verna <didier@xemacs.org> ;; Maintainer: Didier Verna <didier@xemacs.org> @@ -159,32 +159,29 @@ There are currently two built-in format functions: ;; Code partly stolen from article-make-date-line (let* ((extras (mail-header-extra header)) (sched (gnus-diary-header-schedule extras)) - (occur (nndiary-next-occurrence sched (current-time))) (now (current-time)) + (occur (nndiary-next-occurrence sched now)) (real-time (time-subtract occur now))) - (if (null real-time) - "?????" - (let* ((sec (+ (* (float (car real-time)) 65536) (cadr real-time))) - (past (< sec 0)) - delay) - (and past (setq sec (- sec))) - (unless (zerop sec) - ;; This is a bit convoluted, but basically we go through the time - ;; units for years, weeks, etc, and divide things to see whether - ;; that results in positive answers. - (let ((units `((year . ,(* 365.25 24 3600)) - (month . ,(* 31 24 3600)) - (week . ,(* 7 24 3600)) - (day . ,(* 24 3600)) - (hour . 3600) - (minute . 60))) - unit num) - (while (setq unit (pop units)) - (unless (zerop (setq num (ffloor (/ sec (cdr unit))))) - (setq delay (append delay `((,(floor num) . ,(car unit)))))) - (setq sec (- sec (* num (cdr unit))))))) - (funcall gnus-diary-delay-format-function past delay))) - )) + (let* ((sec (encode-time real-time 'integer)) + (past (< sec 0)) + delay) + (and past (setq sec (- sec))) + (unless (zerop sec) + ;; This is a bit convoluted, but basically we go through the time + ;; units for years, weeks, etc, and divide things to see whether + ;; that results in positive answers. + (let ((units `((year . ,(round (* 365.25 24 3600))) + (month . ,(* 31 24 3600)) + (week . ,(* 7 24 3600)) + (day . ,(* 24 3600)) + (hour . 3600) + (minute . 60))) + unit num) + (while (setq unit (pop units)) + (unless (zerop (setq num (floor sec (cdr unit)))) + (setq delay (append delay `((,num . ,(car unit)))))) + (setq sec (mod sec (cdr unit)))))) + (funcall gnus-diary-delay-format-function past delay)))) ;; #### NOTE: Gnus sometimes gives me a HEADER not corresponding to any ;; message, with all fields set to nil here. I don't know what it is for, and diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index a46dd78a5ec..acb8fd77641 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -1,6 +1,6 @@ ;;; gnus-dired.el --- utility functions where gnus and dired meet -;; Copyright (C) 1996-1999, 2001-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2001-2019 Free Software Foundation, Inc. ;; Authors: Benjamin Rutt <brutt@bloomington.in.us>, ;; Shenghuo Zhu <zsh@cs.rochester.edu> diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index 7d4be47e41b..ad1aa62a346 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -1,6 +1,6 @@ ;;; gnus-draft.el --- draft message support for Gnus -;; Copyright (C) 1997-2018 Free Software Foundation, Inc. +;; Copyright (C) 1997-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el index a03c6c140cd..4981614a17f 100644 --- a/lisp/gnus/gnus-dup.el +++ b/lisp/gnus/gnus-dup.el @@ -1,6 +1,6 @@ -;;; gnus-dup.el --- suppression of duplicate articles in Gnus +;;; gnus-dup.el --- suppression of duplicate articles in Gnus -*- lexical-binding: t -*- -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -44,7 +44,7 @@ seen in the same session." :type 'boolean) (defcustom gnus-duplicate-list-length 10000 - "The number of Message-IDs to keep in the duplicate suppression list." + "The maximum number of duplicate Message-IDs to keep track of." :group 'gnus-duplicate :type 'integer) @@ -55,10 +55,14 @@ seen in the same session." ;;; Internal variables -(defvar gnus-dup-list nil) -(defvar gnus-dup-hashtb nil) +(defvar gnus-dup-list nil + "List of seen message IDs, as strings.") -(defvar gnus-dup-list-dirty nil) +(defvar gnus-dup-hashtb nil + "Hash table of seen message IDs, for fast lookup.") + +(defvar gnus-dup-list-dirty nil + "Non-nil if `gnus-dup-list' needs to be saved.") ;;; ;;; Starting and stopping @@ -78,10 +82,10 @@ seen in the same session." (if gnus-save-duplicate-list (gnus-dup-read) (setq gnus-dup-list nil)) - (setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length)) + (setq gnus-dup-hashtb (gnus-make-hashtable)) ;; Enter all Message-IDs into the hash table. - (let ((obarray gnus-dup-hashtb)) - (mapc 'intern gnus-dup-list))) + (dolist (g gnus-dup-list) + (puthash g t gnus-dup-hashtb))) (defun gnus-dup-read () "Read the duplicate suppression list." @@ -103,7 +107,7 @@ seen in the same session." (defun gnus-dup-enter-articles () "Enter articles from the current group for future duplicate suppression." - (unless gnus-dup-list + (unless gnus-dup-hashtb (gnus-dup-open)) (setq gnus-dup-list-dirty t) ; mark list for saving (let (msgid) @@ -116,29 +120,30 @@ seen in the same session." (not (= (gnus-data-mark datum) gnus-canceled-mark)) (setq msgid (mail-header-id (gnus-data-header datum))) (not (nnheader-fake-message-id-p msgid)) - (not (intern-soft msgid gnus-dup-hashtb))) + (not (gethash msgid gnus-dup-hashtb))) (push msgid gnus-dup-list) - (intern msgid gnus-dup-hashtb)))) - ;; Chop off excess Message-IDs from the list. - (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list))) + (puthash msgid t gnus-dup-hashtb)))) + ;; Remove excess Message-IDs from the list and hash table. + (let* ((dups (cons nil gnus-dup-list)) + (end (nthcdr gnus-duplicate-list-length dups))) (when end - (mapc (lambda (id) (unintern id gnus-dup-hashtb)) (cdr end)) - (setcdr end nil)))) + (mapc (lambda (id) (remhash id gnus-dup-hashtb)) (cdr end)) + (setcdr end nil)) + (setq gnus-dup-list (cdr dups)))) (defun gnus-dup-suppress-articles () "Mark duplicate articles as read." - (unless gnus-dup-list + (unless gnus-dup-hashtb (gnus-dup-open)) (gnus-message 8 "Suppressing duplicates...") (let ((auto (and gnus-newsgroup-auto-expire (memq gnus-duplicate-mark gnus-auto-expirable-marks))) number) (dolist (header gnus-newsgroup-headers) - (when (and (intern-soft (mail-header-id header) gnus-dup-hashtb) - (gnus-summary-article-unread-p (mail-header-number header))) - (setq gnus-newsgroup-unreads - (delq (setq number (mail-header-number header)) - gnus-newsgroup-unreads)) + (when (and (gethash (mail-header-id header) gnus-dup-hashtb) + (setq number (mail-header-number header)) + (gnus-summary-article-unread-p number)) + (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads)) (if (not auto) (push (cons number gnus-duplicate-mark) gnus-newsgroup-reads) (push number gnus-newsgroup-expirable) @@ -147,12 +152,13 @@ seen in the same session." (defun gnus-dup-unsuppress-article (article) "Stop suppression of ARTICLE." - (let* ((header (gnus-data-header (gnus-data-find article))) - (id (when header (mail-header-id header)))) - (when id + (let (header id) + (when (and gnus-dup-hashtb + (setq header (gnus-data-header (gnus-data-find article))) + (setq id (mail-header-id header))) (setq gnus-dup-list-dirty t) (setq gnus-dup-list (delete id gnus-dup-list)) - (unintern id gnus-dup-hashtb)))) + (remhash id gnus-dup-hashtb)))) (provide 'gnus-dup) diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el index 059d17335b2..a1f71bb07f9 100644 --- a/lisp/gnus/gnus-eform.el +++ b/lisp/gnus/gnus-eform.el @@ -1,6 +1,6 @@ ;;; gnus-eform.el --- a mode for editing forms for Gnus -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index f1fd51d5509..8b710512be8 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -1,6 +1,6 @@ ;;; gnus-fun.el --- various frivolous extension functions to Gnus -;; Copyright (C) 2002-2018 Free Software Foundation, Inc. +;; Copyright (C) 2002-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el index 95e0927b998..d271a52f908 100644 --- a/lisp/gnus/gnus-gravatar.el +++ b/lisp/gnus/gnus-gravatar.el @@ -1,6 +1,6 @@ ;;; gnus-gravatar.el --- Gnus Gravatar support -;; Copyright (C) 2010-2018 Free Software Foundation, Inc. +;; Copyright (C) 2010-2019 Free Software Foundation, Inc. ;; Author: Julien Danjou <julien@danjou.info> ;; Keywords: news diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index c4ec9c1d327..c757c82fbc8 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1,6 +1,6 @@ ;;; gnus-group.el --- group mode commands for Gnus -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -38,6 +38,7 @@ (eval-when-compile (require 'mm-url) + (require 'subr-x) (let ((features (cons 'gnus-group features))) (require 'gnus-sum)) (unless (boundp 'gnus-cache-active-hashtb) @@ -1142,7 +1143,7 @@ The following commands are available: (let ((gnus-process-mark ?\200) (gnus-group-update-hook nil) (gnus-group-marked '("dummy.group")) - (gnus-active-hashtb (make-vector 10 0))) + (gnus-active-hashtb (gnus-make-hashtable 10))) (gnus-set-active "dummy.group" '(0 . 0)) (gnus-set-work-buffer) (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) @@ -1186,6 +1187,9 @@ The following commands are available: (unless (derived-mode-p 'gnus-group-mode) (gnus-group-mode))) +;; FIXME: If we never have to coerce group names to unibyte now, how +;; much of this is necessary? How much encoding/decoding do we still +;; have to do? (defun gnus-group-name-charset (method group) (unless method (setq method (gnus-find-method-for-group group))) @@ -1267,20 +1271,14 @@ Also see the `gnus-group-use-permanent-levels' variable." ;; has disappeared in the new listing, try to find the next ;; one. If no next one can be found, just leave point at the ;; first newsgroup in the buffer. - (when (not (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe - group gnus-active-hashtb)))) - (let ((newsrc (cdddr (gnus-group-entry group)))) - (while (and newsrc - (not (gnus-goto-char - (text-property-any - (point-min) (point-max) 'gnus-group - (gnus-intern-safe - (caar newsrc) gnus-active-hashtb))))) - (setq newsrc (cdr newsrc))) - (unless newsrc + (when (not (gnus-text-property-search + 'gnus-group group nil 'goto)) + (let ((groups (cdr-safe (member group gnus-group-list)))) + (while (and groups + (not (gnus-text-property-search + 'gnus-group (car groups) 'forward 'goto))) + (setq groups (cdr groups))) + (unless groups (goto-char (point-max)) (forward-line -1))))))) ;; Adjust cursor point. @@ -1313,7 +1311,6 @@ If REGEXP is a function, list dead groups that the function returns non-nil; if it is a string, only list groups matching REGEXP." (set-buffer gnus-group-buffer) (let ((buffer-read-only nil) - (newsrc (cdr gnus-newsrc-alist)) (lowest (or lowest 1)) (not-in-list (and gnus-group-listed-groups (copy-sequence gnus-group-listed-groups))) @@ -1321,12 +1318,11 @@ if it is a string, only list groups matching REGEXP." (erase-buffer) (when (or (< lowest gnus-level-zombie) gnus-group-listed-groups) - ;; List living groups. - (while newsrc - (setq info (car newsrc) + ;; List living groups, according to order in `gnus-group-list'. + (dolist (g (cdr gnus-group-list)) + (setq info (gnus-get-info g) group (gnus-info-group info) params (gnus-info-params info) - newsrc (cdr newsrc) unread (gnus-group-unread group)) (when not-in-list (setq not-in-list (delete group not-in-list))) @@ -1393,39 +1389,35 @@ if it is a string, only list groups matching REGEXP." ;; List zombies and killed lists somewhat faster, which was ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does ;; this by ignoring the group format specification altogether. - (let (group) - (if (> (length groups) gnus-group-listing-limit) - (while groups - (setq group (pop groups)) - (when (gnus-group-prepare-logic - group - (or (not regexp) - (and (stringp regexp) (string-match regexp group)) - (and (functionp regexp) (funcall regexp group)))) - (add-text-properties - (point) (prog1 (1+ (point)) - (insert " " mark " *: " - (gnus-group-decoded-name group) - "\n")) - (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) - 'gnus-unread t - 'gnus-level level)))) - (while groups - (setq group (pop groups)) + (if (nthcdr gnus-group-listing-limit groups) + (dolist (group groups) (when (gnus-group-prepare-logic group - (or (not regexp) - (and (stringp regexp) (string-match regexp group)) - (and (functionp regexp) (funcall regexp group)))) - (gnus-group-insert-group-line - group level nil - (let ((active (gnus-active group))) - (if active - (if (zerop (cdr active)) - 0 - (- (1+ (cdr active)) (car active))) - nil)) - (gnus-method-simplify (gnus-find-method-for-group group)))))))) + (cond ((not regexp)) + ((stringp regexp) (string-match-p regexp group)) + ((functionp regexp) (funcall regexp group)))) + (add-text-properties + (point) (prog1 (1+ (point)) + (insert " " mark " *: " + (gnus-group-decoded-name group) + "\n")) + (list 'gnus-group group + 'gnus-unread t + 'gnus-level level)))) + (dolist (group groups) + (when (gnus-group-prepare-logic + group + (cond ((not regexp)) + ((stringp regexp) (string-match-p regexp group)) + ((functionp regexp) (funcall regexp group)))) + (gnus-group-insert-group-line + group level nil + (let ((active (gnus-active group))) + (and active + (if (zerop (cdr active)) + 0 + (- (cdr active) (car active) -1)))) + (gnus-method-simplify (gnus-find-method-for-group group))))))) (defun gnus-group-update-group-line () "Update the current line in the group buffer." @@ -1438,7 +1430,7 @@ if it is a string, only list groups matching REGEXP." (not (gnus-ephemeral-group-p group)) (gnus-dribble-enter (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (nth 2 entry)) + (gnus-prin1-to-string (nth 1 entry)) ")") (concat "^(gnus-group-set-info '(\"" (regexp-quote group) "\""))) (setq gnus-group-indentation (gnus-group-group-indentation)) @@ -1455,7 +1447,7 @@ if it is a string, only list groups matching REGEXP." (if entry (progn ;; (Un)subscribed group. - (setq info (nth 2 entry)) + (setq info (nth 1 entry)) (gnus-group-insert-group-line group (gnus-info-level info) (gnus-info-marks info) (or (car entry) t) (gnus-info-method info))) @@ -1472,7 +1464,7 @@ if it is a string, only list groups matching REGEXP." (gnus-method-simplify (gnus-find-method-for-group group)))))) (defun gnus-number-of-unseen-articles-in-group (group) - (let* ((info (nth 2 (gnus-group-entry group))) + (let* ((info (nth 1 (gnus-group-entry group))) (marked (gnus-info-marks info)) (seen (cdr (assq 'seen marked))) (active (gnus-active group))) @@ -1531,7 +1523,7 @@ if it is a string, only list groups matching REGEXP." (int-to-string (max 0 (- gnus-tmp-number-total number))) "*")) (gnus-tmp-subscribed - (cond ((<= gnus-tmp-level gnus-level-subscribed) ? ) + (cond ((<= gnus-tmp-level gnus-level-subscribed) ?\s) ((<= gnus-tmp-level gnus-level-unsubscribed) ?U) ((= gnus-tmp-level gnus-level-zombie) ?Z) (t ?K))) @@ -1544,13 +1536,13 @@ if it is a string, only list groups matching REGEXP." (gnus-tmp-newsgroup-description (if gnus-description-hashtb (or (gnus-group-name-decode - (gnus-gethash gnus-tmp-group gnus-description-hashtb) + (gethash gnus-tmp-group gnus-description-hashtb) group-name-charset) "") "")) (gnus-tmp-moderated (if (and gnus-moderated-hashtb - (gnus-gethash gnus-tmp-group gnus-moderated-hashtb)) - ?m ? )) + (gethash gnus-tmp-group gnus-moderated-hashtb)) + ?m ?\s)) (gnus-tmp-moderated-string (if (eq gnus-tmp-moderated ?m) "(m)" "")) (gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-group)) @@ -1564,18 +1556,18 @@ if it is a string, only list groups matching REGEXP." (if (and (numberp number) (zerop number) (cdr (assq 'tick gnus-tmp-marked))) - ?* ? )) + ?* ?\s)) (gnus-tmp-summary-live (if (and (not gnus-group-is-exiting-p) (gnus-buffer-live-p (gnus-summary-buffer-name gnus-tmp-group))) - ?* ? )) + ?* ?\s)) (gnus-tmp-process-marked (if (member gnus-tmp-group gnus-group-marked) - gnus-process-mark ? )) + gnus-process-mark ?\s)) (buffer-read-only nil) beg end - gnus-tmp-header) ; passed as parameter to user-funcs. + gnus-tmp-header) ; passed as parameter to user-funcs. (beginning-of-line) (setq beg (point)) (add-text-properties @@ -1585,7 +1577,7 @@ if it is a string, only list groups matching REGEXP." (let ((gnus-tmp-decoded-group (gnus-group-name-decode gnus-tmp-group group-name-charset))) (eval gnus-group-line-format-spec))) - `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) + `(gnus-group ,gnus-tmp-group gnus-unread ,(if (numberp number) (string-to-number gnus-tmp-number-of-unread) t) @@ -1619,7 +1611,7 @@ Some value are bound so the form can use them." (when list (let* ((entry (gnus-group-entry group)) (active (gnus-active group)) - (info (nth 2 entry)) + (info (nth 1 entry)) (method (inline (gnus-server-get-method group (gnus-info-method info)))) (marked (gnus-info-marks info)) @@ -1690,9 +1682,7 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated." ;; The buffer may be narrowed. (save-restriction (widen) - (let ((ident (gnus-intern-safe group gnus-active-hashtb)) - (loc (point-min)) - found buffer-read-only) + (let (found buffer-read-only) (unless info-unchanged ;; Enter the current status into the dribble buffer. (let ((entry (gnus-group-entry group))) @@ -1700,37 +1690,33 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated." (not (gnus-ephemeral-group-p group))) (gnus-dribble-enter (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (nth 2 entry)) + (gnus-prin1-to-string (nth 1 entry)) ")") (concat "^(gnus-group-set-info '(\"" (regexp-quote group) "\""))))) - ;; Find all group instances. If topics are in use, each group - ;; may be listed in more than once. - (while (setq loc (text-property-any - loc (point-max) 'gnus-group ident)) + ;; Find all group instances. If topics are in use, groups + ;; may be listed more than once. + (goto-char (point-min)) + (while (gnus-text-property-search + 'gnus-group group 'forward 'goto) (setq found t) - (goto-char loc) (let ((gnus-group-indentation (gnus-group-group-indentation))) (gnus-delete-line) (gnus-group-insert-group-line-info group) (save-excursion (forward-line -1) - (gnus-run-hooks 'gnus-group-update-group-hook))) - (setq loc (1+ loc))) + (gnus-run-hooks 'gnus-group-update-group-hook)))) (unless (or found visible-only) ;; No such line in the buffer, find out where it's supposed to ;; go, and insert it there (or at the end of the buffer). (if gnus-goto-missing-group-function (funcall gnus-goto-missing-group-function group) - (let ((entry (cddr (gnus-group-entry group)))) - (while (and entry (car entry) + (let ((entry (cdr (member group gnus-group-list)))) + (goto-char (point-min)) + (while (and (car-safe entry) (not - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe - (caar entry) - gnus-active-hashtb))))) + (gnus-text-property-search + 'gnus-group (car entry) 'forward 'goto))) (setq entry (cdr entry))) (or entry (goto-char (point-max))))) ;; Finally insert the line. @@ -1778,10 +1764,8 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated." (defun gnus-group-group-name () "Get the name of the newsgroup on the current line." (let ((group (get-text-property (point-at-bol) 'gnus-group))) - (when group - (if (stringp group) - group - (symbol-name group))))) + (cond ((stringp group) group) + (group (symbol-name group))))) (defun gnus-group-group-level () "Get the level of the newsgroup on the current line." @@ -1801,7 +1785,7 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer is not updated." (defun gnus-group-new-mail (group) (if (nnmail-new-mail-p (gnus-group-real-name group)) gnus-new-mail-mark - ? )) + ?\s)) (defun gnus-group-level (group) "Return the estimated level of GROUP." @@ -1891,7 +1875,7 @@ If FIRST-TOO, the current line is also eligible as a target." (if unmark (progn (setq gnus-group-marked (delete group gnus-group-marked)) - (insert-char ? 1 t)) + (insert-char ?\s 1 t)) (setq gnus-group-marked (cons group (delete group gnus-group-marked))) (insert-char gnus-process-mark 1 t))) @@ -2062,7 +2046,7 @@ that group." (unless group (error "No group on current line")) (setq marked (gnus-info-marks - (nth 2 (setq entry (gnus-group-entry group))))) + (nth 1 (setq entry (gnus-group-entry group))))) ;; This group might be a dead group. In that case we have to get ;; the number of unread articles from `gnus-active-hashtb'. (setq number @@ -2137,6 +2121,7 @@ be permanent." (let ((group (gnus-group-group-name))) (when group (gnus-group-decoded-name group))) + ;; FIXME: Use rx. (let ((regexp "[][\C-@-\t\v-*,/:-@\\^`{-\C-?]*\ \\(nn[a-z]+\\(?:\\+[^][\C-@-*,/:-@\\^`{-\C-?]+\\)?:\ [^][\C-@-*,./:-@\\^`{-\C-?]+\\(?:\\.[^][\C-@-*,./:-@\\^`{-\C-?]+\\)*\ @@ -2175,34 +2160,39 @@ be permanent." (defun gnus-group-completing-read (&optional prompt collection require-match initial-input hist def) - "Read a group name with completion. Non-ASCII group names are allowed. -The arguments are the same as `completing-read' except that COLLECTION -and HIST default to `gnus-active-hashtb' and `gnus-group-history' -respectively if they are omitted. Regards COLLECTION as a hash table -if it is not a list." + "Read a group name with completion. +Non-ASCII group names are allowed. The arguments are the same as +`completing-read' except that COLLECTION and HIST default to +`gnus-active-hashtb' and `gnus-group-history' respectively if +they are omitted. Can handle COLLECTION as a list, hash table, +or vector." (or collection (setq collection gnus-active-hashtb)) - (let (choices group) - (if (listp collection) - (dolist (symbol collection) - (setq group (symbol-name symbol)) - (push (if (string-match "[^\000-\177]" group) - (gnus-group-decoded-name group) - group) - choices)) - (mapatoms (lambda (symbol) - (setq group (symbol-name symbol)) - (push (if (string-match "[^\000-\177]" group) - (gnus-group-decoded-name group) - group) - choices)) - collection)) - (setq group (gnus-completing-read (or prompt "Group") (nreverse choices) - require-match initial-input - (or hist 'gnus-group-history) - def)) - (unless (if (listp collection) - (member group (mapcar 'symbol-name collection)) - (symbol-value (intern-soft group collection))) + (let* ((choices + (mapcar + (lambda (g) + (if (string-match "[^\000-\177]" g) + (gnus-group-decoded-name g) + g)) + (cond ((listp collection) + collection) + ((vectorp collection) + (mapatoms #'symbol-name collection)) + ((hash-table-p collection) + (hash-table-keys collection))))) + (group + (gnus-completing-read (or prompt "Group") (reverse choices) + require-match initial-input + (or hist 'gnus-group-history) + def))) + (unless (cond ((and (listp collection) + (symbolp (car collection))) + (member group (mapcar 'symbol-name collection))) + ((listp collection) + (member group collection)) + ((vectorp collection) + (symbol-value (intern-soft group collection))) + ((hash-table-p collection) + (gethash group collection))) (setq group (encode-coding-string group (gnus-group-name-charset nil group)))) @@ -2280,7 +2270,8 @@ Return the name of the group if selection was successful." (nnheader-init-server-buffer) ;; Necessary because of funky inlining. (require 'gnus-cache) - (setq gnus-newsrc-hashtb (gnus-make-hashtable))) + (setq gnus-newsrc-hashtb (gnus-make-hashtable 100) + gnus-active-hashtb (gnus-make-hashtable 100))) ;; Transform the select method into a unique server. (when (stringp method) (setq method (gnus-server-to-method method))) @@ -2297,23 +2288,23 @@ Return the name of the group if selection was successful." (gnus-group-prefixed-name (gnus-group-real-name group) method)))) (gnus-set-active group nil) - (gnus-sethash + (puthash group - `(-1 nil (,group - ,gnus-level-default-subscribed nil nil ,method - ,(cons - (cons 'quit-config - (cond - (quit-config - quit-config) - ((assq gnus-current-window-configuration - gnus-buffer-configuration) - (cons gnus-summary-buffer - gnus-current-window-configuration)) - (t - (cons (current-buffer) - (current-window-configuration))))) - parameters))) + `(-1 (,group + ,gnus-level-default-subscribed nil nil ,method + ,(cons + (cons 'quit-config + (cond + (quit-config + quit-config) + ((assq gnus-current-window-configuration + gnus-buffer-configuration) + (cons gnus-summary-buffer + gnus-current-window-configuration)) + (t + (cons (current-buffer) + (current-window-configuration))))) + parameters))) gnus-newsrc-hashtb) (push method gnus-ephemeral-servers) (when (gnus-buffer-live-p gnus-group-buffer) @@ -2558,9 +2549,11 @@ If PROMPT (the prefix) is a number, use the prompt specified in (gnus-group-position-point))) (defun gnus-group-goto-group (group &optional far test-marked) - "Goto to newsgroup GROUP. + "Go to newsgroup GROUP. If FAR, it is likely that the group is not on the current line. -If TEST-MARKED, the line must be marked." +If TEST-MARKED, the line must be marked. + +Return nil if GROUP is not found." (when group (let ((start (point))) (beginning-of-line) @@ -2568,24 +2561,21 @@ If TEST-MARKED, the line must be marked." ;; It's quite likely that we are on the right line, so ;; we check the current line first. ((and (not far) - (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb)) + (equal (get-text-property (point) 'gnus-group) group) (or (not test-marked) (gnus-group-mark-line-p))) (point)) ;; Previous and next line are also likely, so we check them as well. ((and (not far) (save-excursion (forward-line -1) - (and (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb)) + (and (equal (get-text-property (point) 'gnus-group) group) (or (not test-marked) (gnus-group-mark-line-p))))) (forward-line -1) (point)) ((and (not far) (save-excursion (forward-line 1) - (and (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb)) + (and (equal (get-text-property (point) 'gnus-group) group) (or (not test-marked) (gnus-group-mark-line-p))))) (forward-line 1) (point)) @@ -2593,21 +2583,16 @@ If TEST-MARKED, the line must be marked." (goto-char (point-min)) (let (found) (while (and (not found) - (gnus-goto-char - (text-property-any - (point) (point-max) - 'gnus-group - (gnus-intern-safe group gnus-active-hashtb)))) + (gnus-text-property-search + 'gnus-group group 'forward 'goto)) (if (gnus-group-mark-line-p) (setq found t) (forward-line 1))) found)) (t ;; Search through the entire buffer. - (if (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb))) + (if (gnus-text-property-search + 'gnus-group group nil 'goto) (point) (goto-char start) nil)))))) @@ -2775,9 +2760,7 @@ server." (gnus-group-change-level (setq info (list t nname gnus-level-default-subscribed nil nil meth)) gnus-level-default-subscribed gnus-level-killed - (and (gnus-group-group-name) - (gnus-group-entry (gnus-group-group-name))) - t) + (gnus-group-group-name) t) ;; Make it active. (gnus-set-active nname (cons 1 0)) (unless (gnus-ephemeral-group-p name) @@ -2837,6 +2820,7 @@ If FORCE (the prefix) is non-nil, all the articles in the group will be deleted. This is \"deleted\" as in \"removed forever from the face of the Earth\". There is no undo. The user will be prompted before doing the deletion. + Note that you also have to specify FORCE if you want the group to be removed from the server, even when it's empty." (interactive @@ -2848,12 +2832,11 @@ be removed from the server, even when it's empty." (error "This back end does not support group deletion")) (prog1 (let ((group-decoded (gnus-group-decoded-name group))) - (if (and (not no-prompt) - (not (gnus-yes-or-no-p - (format - "Do you really want to delete %s%s? " - group-decoded (if force " and all its contents" ""))))) - () ; Whew! + (when (or no-prompt + (gnus-yes-or-no-p + (format + "Do you really want to delete %s%s? " + group-decoded (if force " and all its contents" "")))) (gnus-message 6 "Deleting group %s..." group-decoded) (if (not (gnus-request-delete-group group force)) (gnus-error 3 "Couldn't delete group %s" group-decoded) @@ -3234,7 +3217,7 @@ mail messages or news articles in files that have numeric names." ;; Subscribe the new group after the group on the current line. (gnus-subscribe-group pgroup (gnus-group-group-name) method) (gnus-group-update-group pgroup) - (forward-line -1) + (forward-line) (gnus-group-position-point))) (defun gnus-group-enter-directory (dir) @@ -3627,7 +3610,7 @@ The return value is the number of articles that were marked as read, or nil if no action could be taken." (let* ((entry (gnus-group-entry group)) (num (car entry)) - (marks (gnus-info-marks (nth 2 entry))) + (marks (gnus-info-marks (nth 1 entry))) (unread (gnus-sequence-of-unread-articles group))) ;; Remove entries for this group. (nnmail-purge-split-history (gnus-group-real-name group)) @@ -3809,8 +3792,7 @@ group line." (or (and (member group gnus-zombie-list) gnus-level-zombie) gnus-level-killed) - (when (gnus-group-group-name) - (gnus-group-entry (gnus-group-group-name)))) + (gnus-group-group-name)) (unless silent (gnus-group-update-group group))) (t (error "No such newsgroup: %s" group))) @@ -3881,10 +3863,12 @@ of groups killed." `(progn (gnus-group-goto-group ,(gnus-group-group-name)) (gnus-group-yank-group))) - (push (cons (car entry) (nth 2 entry)) + (push (cons (car entry) (nth 1 entry)) gnus-list-of-killed-groups)) (gnus-group-change-level (if entry entry group) gnus-level-killed (if entry nil level)) + ;; FIXME: Since the group has already been removed from + ;; `gnus-newsrc-hashtb', this check will always return nil. (when (numberp (gnus-group-unread group)) (gnus-request-update-group-status group 'unsubscribe)) (message "Killed group %s" (gnus-group-decoded-name group))) @@ -3902,7 +3886,7 @@ of groups killed." group gnus-level-killed 3)) (cond ((setq entry (gnus-group-entry group)) - (push (cons (car entry) (nth 2 entry)) + (push (cons (car entry) (nth 1 entry)) gnus-list-of-killed-groups) (setcdr (cdr entry) (cdddr entry))) ((member group gnus-zombie-list) @@ -3935,9 +3919,7 @@ yanked) a list of yanked groups is returned." ;; first newsgroup. (setq prev (gnus-group-group-name)) (gnus-group-change-level - info (gnus-info-level (cdr info)) gnus-level-killed - (and prev (gnus-group-entry prev)) - t) + info (gnus-info-level (cdr info)) gnus-level-killed prev t) (gnus-group-insert-group-line-info group) (gnus-request-update-group-status group 'subscribe) (gnus-undo-register @@ -4021,28 +4003,15 @@ entail asking the server for the groups." (gnus-agent gnus-plugged)); If we're actually plugged, store the active file in the agent. (gnus-read-active-file))) ;; Find all groups and sort them. - (let ((groups - (sort - (let (list) - (mapatoms - (lambda (sym) - (and (boundp sym) - (symbol-value sym) - (push (symbol-name sym) list))) - gnus-active-hashtb) - list) - 'string<)) - (buffer-read-only nil) - group) + (let ((buffer-read-only nil)) (erase-buffer) - (while groups - (setq group (pop groups)) + (dolist (group (sort (hash-table-keys gnus-active-hashtb) #'string<)) (add-text-properties (point) (prog1 (1+ (point)) (insert " *: " (gnus-group-decoded-name group) "\n")) - (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) + (list 'gnus-group group 'gnus-unread t 'gnus-level (inline (gnus-group-level group))))) (goto-char (point-min)))) @@ -4142,17 +4111,17 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." desc) (when (and force gnus-description-hashtb) - (gnus-sethash mname nil gnus-description-hashtb)) + (remhash mname gnus-description-hashtb)) (unless group (error "No group name given")) (when (or (and gnus-description-hashtb ;; We check whether this group's method has been ;; queried for a description file. - (gnus-gethash mname gnus-description-hashtb)) + (gethash mname gnus-description-hashtb)) (setq desc (gnus-group-get-description group)) (gnus-read-descriptions-file method)) (gnus-message 1 "%s" - (or desc (gnus-gethash group gnus-description-hashtb) + (or desc (gethash group gnus-description-hashtb) "No description available"))))) ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. @@ -4164,24 +4133,19 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (when (not (or gnus-description-hashtb (gnus-read-all-descriptions-files))) (error "Couldn't request descriptions file")) - (let ((buffer-read-only nil) - b groups) - (mapatoms - (lambda (group) - (push (symbol-name group) groups)) - gnus-description-hashtb) - (setq groups (sort groups 'string<)) + (let ((buffer-read-only nil)) (erase-buffer) - (dolist (group groups) - (setq b (point)) - (let ((charset (gnus-group-name-charset nil group))) + (dolist (group (sort (hash-table-keys gnus-description-hashtb) #'string<)) + (let ((b (point)) + (desc (gethash group gnus-description-hashtb)) + (charset (gnus-group-name-charset nil group))) (insert (format " *: %-20s %s\n" (gnus-group-name-decode group charset) - (gnus-group-name-decode group charset)))) - (add-text-properties - b (1+ b) (list 'gnus-group (intern group gnus-description-hashtb) - 'gnus-unread t 'gnus-marked nil - 'gnus-level (1+ gnus-level-subscribed)))) + (gnus-group-name-decode desc charset))) + (add-text-properties + b (1+ b) (list 'gnus-group group + 'gnus-unread t 'gnus-marked nil + 'gnus-level (1+ gnus-level-subscribed))))) (goto-char (point-min)) (gnus-group-position-point))) @@ -4193,20 +4157,16 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (obuf (current-buffer)) groups des) ;; Go through all newsgroups that are known to Gnus. - (mapatoms - (lambda (group) - (and (symbol-name group) - (string-match regexp (symbol-name group)) - (symbol-value group) - (push (symbol-name group) groups))) + (maphash + (lambda (g-name _) + (and (string-match regexp g-name) + (push g-name groups))) gnus-active-hashtb) ;; Also go through all descriptions that are known to Gnus. (when search-description - (mapatoms - (lambda (group) - (and (string-match regexp (symbol-value group)) - (push (symbol-name group) groups))) - gnus-description-hashtb)) + (dolist (g-name (hash-table-keys gnus-description-hashtb)) + (when (string-match regexp g-name) + (push g-name groups)))) (if (not groups) (gnus-message 3 "No groups matched \"%s\"." regexp) ;; Print out all the groups. @@ -4222,8 +4182,8 @@ If DONT-SCAN is non-nil, scan non-activated groups as well." (let ((charset (gnus-group-name-charset nil prev))) (insert (gnus-group-name-decode prev charset) "\n") (when (and gnus-description-hashtb - (setq des (gnus-gethash (car groups) - gnus-description-hashtb))) + (setq des (gethash (car groups) + gnus-description-hashtb))) (insert " " (gnus-group-name-decode des charset) "\n")))) (setq groups (cdr groups))) (goto-char (point-min)))) @@ -4468,7 +4428,7 @@ and the second element is the address." (let* ((entry (gnus-group-entry (or method-only-group (gnus-info-group info)))) (part-info info) - (info (if method-only-group (nth 2 entry) info)) + (info (if method-only-group (nth 1 entry) info)) method) (when method-only-group (unless entry @@ -4510,7 +4470,7 @@ and the second element is the address." ;; can do the update. (if entry (progn - (setcar (nthcdr 2 entry) info) + (setcar (nthcdr 1 entry) info) (when (and (not (eq (car entry) t)) (gnus-active (gnus-info-group info))) (setcar entry (length @@ -4578,8 +4538,7 @@ and the second element is the address." This function can be used in hooks like `gnus-select-group-hook' or `gnus-group-catchup-group-hook'." (when gnus-newsgroup-name - (let ((time (current-time))) - (setcdr (cdr time) nil) + (let ((time (encode-time nil 'integer))) (gnus-group-set-parameter gnus-newsgroup-name 'timestamp time)))) (defsubst gnus-group-timestamp (group) @@ -4588,11 +4547,11 @@ or `gnus-group-catchup-group-hook'." (defun gnus-group-timestamp-delta (group) "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 nil time))) - (+ (* (nth 0 delta) 65536.0) - (nth 1 delta)))) + ;; FIXME: This should return a Lisp integer, not a Lisp float, + ;; since it is always an integer. + (let* ((time (or (gnus-group-timestamp group) 0)) + (delta (time-since time))) + (float-time delta))) (defun gnus-group-timestamp-string (group) "Return a string of the timestamp for GROUP." @@ -4620,11 +4579,11 @@ This command may read the active file." (assq 'cache marks))) lowest #'(lambda (group) - (or (gnus-gethash group - gnus-cache-active-hashtb) + (or (gethash group + gnus-cache-active-hashtb) ;; Cache active file might use "." ;; instead of ":". - (gnus-gethash + (gethash (mapconcat 'identity (split-string group ":") ".") diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index f097028cb3e..f36c3897876 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -1,6 +1,6 @@ ;;; gnus-html.el --- Render HTML in a buffer. -;; Copyright (C) 2010-2018 Free Software Foundation, Inc. +;; Copyright (C) 2010-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: html, web diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index 3365c826e11..53a20b90ebd 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -1,6 +1,6 @@ -;;; gnus-icalendar.el --- reply to iCalendar meeting requests +;;; gnus-icalendar.el --- reply to iCalendar meeting requests -*- lexical-binding:t -*- -;; Copyright (C) 2013-2018 Free Software Foundation, Inc. +;; Copyright (C) 2013-2019 Free Software Foundation, Inc. ;; Author: Jan Tatarik <Jan.Tatarik@gmail.com> ;; Keywords: mail, icalendar, org @@ -147,7 +147,7 @@ (icalendar--get-event-property-attributes event field) zone-map)) (dtdate-dec (icalendar--decode-isodatetime dtdate nil dtdate-zone))) - (apply 'encode-time dtdate-dec))) + (encode-time dtdate-dec))) (defun gnus-icalendar-event--find-attendee (ical name-or-email) (let* ((event (car (icalendar--all-events ical))) @@ -244,7 +244,7 @@ (map-property ical-property)) args))))) (mapc #'accumulate-args prop-map) - (apply 'make-instance event-class args)))) + (apply #'make-instance event-class args)))) (defun gnus-icalendar-event-from-buffer (buf &optional attendee-name-or-email) "Parse RFC5545 iCalendar in buffer BUF and return an event object. @@ -301,7 +301,8 @@ status will be retrieved from the first matching attendee record." ((string= key "DTSTAMP") (update-dtstamp)) ((member key '("ORGANIZER" "DTSTART" "DTEND" "LOCATION" "DURATION" "SEQUENCE" - "RECURRENCE-ID" "UID")) line) + "RECURRENCE-ID" "UID")) + line) (t nil)))) (when new-line (push new-line reply-event-lines)))))) @@ -352,9 +353,9 @@ on the IDENTITIES list." ;;; ;;; gnus-icalendar-org -;;; -;;; TODO: this is an optional feature, and it's only available with org-mode -;;; 7+, so will need to properly handle emacsen with no/outdated org-mode +;; +;; TODO: this is an optional feature, and it's only available with org-mode +;; 7+, so will need to properly handle emacsen with no/outdated org-mode (require 'org) (require 'org-capture) @@ -367,23 +368,19 @@ on the IDENTITIES list." (defcustom gnus-icalendar-org-capture-file nil "Target Org file for storing captured calendar events." - :type '(choice (const nil) file) - :group 'gnus-icalendar-org) + :type '(choice (const nil) file)) (defcustom gnus-icalendar-org-capture-headline nil "Target outline in `gnus-icalendar-org-capture-file' for storing captured events." - :type '(repeat string) - :group 'gnus-icalendar-org) + :type '(repeat string)) (defcustom gnus-icalendar-org-template-name "used by gnus-icalendar-org" "Org-mode template name." - :type '(string) - :group 'gnus-icalendar-org) + :type '(string)) (defcustom gnus-icalendar-org-template-key "#" "Org-mode template hotkey." - :type '(string) - :group 'gnus-icalendar-org) + :type '(string)) (defvar gnus-icalendar-org-enabled-p nil) @@ -413,13 +410,12 @@ Return nil for non-recurring EVENT." (end-time (format-time-string "%H:%M" end)) (end-at-midnight (string= end-time "00:00")) (start-end-date-diff - (/ (float-time (time-subtract - (org-time-string-to-time end-date) - (org-time-string-to-time start-date))) - 86400)) + (time-to-number-of-days (time-subtract + (org-time-string-to-time end-date) + (org-time-string-to-time start-date)))) (org-repeat (gnus-icalendar-event:org-repeat event)) (repeat (if org-repeat (concat " " org-repeat) "")) - (time-1-day '(0 86400))) + (time-1-day 86400)) ;; NOTE: special care is needed with appointments ending at midnight ;; (typically all-day events): the end time has to be changed to 23:59 to @@ -655,10 +651,7 @@ is searched." (defun gnus-icalendar-show-org-agenda (event) (let* ((time-delta (time-subtract (gnus-icalendar-event:end-time event) (gnus-icalendar-event:start-time event))) - (duration-days (1+ (/ (+ (* (car time-delta) (expt 2 16)) - (cadr time-delta)) - 86400)))) - + (duration-days (1+ (floor (encode-time time-delta 'integer) 86400)))) (org-agenda-list nil (gnus-icalendar-event:start event) duration-days))) (cl-defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-request) reply-status) @@ -666,7 +659,7 @@ is searched." (gnus-icalendar--update-org-event event reply-status) (gnus-icalendar:org-event-save event reply-status))) -(cl-defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-cancel) reply-status) +(cl-defmethod gnus-icalendar-event:sync-to-org ((event gnus-icalendar-event-cancel) _reply-status) (when (gnus-icalendar-find-org-event-file event) (gnus-icalendar--cancel-org-event event))) @@ -689,8 +682,7 @@ is searched." (defcustom gnus-icalendar-reply-bufname "*CAL*" "Buffer used for building iCalendar invitation reply." - :type '(string) - :group 'gnus-icalendar) + :type '(string)) (defcustom gnus-icalendar-additional-identities nil "We need to know your identity to make replies to calendar requests work. @@ -706,17 +698,13 @@ Your identity is guessed automatically from the variables If you need even more aliases you can define them here. It really only makes sense to define names or email addresses." - :type '(repeat string) - :group 'gnus-icalendar) + :type '(repeat string)) -(make-variable-buffer-local - (defvar gnus-icalendar-reply-status nil)) +(defvar-local gnus-icalendar-reply-status nil) -(make-variable-buffer-local - (defvar gnus-icalendar-event nil)) +(defvar-local gnus-icalendar-event nil) -(make-variable-buffer-local - (defvar gnus-icalendar-handle nil)) +(defvar-local gnus-icalendar-handle nil) (defun gnus-icalendar-identities () "Return list of regexp-quoted names and email addresses belonging to the user. @@ -742,7 +730,8 @@ These will be used to retrieve the RSVP information from ical events." (cadr x)))) (with-slots (organizer summary description location recur uid - method rsvp participation-type) event + method rsvp participation-type) + event (let ((headers `(("Summary" ,summary) ("Location" ,(or location "")) ("Time" ,(gnus-icalendar-event:org-timestamp event)) @@ -767,7 +756,7 @@ These will be used to retrieve the RSVP information from ical events." `(let ((,charset (cdr (assoc 'charset (mm-handle-type ,handle))))) (with-temp-buffer (mm-insert-part ,handle) - (when (string= ,charset "utf-8") + (when (string= (downcase ,charset) "utf-8") (decode-coding-region (point-min) (point-max) 'utf-8)) ,@body)))) @@ -848,7 +837,7 @@ These will be used to retrieve the RSVP information from ical events." ("Tentative" gnus-icalendar-reply (,handle tentative ,event)) ("Decline" gnus-icalendar-reply (,handle declined ,event))))) -(cl-defmethod gnus-icalendar-event:inline-reply-buttons ((event gnus-icalendar-event-reply) handle) +(cl-defmethod gnus-icalendar-event:inline-reply-buttons ((_event gnus-icalendar-event-reply) _handle) "No buttons for REPLY events." nil) @@ -857,7 +846,7 @@ These will be used to retrieve the RSVP information from ical events." (gnus-icalendar--get-org-event-reply-status event)) "Not replied yet")) -(cl-defmethod gnus-icalendar-event:inline-reply-status ((event gnus-icalendar-event-reply)) +(cl-defmethod gnus-icalendar-event:inline-reply-status ((_event gnus-icalendar-event-reply)) "No reply status for REPLY events." nil) @@ -884,7 +873,7 @@ These will be used to retrieve the RSVP information from ical events." (when org-entry-exists-p `("Show Org Entry" gnus-icalendar--show-org-event ,event)))))) - +;;;###autoload (defun gnus-icalendar-mm-inline (handle) (let ((event (gnus-icalendar-event-from-handle handle (gnus-icalendar-identities)))) @@ -896,7 +885,7 @@ These will be used to retrieve the RSVP information from ical events." (buttons) (when buttons (mapc (lambda (x) - (apply 'gnus-icalendar-insert-button x) + (apply #'gnus-icalendar-insert-button x) (insert " ")) buttons) (insert "\n\n")))) @@ -977,6 +966,9 @@ These will be used to retrieve the RSVP information from ical events." (defvar gnus-mime-action-alist) ; gnus-art (defun gnus-icalendar-setup () + ;; FIXME: Get rid of this! + ;; The three add-to-list are now redundant (good), but I think the rest + ;; is still not automatically setup. (add-to-list 'mm-inlined-types "text/calendar") (add-to-list 'mm-automatic-display "text/calendar") (add-to-list 'mm-inline-media-tests '("text/calendar" gnus-icalendar-mm-inline identity)) @@ -991,7 +983,7 @@ These will be used to retrieve the RSVP information from ical events." (require 'gnus-art) (add-to-list 'gnus-mime-action-alist - (cons "save calendar event" 'gnus-icalendar-save-event) + (cons "save calendar event" #'gnus-icalendar-save-event) t)) (provide 'gnus-icalendar) diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 5d5f9ebb670..e23e53b1ef5 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -1,6 +1,6 @@ ;;; gnus-int.el --- backend interface functions for Gnus -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -257,7 +257,8 @@ If it is down, start it up (again)." (insert (format-time-string "%H:%M:%S") (format " %.2fs %s %S\n" (if (numberp gnus-backend-trace-elapsed) - (- (float-time) gnus-backend-trace-elapsed) + (float-time + (time-since gnus-backend-trace-elapsed)) 0) type form)) (setq gnus-backend-trace-elapsed (float-time))))) diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index e65ff51ce78..a7ded393034 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el @@ -1,6 +1,6 @@ ;;; gnus-kill.el --- kill commands for Gnus -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> ;; Lars Magne Ingebrigtsen <larsi@gnus.org> diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el index 2076d8aebe7..90f74205209 100644 --- a/lisp/gnus/gnus-logic.el +++ b/lisp/gnus/gnus-logic.el @@ -1,6 +1,6 @@ ;;; gnus-logic.el --- advanced scoring code for Gnus -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -162,9 +162,9 @@ (funcall type (or (aref gnus-advanced-headers index) 0) match))) (defun gnus-advanced-date (index match type) - (let ((date (apply 'encode-time (parse-time-string - (aref gnus-advanced-headers index)))) - (match (apply 'encode-time (parse-time-string match)))) + (let ((date (encode-time (parse-time-string + (aref gnus-advanced-headers index)))) + (match (encode-time (parse-time-string match)))) (cond ((eq type 'at) (equal date match)) diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el index e91d4f87d88..1420d705edf 100644 --- a/lisp/gnus/gnus-mh.el +++ b/lisp/gnus/gnus-mh.el @@ -1,6 +1,6 @@ ;;; gnus-mh.el --- mh-e interface for Gnus -;; Copyright (C) 1994-2018 Free Software Foundation, Inc. +;; Copyright (C) 1994-2019 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> ;; Lars Magne Ingebrigtsen <larsi@gnus.org> diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el index 1c67f5ffba0..6a264e099a6 100644 --- a/lisp/gnus/gnus-ml.el +++ b/lisp/gnus/gnus-ml.el @@ -1,6 +1,6 @@ ;;; gnus-ml.el --- Mailing list minor mode for Gnus -;; Copyright (C) 2000-2018 Free Software Foundation, Inc. +;; Copyright (C) 2000-2019 Free Software Foundation, Inc. ;; Author: Julien Gilles <jgilles@free.fr> ;; Keywords: news, mail diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el index 599b9c61dcf..e9c0de968b3 100644 --- a/lisp/gnus/gnus-mlspl.el +++ b/lisp/gnus/gnus-mlspl.el @@ -1,6 +1,6 @@ ;;; gnus-mlspl.el --- a group params-based mail splitting mechanism -;; Copyright (C) 1998-2018 Free Software Foundation, Inc. +;; Copyright (C) 1998-2019 Free Software Foundation, Inc. ;; Author: Alexandre Oliva <oliva@lsd.ic.unicamp.br> ;; Keywords: news, mail diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index f469afd41b1..b6d649d7603 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1,6 +1,6 @@ ;;; gnus-msg.el --- mail and post interface for Gnus -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> ;; Lars Magne Ingebrigtsen <larsi@gnus.org> diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index 1703df2e536..34761645837 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -1,6 +1,6 @@ ;; gnus-notifications.el -- Send notification on new message in Gnus -;; Copyright (C) 2012-2018 Free Software Foundation, Inc. +;; Copyright (C) 2012-2019 Free Software Foundation, Inc. ;; Author: Julien Danjou <julien@danjou.info> ;; Keywords: news diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index b6bb5c9c2b7..18b46a1c12f 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -1,6 +1,6 @@ ;;; gnus-picon.el --- displaying pretty icons in Gnus -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news xpm annotation glyph faces diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el index dd3793593e0..b775def9a0d 100644 --- a/lisp/gnus/gnus-range.el +++ b/lisp/gnus/gnus-range.el @@ -1,6 +1,6 @@ ;;; gnus-range.el --- range and sequence functions for Gnus -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 229d057946e..634cf926cea 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -1,6 +1,6 @@ ;;; gnus-registry.el --- article registry for Gnus -;; Copyright (C) 2002-2018 Free Software Foundation, Inc. +;; Copyright (C) 2002-2019 Free Software Foundation, Inc. ;; Author: Ted Zlatanov <tzz@lifelogs.com> ;; Keywords: news registry diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el index 4b968450b38..344ac550df2 100644 --- a/lisp/gnus/gnus-rfc1843.el +++ b/lisp/gnus/gnus-rfc1843.el @@ -1,6 +1,6 @@ ;;; gnus-rfc1843.el --- HZ (rfc1843) decoding interface functions for Gnus -;; Copyright (C) 1998-2018 Free Software Foundation, Inc. +;; Copyright (C) 1998-2019 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> ;; Keywords: news HZ HZ+ mail i18n diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 5690c679061..58c05e0716a 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -1,6 +1,6 @@ ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus -;; Copyright (C) 1996-1999, 2001-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-1999, 2001-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index 327cc69392d..2faf0f951db 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -1,6 +1,6 @@ ;;; gnus-score.el --- scoring code for Gnus -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Per Abrahamsen <amanda@iesd.auc.dk> ;; Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -1501,7 +1501,7 @@ If FORMAT, also format the current score file." (when (and gnus-summary-default-score scores) (let* ((entries gnus-header-index) - (now (date-to-day (current-time-string))) + (now (time-to-days nil)) (expire (and gnus-score-expiry-days (- now gnus-score-expiry-days))) (headers gnus-newsgroup-headers) @@ -2234,8 +2234,7 @@ score in `gnus-newsgroup-scored' by SCORE." (let* ((score (or (nth 1 kill) gnus-score-interactive-default-score)) (date (nth 2 kill)) found) - (when (setq arts (intern-soft (nth 0 kill) hashtb)) - (setq arts (symbol-value arts)) + (when (setq arts (gethash (nth 0 kill) hashtb)) (setq found t) (if trace (while (setq art (pop arts)) @@ -2273,11 +2272,11 @@ score in `gnus-newsgroup-scored' by SCORE." (with-syntax-table gnus-adaptive-word-syntax-table (while (re-search-forward "\\b\\w+\\b" nil t) (setq val - (gnus-gethash + (gethash (setq word (downcase (buffer-substring (match-beginning 0) (match-end 0)))) hashtb)) - (gnus-sethash + (puthash word (append (get-text-property (point-at-eol) 'articles) val) hashtb))) @@ -2289,7 +2288,7 @@ score in `gnus-newsgroup-scored' by SCORE." ".")) gnus-default-ignored-adaptive-words))) (while ignored - (gnus-sethash (pop ignored) nil hashtb))))) + (remhash (pop ignored) hashtb))))) (defun gnus-score-string< (a1 a2) ;; Compare headers in articles A2 and A2. @@ -2380,7 +2379,7 @@ score in `gnus-newsgroup-scored' by SCORE." (memq 'word gnus-newsgroup-adaptive)) (with-temp-buffer (let* ((hashtb (gnus-make-hashtable 1000)) - (date (date-to-day (current-time-string))) + (date (time-to-days nil)) (data gnus-newsgroup-data) word d score val) (with-syntax-table gnus-adaptive-word-syntax-table @@ -2400,8 +2399,8 @@ score in `gnus-newsgroup-scored' by SCORE." (goto-char (point-min)) (while (re-search-forward "\\b\\w+\\b" nil t) ;; Put the word and score into the hashtb. - (setq val (gnus-gethash (setq word (match-string 0)) - hashtb)) + (setq val (gethash (setq word (match-string 0)) + hashtb)) (when (or (not gnus-adaptive-word-length-limit) (> (length word) gnus-adaptive-word-length-limit)) @@ -2409,7 +2408,7 @@ score in `gnus-newsgroup-scored' by SCORE." (if (and gnus-adaptive-word-minimum (< val gnus-adaptive-word-minimum)) (setq val gnus-adaptive-word-minimum)) - (gnus-sethash word val hashtb))) + (puthash word val hashtb))) (erase-buffer)))) ;; Make all the ignorable words ignored. (let ((ignored (append gnus-ignored-adaptive-words @@ -2420,16 +2419,14 @@ score in `gnus-newsgroup-scored' by SCORE." ".")) gnus-default-ignored-adaptive-words))) (while ignored - (gnus-sethash (pop ignored) nil hashtb))) + (remhash (pop ignored) hashtb))) ;; Now we have all the words and scores, so we ;; add these rules to the ADAPT file. (set-buffer gnus-summary-buffer) - (mapatoms - (lambda (word) - (when (symbol-value word) - (gnus-summary-score-entry - "subject" (symbol-name word) 'w (symbol-value word) - date nil t))) + (maphash + (lambda (word val) + (gnus-summary-score-entry + "subject" word 'w val date nil t)) hashtb)))))) (defun gnus-score-edit-done () diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el index f09478d7f9a..fc0bf3098b1 100644 --- a/lisp/gnus/gnus-sieve.el +++ b/lisp/gnus/gnus-sieve.el @@ -1,6 +1,6 @@ ;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus -;; Copyright (C) 2001-2018 Free Software Foundation, Inc. +;; Copyright (C) 2001-2019 Free Software Foundation, Inc. ;; Author: NAGY Andras <nagya@inf.elte.hu>, ;; Simon Josefsson <simon@josefsson.org> diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index 4b5f15fbc6d..b236f0a4018 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -1,6 +1,6 @@ ;;; gnus-spec.el --- format spec functions for Gnus -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 5bdf358dad3..76a0f7d0fdb 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -1,6 +1,6 @@ ;;; gnus-srvr.el --- virtual server support for Gnus -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index f15d645a534..2f8a260bf13 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -1,6 +1,6 @@ ;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -543,29 +543,21 @@ Can be used to turn version control on or off." (message "Descend hierarchy %s? ([y]nsq): " (substring prefix 1 (1- (length prefix))))) (cond ((= ans ?n) - (while (and groups - (setq group (car groups) - real-group (gnus-group-real-name group)) - (string-match prefix real-group)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups))) + (dolist (g groups) + (when (string-match prefix (gnus-group-real-name g)) + (push g gnus-killed-list) + (puthash g t gnus-killed-hashtb))) (setq starts (cdr starts))) ((= ans ?s) - (while (and groups - (setq group (car groups) - real-group (gnus-group-real-name group)) - (string-match prefix real-group)) - (gnus-sethash group group gnus-killed-hashtb) - (gnus-subscribe-alphabetically (car groups)) - (setq groups (cdr groups))) + (dolist (g groups) + (when (string-match prefix (gnus-group-real-name g)) + (puthash g t gnus-killed-hashtb) + (gnus-subscribe-alphabetically g))) (setq starts (cdr starts))) ((= ans ?q) - (while groups - (setq group (car groups)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups)))) + (dolist (g groups) + (push g gnus-killed-list) + (puthash g t gnus-killed-hashtb))) (t nil))) (message "Subscribe %s? ([n]yq)" (car groups)) (while (not (memq (setq ans (read-char-exclusive)) @@ -575,16 +567,14 @@ Can be used to turn version control on or off." (setq group (car groups)) (cond ((= ans ?y) (gnus-subscribe-alphabetically (car groups)) - (gnus-sethash group group gnus-killed-hashtb)) + (puthash group t gnus-killed-hashtb)) ((= ans ?q) - (while groups - (setq group (car groups)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups)))) + (dolist (g groups) + (push g gnus-killed-list) + (puthash g t gnus-killed-hashtb))) (t (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb))) + (puthash group t gnus-killed-hashtb))) (setq groups (cdr groups))))))) (defun gnus-subscribe-randomly (newsgroup) @@ -647,7 +637,7 @@ the first newsgroup." ;; We subscribe the group by changing its level to `subscribed'. (gnus-group-change-level newsgroup gnus-level-default-subscribed - gnus-level-killed (gnus-group-entry (or next "dummy.group"))) + gnus-level-killed (or next "dummy.group")) (gnus-request-update-group-status newsgroup 'subscribe) (gnus-message 5 "Subscribe newsgroup: %s" newsgroup) (run-hook-with-args 'gnus-subscribe-newsgroup-functions newsgroup) @@ -696,6 +686,7 @@ the first newsgroup." gnus-agent-file-loading-cache nil gnus-server-method-cache nil gnus-newsrc-alist nil + gnus-group-list nil gnus-newsrc-hashtb nil gnus-killed-list nil gnus-zombie-list nil @@ -1018,7 +1009,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." (eq gnus-read-active-file 'some)) (gnus-update-active-hashtb-from-killed)) (unless gnus-active-hashtb - (setq gnus-active-hashtb (gnus-make-hashtable 4096))) + (setq gnus-active-hashtb (gnus-make-hashtable 4000))) ;; Initialize the cache. (when gnus-use-cache (gnus-cache-open)) @@ -1108,7 +1099,7 @@ for new groups, and subscribe the new groups as zombies." (gnus-ask-server-for-new-groups) ;; Go through the active hashtb and look for new groups. (let ((groups 0) - group new-newsgroups) + new-newsgroups) (gnus-message 5 "Looking for new newsgroups...") (unless gnus-have-read-active-file (gnus-read-active-file)) @@ -1117,30 +1108,26 @@ for new groups, and subscribe the new groups as zombies." (gnus-make-hashtable-from-killed)) ;; Go though every newsgroup in `gnus-active-hashtb' and compare ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. - (mapatoms - (lambda (sym) - (if (or (null (setq group (symbol-name sym))) - (not (boundp sym)) - (null (symbol-value sym)) - (gnus-gethash group gnus-killed-hashtb) - (gnus-gethash group gnus-newsrc-hashtb)) - () - (let ((do-sub (gnus-matches-options-n group))) + (maphash + (lambda (g-name active) + (unless (or (gethash g-name gnus-killed-hashtb) + (gethash g-name gnus-newsrc-hashtb)) + (let ((do-sub (gnus-matches-options-n g-name))) (cond ((eq do-sub 'subscribe) (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) + (puthash g-name t gnus-killed-hashtb) (gnus-call-subscribe-functions - gnus-subscribe-options-newsgroup-method group)) + gnus-subscribe-options-newsgroup-method g-name)) ((eq do-sub 'ignore) nil) (t (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) + (puthash g-name t gnus-killed-hashtb) (if gnus-subscribe-hierarchical-interactive - (push group new-newsgroups) + (push g-name new-newsgroups) (gnus-call-subscribe-functions - gnus-subscribe-newsgroup-method group))))))) + gnus-subscribe-newsgroup-method g-name))))))) gnus-active-hashtb) (when new-newsgroups (gnus-subscribe-hierarchical-interactive new-newsgroups)) @@ -1213,36 +1200,32 @@ for new groups, and subscribe the new groups as zombies." ;; 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'. - (mapatoms - (lambda (group-sym) - (if (or (null (setq group (symbol-name group-sym))) - (not (boundp group-sym)) - (null (symbol-value group-sym)) - (gnus-gethash group gnus-newsrc-hashtb) - (member group gnus-zombie-list) - (member group gnus-killed-list)) - ;; The group is already known. - () + (maphash + (lambda (g-name val) + (unless (or (null val) ; The group is already known. + (gethash g-name gnus-newsrc-hashtb) + (member g-name gnus-zombie-list) + (member g-name gnus-killed-list)) ;; Make this group active. - (when (symbol-value group-sym) - (gnus-set-active group (symbol-value group-sym))) + (when val + (gnus-set-active g-name val)) ;; Check whether we want it or not. - (let ((do-sub (gnus-matches-options-n group))) + (let ((do-sub (gnus-matches-options-n g-name))) (cond ((eq do-sub 'subscribe) (cl-incf groups) - (gnus-sethash group group gnus-killed-hashtb) + (puthash g-name group gnus-killed-hashtb) (gnus-call-subscribe-functions - gnus-subscribe-options-newsgroup-method group)) + gnus-subscribe-options-newsgroup-method g-name)) ((eq do-sub 'ignore) nil) (t (cl-incf groups) - (gnus-sethash group group gnus-killed-hashtb) + (puthash g-name group gnus-killed-hashtb) (if gnus-subscribe-hierarchical-interactive - (push group new-newsgroups) + (push g-name new-newsgroups) (gnus-call-subscribe-functions - gnus-subscribe-newsgroup-method group))))))) + gnus-subscribe-newsgroup-method g-name))))))) hashtb)) (when new-newsgroups (gnus-subscribe-hierarchical-interactive new-newsgroups))) @@ -1263,29 +1246,28 @@ for new groups, and subscribe the new groups as zombies." gnus-level-default-subscribed gnus-level-killed previous t) t) -;; `gnus-group-change-level' is the fundamental function for changing -;; subscription levels of newsgroups. This might mean just changing -;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back -;; again, which subscribes/unsubscribes a group, which is equally -;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and -;; from 8-9 to 1-7 means that you remove the group from the list of -;; killed (or zombie) groups and add them to the (kinda) subscribed -;; groups. And last but not least, moving from 8 to 9 and 9 to 8, -;; which is trivial. -;; ENTRY can either be a string (newsgroup name) or a list (if -;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST), -;; otherwise it's a list in the format of the `gnus-newsrc-hashtb' -;; entries. -;; LEVEL is the new level of the group, OLDLEVEL is the old level and -;; PREVIOUS is the group (in hashtb entry format) to insert this group -;; after. + (defun gnus-group-change-level (entry level &optional oldlevel previous fromkilled) + "Change level of group ENTRY to LEVEL. +This is the fundamental function for changing subscription levels +of newsgroups. This might mean just changing from level 1 to 2, +which is pretty trivial, from 2 to 6 or back again, which +subscribes/unsubscribes a group, which is equally trivial. +Changing from 1-7 to 8-9 means that you kill a group, and from +8-9 to 1-7 means that you remove the group from the list of +killed (or zombie) groups and add them to the (kinda) subscribed +groups. And last but not least, moving from 8 to 9 and 9 to 8, +which is trivial. ENTRY can either be a string (newsgroup name) +or a list (if FROMKILLED is t, it's a list on the format (NUM +INFO-LIST), otherwise it's a list in the format of the +`gnus-newsrc-hashtb' entries. LEVEL is the new level of the +group, OLDLEVEL is the old level and PREVIOUS is the group (a +string name) to insert this group after." (let (group info active num) - ;; Glean what info we can from the arguments + ;; Glean what info we can from the arguments. (if (consp entry) - (if fromkilled (setq group (nth 1 entry)) - (setq group (car (nth 2 entry)))) + (setq group (if fromkilled (nth 1 entry) (car (nth 1 entry)))) (setq group entry)) (when (and (stringp entry) oldlevel @@ -1293,21 +1275,17 @@ for new groups, and subscribe the new groups as zombies." (setq entry (gnus-group-entry entry))) (if (and (not oldlevel) (consp entry)) - (setq oldlevel (gnus-info-level (nth 2 entry))) + (setq oldlevel (gnus-info-level (nth 1 entry))) (setq oldlevel (or oldlevel gnus-level-killed))) (when (stringp previous) (setq previous (gnus-group-entry previous))) - - (if (and (>= oldlevel gnus-level-zombie) - (gnus-group-entry group)) - ;; We are trying to subscribe a group that is already - ;; subscribed. - () ; Do nothing. - + ;; Group is already subscribed. + (unless (and (>= oldlevel gnus-level-zombie) + (gnus-group-entry group)) (unless (gnus-ephemeral-group-p group) (gnus-dribble-enter (format "(gnus-group-change-level %S %S %S %S %S)" - group level oldlevel (car (nth 2 previous)) fromkilled))) + group level oldlevel previous fromkilled))) ;; Then we remove the newgroup from any old structures, if needed. ;; If the group was killed, we remove it from the killed or zombie @@ -1321,11 +1299,10 @@ for new groups, and subscribe the new groups as zombies." (t (when (and (>= level gnus-level-zombie) entry) - (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) - (when (nth 3 entry) - (setcdr (gnus-group-entry (car (nth 3 entry))) - (cdr entry))) - (setcdr (cdr entry) (cdddr entry))))) + (remhash (car (nth 1 entry)) gnus-newsrc-hashtb) + (setq gnus-group-list (remove group gnus-group-list)) + (setq gnus-newsrc-alist (delq (assoc group gnus-newsrc-alist) + gnus-newsrc-alist))))) ;; Finally we enter (if needed) the list where it is supposed to ;; go, and change the subscription level. If it is to be killed, @@ -1333,12 +1310,13 @@ for new groups, and subscribe the new groups as zombies." (cond ((>= level gnus-level-zombie) ;; Remove from the hash table. - (gnus-sethash group nil gnus-newsrc-hashtb) + (remhash group gnus-newsrc-hashtb) + (setq gnus-group-list (remove group gnus-group-list)) (if (= level gnus-level-zombie) (push group gnus-zombie-list) (if (= oldlevel gnus-level-killed) ;; Remove from active hashtb. - (unintern group gnus-active-hashtb) + (remhash group gnus-active-hashtb) ;; Don't add it into killed-list if it was killed. (push group gnus-killed-list)))) (t @@ -1349,7 +1327,7 @@ for new groups, and subscribe the new groups as zombies." ;; It was alive, and it is going to stay alive, so we ;; just change the level and don't change any pointers or ;; hash table entries. - (setcar (cdaddr entry) level) + (setcar (cdadr entry) level) (if (listp entry) (setq info (cdr entry) num (car entry)) @@ -1364,23 +1342,16 @@ for new groups, and subscribe the new groups as zombies." (if method (setq info (list group level nil nil method)) (setq info (list group level nil))))) - (unless previous - (setq previous - (let ((p gnus-newsrc-alist)) - (while (cddr p) - (setq p (cdr p))) - p))) - (setq entry (cons info (cddr previous))) - (if (cdr previous) - (progn - (setcdr (cdr previous) entry) - (gnus-sethash group (cons num (cdr previous)) - gnus-newsrc-hashtb)) - (setcdr previous entry) - (gnus-sethash group (cons num previous) - gnus-newsrc-hashtb)) - (when (cdr entry) - (setcdr (gnus-group-entry (caadr entry)) entry)) + ;; Add group. The exact ordering only matters for + ;; `gnus-group-list', though we need to keep the dummy group + ;; at the head of `gnus-newsrc-alist'. + (push info (cdr gnus-newsrc-alist)) + (puthash group (list num info) gnus-newsrc-hashtb) + (let* ((prev-idx (seq-position gnus-group-list (caadr previous))) + (idx (if prev-idx + (1+ prev-idx) + (length gnus-group-list)))) + (push group (nthcdr idx gnus-group-list))) (gnus-dribble-enter (format "(gnus-group-set-info '%S)" info) (concat "^(gnus-group-set-info '(\"" (regexp-quote group) "\""))))) @@ -1455,7 +1426,7 @@ newsgroup." (defun gnus-cache-possibly-alter-active (group active) "Alter the ACTIVE info for GROUP to reflect the articles in the cache." (when gnus-cache-active-hashtb - (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) + (let ((cache-active (gethash group gnus-cache-active-hashtb))) (when cache-active (when (< (car cache-active) (car active)) (setcar active (car cache-active))) @@ -1837,19 +1808,25 @@ backend check whether the group actually exists." (dolist (info infos) (gnus-activate-group (gnus-info-group info) nil nil method t)))))) -;; Create a hash table out of the newsrc alist. The `car's of the -;; alist elements are used as keys. (defun gnus-make-hashtable-from-newsrc-alist () + "Create a hash table from `gnus-newsrc-alist'. +The keys are group names, and values are a cons of (unread info), +where unread is an integer count of calculated unread +messages (or nil), and info is a regular gnus info entry. + +The info element is shared with the same element of +`gnus-newrc-alist', so as to conserve space." (let ((alist gnus-newsrc-alist) (ohashtb gnus-newsrc-hashtb) - prev info method rest methods) - (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) + info method gname rest methods) + (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)) + gnus-group-list nil) (setq alist - (setq prev (setq gnus-newsrc-alist - (if (equal (caar gnus-newsrc-alist) - "dummy.group") - gnus-newsrc-alist - (cons (list "dummy.group" 0 nil) alist))))) + (setq gnus-newsrc-alist + (if (equal (caar gnus-newsrc-alist) + "dummy.group") + gnus-newsrc-alist + (cons (list "dummy.group" 0 nil) alist)))) (while alist (setq info (car alist)) ;; Make the same select-methods identical Lisp objects. @@ -1858,17 +1835,18 @@ backend check whether the group actually exists." (gnus-info-set-method info (car rest)) (push method methods))) ;; Check for duplicates. - (if (gnus-gethash (car info) gnus-newsrc-hashtb) + (if (gethash (car info) gnus-newsrc-hashtb) ;; Remove this entry from the alist. - (setcdr prev (cddr prev)) - (gnus-sethash + (setcdr alist (cddr alist)) + (puthash (car info) ;; Preserve number of unread articles in groups. - (cons (and ohashtb (car (gnus-gethash (car info) ohashtb))) - prev) + (list (and ohashtb (car (gethash (car info) ohashtb))) + info) gnus-newsrc-hashtb) - (setq prev alist)) + (push (car info) gnus-group-list)) (setq alist (cdr alist))) + (setq gnus-group-list (nreverse gnus-group-list)) ;; Make the same select-methods in `gnus-server-alist' identical ;; as well. (while methods @@ -1883,10 +1861,10 @@ backend check whether the group actually exists." (setq gnus-killed-hashtb (gnus-make-hashtable (+ (length gnus-killed-list) (length gnus-zombie-list)))) - (while lists - (setq list (symbol-value (pop lists))) - (while list - (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) + (dolist (g (append gnus-killed-list gnus-zombie-list)) + ;; NOTE: We have lost the ordering that used to be kept in this + ;; variable. + (puthash g t gnus-killed-hashtb)))) (defun gnus-parse-active () "Parse active info in the nntp server buffer." @@ -1900,7 +1878,7 @@ backend check whether the group actually exists." (defun gnus-make-articles-unread (group articles) "Mark ARTICLES in GROUP as unread." - (let* ((info (nth 2 (or (gnus-group-entry group) + (let* ((info (nth 1 (or (gnus-group-entry group) (gnus-group-entry (gnus-group-real-name group))))) (ranges (gnus-info-read info)) @@ -1924,7 +1902,7 @@ backend check whether the group actually exists." "Mark ascending ARTICLES in GROUP as unread." (let* ((entry (or (gnus-group-entry group) (gnus-group-entry (gnus-group-real-name group)))) - (info (nth 2 entry)) + (info (nth 1 entry)) (ranges (gnus-info-read info)) (r ranges) modified) @@ -1987,12 +1965,11 @@ backend check whether the group actually exists." ;; Insert the change into the group buffer and the dribble file. (gnus-group-update-group group t)))) -;; Enter all dead groups into the hashtb. (defun gnus-update-active-hashtb-from-killed () - (let ((hashtb (setq gnus-active-hashtb (gnus-make-hashtable 4096)))) - (dolist (list (list gnus-killed-list gnus-zombie-list)) - (dolist (group list) - (gnus-sethash group nil hashtb))))) + (let ((hashtb (setq gnus-active-hashtb + (gnus-make-hashtable 4000)))) + (dolist (g (append gnus-killed-list gnus-zombie-list)) + (remhash g hashtb)))) (defun gnus-get-killed-groups () "Go through the active hashtb and mark all unknown groups as killed." @@ -2003,20 +1980,16 @@ backend check whether the group actually exists." (unless gnus-killed-hashtb (gnus-make-hashtable-from-killed)) ;; Go through all newsgroups that are known to Gnus - enlarge kill list. - (mapatoms - (lambda (sym) - (let ((groups 0) - (group (symbol-name sym))) - (if (or (null group) - (gnus-gethash group gnus-killed-hashtb) - (gnus-gethash group gnus-newsrc-hashtb)) - () - (let ((do-sub (gnus-matches-options-n group))) - (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore)) - () + (maphash + (lambda (g-name active) + (let ((groups 0)) + (unless (or (gethash g-name gnus-killed-hashtb) + (gethash g-name gnus-newsrc-hashtb)) + (let ((do-sub (gnus-matches-options-n g-name))) + (unless (or (eq do-sub 'subscribe) (eq do-sub 'ignore)) (setq groups (1+ groups)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb)))))) + (push g-name gnus-killed-list) + (puthash g-name t gnus-killed-hashtb)))))) gnus-active-hashtb) (gnus-dribble-touch)) @@ -2129,11 +2102,13 @@ backend check whether the group actually exists." (not (equal method gnus-select-method))) gnus-active-hashtb (setq gnus-active-hashtb - (if (equal method gnus-select-method) - (gnus-make-hashtable - (count-lines (point-min) (point-max))) - (gnus-make-hashtable 4096)))))) + (gnus-make-hashtable + (if (equal method gnus-select-method) + (count-lines (point-min) (point-max)) + 4000)))))) group max min) + (unless gnus-moderated-hashtb + (setq gnus-moderated-hashtb (gnus-make-hashtable 100))) ;; Delete unnecessary lines. (goto-char (point-min)) (cond @@ -2143,12 +2118,6 @@ backend check whether the group actually exists." (delete-matching-lines (concat "^to\\.\\|" gnus-ignored-newsgroups)))) (goto-char (point-min)) - (unless (re-search-forward "[\\\"]" nil t) - ;; Make the group names readable as a lisp expression even if they - ;; contain special characters. - (goto-char (point-max)) - (while (re-search-backward "[][';?()#]" nil t) - (insert ?\\))) ;; Let the Gnus agent save the active file. (when (and gnus-agent real-active (gnus-online method)) @@ -2168,49 +2137,41 @@ backend check whether the group actually exists." (insert prefix) (zerop (forward-line 1))))))) ;; Store the active file in a hash table. - ;; Use a unibyte buffer in order to make `read' read non-ASCII - ;; group names (which have been encoded) as unibyte strings. - (mm-with-unibyte-buffer + + (with-temp-buffer (insert-buffer-substring cur) (setq cur (current-buffer)) (goto-char (point-min)) (while (not (eobp)) (condition-case () - (progn - (narrow-to-region (point) (point-at-eol)) - ;; group gets set to a symbol interned in the hash table - ;; (what a hack!!) - jwz - (setq group (let ((obarray hashtb)) (read cur))) - ;; ### The extended group name scheme makes - ;; the previous optimization strategy sort of pointless... - (when (stringp group) - (setq group (intern group hashtb))) - (if (and (numberp (setq max (read cur))) - (numberp (setq min (read cur))) - (progn - (skip-chars-forward " \t") - (not - (or (eq (char-after) ?=) - (eq (char-after) ?x) - (eq (char-after) ?j))))) - (progn - (set group (cons min max)) - ;; if group is moderated, stick in moderation table - (when (eq (char-after) ?m) - (unless gnus-moderated-hashtb - (setq gnus-moderated-hashtb (gnus-make-hashtable))) - (gnus-sethash (symbol-name group) t - gnus-moderated-hashtb))) - (set group nil))) + (if (and (stringp (progn + (setq group (read cur) + group + (cond ((numberp group) + (number-to-string group)) + ((symbolp group) + (encode-coding-string + (symbol-name group) + 'latin-1)) + ((stringp group) + group))))) + (numberp (setq max (read cur))) + (numberp (setq min (read cur))) + (null (progn + (skip-chars-forward " \t") + (memq (char-after) + '(?= ?x ?j))))) + (progn (puthash group (cons min max) hashtb) + ;; If group is moderated, stick it in the + ;; moderation cache. + (when (eq (char-after) ?m) + (puthash group t gnus-moderated-hashtb))) + (setq group nil)) (error - (and group - (symbolp group) - (set group nil)) (unless ignore-errors (gnus-message 3 "Warning - invalid active: %s" (buffer-substring (point-at-bol) (point-at-eol)))))) - (widen) (forward-line 1))))) (defun gnus-groups-to-gnus-format (method &optional hashtb real-active) @@ -2238,35 +2199,23 @@ backend check whether the group actually exists." (gnus-active-to-gnus-format method hashtb nil real-active)) (goto-char (point-min)) - ;; We split this into to separate loops, one with the prefix - ;; and one without to speed the reading up somewhat. - (if prefix - (let (min max opoint group) - (while (not (eobp)) - (condition-case () - (progn - (read cur) (read cur) - (setq min (read cur) - max (read cur) - opoint (point)) - (skip-chars-forward " \t") - (insert prefix) - (goto-char opoint) - (set (let ((obarray hashtb)) (read cur)) - (cons min max))) - (error (and group (symbolp group) (set group nil)))) - (forward-line 1))) - (let (min max group) - (while (not (eobp)) - (condition-case () - (when (eq (char-after) ?2) - (read cur) (read cur) - (setq min (read cur) - max (read cur)) - (set (setq group (let ((obarray hashtb)) (read cur))) - (cons min max))) - (error (and group (symbolp group) (set group nil)))) - (forward-line 1))))))) + (let (min max group) + (while (not (eobp)) + (condition-case () + (when (eq (char-after) ?2) + (read cur) (read cur) + (setq min (read cur) + max (read cur) + group (read cur) + group (if (numberp group) + (number-to-string group) + (symbol-name group))) + (puthash (if prefix + (concat prefix group) + group) + (cons min max) hashtb)) + (error (remhash group hashtb))) + (forward-line 1)))))) (defun gnus-read-newsrc-file (&optional force) "Read startup file. @@ -2529,16 +2478,11 @@ If FORCE is non-nil, the .newsrc file is read." (setq gnus-newsrc-options-n nil) (unless gnus-active-hashtb - (setq gnus-active-hashtb (gnus-make-hashtable 4096))) + (setq gnus-active-hashtb (gnus-make-hashtable 4000))) (let ((buf (current-buffer)) (already-read (> (length gnus-newsrc-alist) 1)) - group subscribed options-symbol newsrc Options-symbol - symbol reads num1) + group subscribed newsrc reads num1) (goto-char (point-min)) - ;; We intern the symbol `options' in the active hashtb so that we - ;; can `eq' against it later. - (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil) - (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil) (while (not (eobp)) ;; We first read the first word on the line by narrowing and @@ -2549,15 +2493,16 @@ If FORCE is non-nil, the .newsrc file is read." (point) (progn (skip-chars-forward "^ \t!:\n") (point))) (goto-char (point-min)) - (setq symbol + (setq group (and (/= (point-min) (point-max)) - (let ((obarray gnus-active-hashtb)) (read buf)))) + (read buf)) + group (if (numberp group) + (number-to-string group) + (symbol-name group))) (widen) - ;; Now, the symbol we have read is either `options' or a group - ;; name. If it is an options line, we just add it to a string. (cond - ((or (eq symbol options-symbol) - (eq symbol Options-symbol)) + ;; It's possible that "group" is actually an options line. + ((string-equal (downcase group) "options") (setq gnus-newsrc-options ;; This concatting is quite inefficient, but since our ;; thorough studies show that approx 99.37% of all @@ -2571,19 +2516,13 @@ If FORCE is non-nil, the .newsrc file is read." (point-at-bol)) (point))))) (forward-line -1)) - (symbol - ;; Group names can be just numbers. - (when (numberp symbol) - (setq symbol (intern (int-to-string symbol) gnus-active-hashtb))) - (unless (boundp symbol) - (set symbol nil)) + (group ;; It was a group name. (setq subscribed (eq (char-after) ?:) - group (symbol-name symbol) reads nil) (if (eolp) ;; If the line ends here, this is clearly a buggy line, so - ;; we put point a the beginning of line and let the cond + ;; we put point at the beginning of line and let the cond ;; below do the error handling. (beginning-of-line) ;; We skip to the beginning of the ranges. @@ -2622,7 +2561,7 @@ If FORCE is non-nil, the .newsrc file is read." ;; It was just a simple number, so we add it to the ;; list of ranges. (push num1 reads)) - ;; If the next char in ?\n, then we have reached the end + ;; If the next char is ?\n, then we have reached the end ;; of the line and return nil. (not (eq (char-after) ?\n))) ((eq (char-after) ?\n) @@ -2651,7 +2590,8 @@ If FORCE is non-nil, the .newsrc file is read." (let ((info (gnus-get-info group)) level) (if info - ;; There is an entry for this file in the alist. + ;; There is an entry for this file in + ;; `gnus-newsrc-hashtb'. (progn (gnus-info-set-read info (nreverse reads)) ;; We update the level very gently. In fact, we @@ -2679,8 +2619,7 @@ If FORCE is non-nil, the .newsrc file is read." (setq newsrc (nreverse newsrc)) - (if (not already-read) - () + (unless already-read ;; We now have two newsrc lists - `newsrc', which is what we ;; have read from .newsrc, and `gnus-newsrc-alist', which is ;; what we've read from .newsrc.eld. We have to merge these @@ -2777,9 +2716,10 @@ If FORCE is non-nil, the .newsrc file is read." (defvar gnus-save-newsrc-file-last-timestamp nil) (defun gnus-save-newsrc-file (&optional force) - "Save .newsrc file." - ;; Note: We cannot save .newsrc file if all newsgroups are removed - ;; from the variable gnus-newsrc-alist. + "Save .newsrc file. +Use the group string names in `gnus-group-list' to pull info +values from `gnus-newsrc-hashtb', and write a new value of +`gnus-newsrc-alist'." (when (and (or gnus-newsrc-alist gnus-killed-list) gnus-current-startup-file) ;; Save agent range limits for the currently active method. @@ -2895,7 +2835,13 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-group-set-mode-line))))) (defun gnus-gnus-to-quick-newsrc-format (&optional minimal name &rest specific-variables) - "Print Gnus variables such as `gnus-newsrc-alist' in Lisp format." + "Print Gnus variables such as `gnus-newsrc-alist' in Lisp format. +Unless optional argument MINIMAL is non-nil, print human-readable +information in the header of the file, including the file +version. If NAME is present, print that as part of the header. + +Variables printed are either the variables specified in +SPECIFIC-VARIABLES, or those in `gnus-variable-list'." (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n" gnus-ding-file-coding-system)) (if name @@ -2929,9 +2875,18 @@ If FORCE is non-nil, the .newsrc file is read." ;; Remove the `gnus-killed-list' from the list of variables ;; to be saved, if required. (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))) - ;; Peel off the "dummy" group. - (gnus-newsrc-alist (cdr gnus-newsrc-alist)) variable) + ;; A bit of a fake-out here: the original value of + ;; `gnus-newsrc-alist' isn't written to file, instead it is + ;; constructed at the last minute by combining the group + ;; ordering in `gnus-group-list' with the group infos from + ;; `gnus-newsrc-hashtb'. + (set (nth (seq-position gnus-variable-list 'gnus-newsrc-alist) + gnus-variable-list) + (mapcar (lambda (g) + (nth 1 (gethash g gnus-newsrc-hashtb))) + (delete "dummy.group" gnus-group-list))) + ;; Insert the variables into the file. (while variables (when (and (boundp (setq variable (pop variables))) @@ -2956,8 +2911,8 @@ If FORCE is non-nil, the .newsrc file is read." (interactive (list (gnus-y-or-n-p "write foreign groups too? "))) ;; Generate and save the .newsrc file. (with-current-buffer (create-file-buffer gnus-current-startup-file) - (let ((newsrc (cdr gnus-newsrc-alist)) - (standard-output (current-buffer)) + (let ((standard-output (current-buffer)) + (groups (delete "dummy.group" (copy-sequence gnus-group-list))) info ranges range method) (setq buffer-file-name gnus-current-startup-file) (setq default-directory (file-name-directory buffer-file-name)) @@ -2971,13 +2926,14 @@ If FORCE is non-nil, the .newsrc file is read." (when gnus-newsrc-options (insert gnus-newsrc-options)) ;; Write subscribed and unsubscribed. - (while (setq info (pop newsrc)) - ;; Don't write foreign groups to .newsrc. + (dolist (g-name groups) + (setq info (nth 1 (gnus-group-entry g-name))) + ;; Maybe don't write foreign groups to .newsrc. (when (or (null (setq method (gnus-info-method info))) (equal method "native") (inline (gnus-server-equal method gnus-select-method)) foreign-ok) - (insert (gnus-info-group info) + (insert g-name (if (> (gnus-info-level info) gnus-level-subscribed) "!" ":")) (when (setq ranges (gnus-info-read info)) @@ -3105,10 +3061,10 @@ If FORCE is non-nil, the .newsrc file is read." ;; to avoid trying to re-read after a failed read. (unless gnus-description-hashtb (setq gnus-description-hashtb - (gnus-make-hashtable (length gnus-active-hashtb)))) + (gnus-make-hashtable (hash-table-size gnus-active-hashtb)))) ;; Mark this method's desc file as read. - (gnus-sethash (gnus-group-prefixed-name "" method) "Has read" - gnus-description-hashtb) + (puthash (gnus-group-prefixed-name "" method) "Has read" + gnus-description-hashtb) (gnus-message 5 "Reading descriptions file via %s..." (car method)) (cond @@ -3144,29 +3100,26 @@ If FORCE is non-nil, the .newsrc file is read." (zerop (forward-line 1))))))) (goto-char (point-min)) (while (not (eobp)) - ;; If we get an error, we set group to 0, which is not a - ;; symbol... (setq group (condition-case () - (let ((obarray gnus-description-hashtb)) - ;; Group is set to a symbol interned in this - ;; hash table. - (read nntp-server-buffer)) - (error 0))) + (read nntp-server-buffer) + (error nil))) (skip-chars-forward " \t") - ;; ... which leads to this line being effectively ignored. - (when (symbolp group) + (when group + (setq group (if (numberp group) + (number-to-string group) + (symbol-name group))) (let* ((str (buffer-substring (point) (progn (end-of-line) (point)))) - (name (symbol-name group)) (charset - (or (gnus-group-name-charset method name) - (gnus-parameter-charset name) + (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))) - (set group str))) + (puthash group str gnus-description-hashtb))) (forward-line 1)))) (gnus-message 5 "Reading descriptions file...done") t)))) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 4baf4bc8263..b8aa302f11a 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1,6 +1,6 @@ ;;; gnus-sum.el --- summary mode commands for Gnus -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -27,7 +27,34 @@ (require 'cl-lib) (defvar tool-bar-mode) +(defvar gnus-category-predicate-alist) +(defvar gnus-category-predicate-cache) +(defvar gnus-inhibit-article-treatments) +(defvar gnus-inhibit-demon) +(defvar gnus-tmp-article-number) +(defvar gnus-tmp-closing-bracket) +(defvar gnus-tmp-current) +(defvar gnus-tmp-dummy) +(defvar gnus-tmp-expirable) +(defvar gnus-tmp-from) +(defvar gnus-tmp-group-name) (defvar gnus-tmp-header) +(defvar gnus-tmp-indentation) +(defvar gnus-tmp-level) +(defvar gnus-tmp-lines) +(defvar gnus-tmp-number) +(defvar gnus-tmp-opening-bracket) +(defvar gnus-tmp-process) +(defvar gnus-tmp-replied) +(defvar gnus-tmp-score) +(defvar gnus-tmp-score-char) +(defvar gnus-tmp-subject) +(defvar gnus-tmp-subject-or-nil) +(defvar gnus-tmp-unread) +(defvar gnus-tmp-unread-and-unselected) +(defvar gnus-tmp-unread-and-unticked) +(defvar gnus-tmp-user-defined) +(defvar gnus-use-article-prefetch) (require 'gnus) (require 'gnus-group) @@ -39,6 +66,8 @@ (require 'gmm-utils) (require 'mm-decode) (require 'nnoo) +(eval-when-compile + (require 'subr-x)) (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) (autoload 'gnus-cache-write-active "gnus-cache") @@ -782,7 +811,7 @@ score file." :group 'gnus-score-default :type 'integer) -(defun gnus-widget-reversible-match (widget value) +(defun gnus-widget-reversible-match (_widget value) "Ignoring WIDGET, convert VALUE to internal form. VALUE should have the form `FOO' or `(not FOO)', where FOO is an symbol." ;; (debug value) @@ -792,7 +821,7 @@ VALUE should have the form `FOO' or `(not FOO)', where FOO is an symbol." (eq (nth 0 value) 'not) (symbolp (nth 1 value))))) -(defun gnus-widget-reversible-to-internal (widget value) +(defun gnus-widget-reversible-to-internal (_widget value) "Ignoring WIDGET, convert VALUE to internal form. VALUE should have the form `FOO' or `(not FOO)', where FOO is an atom. FOO is converted to (FOO nil) and (not FOO) is converted to (FOO t)." @@ -801,7 +830,7 @@ FOO is converted to (FOO nil) and (not FOO) is converted to (FOO t)." (list value nil) (list (nth 1 value) t))) -(defun gnus-widget-reversible-to-external (widget value) +(defun gnus-widget-reversible-to-external (_widget value) "Ignoring WIDGET, convert VALUE to external form. VALUE should have the form `(FOO nil)' or `(FOO t)', where FOO is an atom. \(FOO nil) is converted to FOO and (FOO t) is converted to (not FOO)." @@ -1361,7 +1390,15 @@ the normal Gnus MIME machinery." (defvar gnus-current-crosspost-group nil) (defvar gnus-newsgroup-display nil) -(defvar gnus-newsgroup-dependencies nil) +(defvar gnus-newsgroup-dependencies nil + "A hash table holding dependencies between messages.") +;; Dependencies are held in a tree structure: a list with the root +;; message as car, and each immediate child a sublist (perhaps +;; containing further sublists). Each message is represented as a +;; vector of headers. Each message's list can be looked up in the +;; dependency table using the message's Message-ID as the key. The +;; root key is the string "none". + (defvar gnus-newsgroup-adaptive nil) (defvar gnus-summary-display-article-function nil) (defvar gnus-summary-highlight-line-function nil @@ -1375,7 +1412,8 @@ the normal Gnus MIME machinery." (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from))) ?s) (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) - gnus-tmp-from) ?s) + gnus-tmp-from) + ?s) (?F gnus-tmp-from ?s) (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s) @@ -1387,12 +1425,15 @@ the normal Gnus MIME machinery." (?k (gnus-summary-line-message-size gnus-tmp-header) ?s) (?L gnus-tmp-lines ?s) (?Z (or (nnir-article-rsv (mail-header-number gnus-tmp-header)) - 0) ?d) + 0) + ?d) (?G (or (nnir-article-group (mail-header-number gnus-tmp-header)) - "") ?s) + "") + ?s) (?g (or (gnus-group-short-name (nnir-article-group (mail-header-number gnus-tmp-header))) - "") ?s) + "") + ?s) (?O gnus-tmp-downloaded ?c) (?I gnus-tmp-indentation ?s) (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) @@ -1417,7 +1458,8 @@ the normal Gnus MIME machinery." (?P (gnus-pick-line-number) ?d) (?B gnus-tmp-thread-tree-header-string ?s) (user-date (gnus-user-date - ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s)) + ,(macroexpand '(mail-header-date gnus-tmp-header))) + ?s)) "An alist of format specifications that can appear in summary lines. These are paired with what variables they correspond with, along with the type of the variable (string, integer, character, etc).") @@ -1662,6 +1704,7 @@ For example: (eval-when-compile ;; Bind features so that require will believe that gnus-sum has ;; already been loaded (avoids infinite recursion) + (with-no-warnings (defvar features)) ;Not just a local variable. (let ((features (cons 'gnus-sum features))) (require 'gnus-art))) @@ -3043,6 +3086,11 @@ When FORCE, rebuild the tool bar." (defvar bidi-paragraph-direction) +(defvar gnus-summary-mode-group nil + "Variable for communication with `gnus-summary-mode'. +Allows the `gnus-newsgroup-name' local variable to be set before +the summary mode hooks are run.") + (define-derived-mode gnus-summary-mode gnus-mode "Summary" "Major mode for reading articles. \\<gnus-summary-mode-map> @@ -3064,6 +3112,7 @@ The following commands are available: (let ((gnus-summary-local-variables gnus-newsgroup-variables)) (gnus-summary-make-local-variables)) (gnus-summary-make-local-variables) + (setq gnus-newsgroup-name gnus-summary-mode-group) (when (gnus-visual-p 'summary-menu 'menu) (gnus-summary-make-menu-bar) (gnus-summary-make-tool-bar)) @@ -3091,18 +3140,16 @@ The following commands are available: (defun gnus-summary-make-local-variables () "Make all the local summary buffer variables." - (let (global) - (dolist (local gnus-summary-local-variables) - (if (consp local) - (progn - (if (eq (cdr local) 'global) - ;; Copy the global value of the variable. - (setq global (symbol-value (car local))) - ;; Use the value from the list. - (setq global (eval (cdr local)))) - (set (make-local-variable (car local)) global)) - ;; Simple nil-valued local variable. - (set (make-local-variable local) nil))))) + (dolist (local gnus-summary-local-variables) + (if (consp local) + (let ((global (if (eq (cdr local) 'global) + ;; Copy the global value of the variable. + (symbol-value (car local)) + ;; Use the value from the list. + (eval (cdr local))))) + (set (make-local-variable (car local)) global)) + ;; Simple nil-valued local variable. + (set (make-local-variable local) nil)))) ;; Summary data functions. @@ -3476,10 +3523,10 @@ Returns non-nil if the setup was successful." (not gnus-newsgroup-prepared)) (set-buffer (gnus-get-buffer-create buffer)) (setq gnus-summary-buffer (current-buffer)) - (gnus-summary-mode) + (let ((gnus-summary-mode-group group)) + (gnus-summary-mode)) (when (gnus-group-quit-config group) (set (make-local-variable 'gnus-single-article-buffer) nil)) - (setq gnus-newsgroup-name group) (turn-on-gnus-mailing-list-mode) ;; These functions don't currently depend on GROUP, but might in ;; the future. @@ -3509,13 +3556,12 @@ buffer that was in action when the last article was fetched." (score-file gnus-current-score-file) (default-charset gnus-newsgroup-charset) vlist) - (let ((locals gnus-newsgroup-variables)) - (while locals - (if (consp (car locals)) - (push (eval (caar locals)) vlist) - (push (eval (car locals)) vlist)) - (setq locals (cdr locals))) - (setq vlist (nreverse vlist))) + (dolist (local gnus-newsgroup-variables) + (push (eval (if (consp local) (car local) + local) + t) + vlist)) + (setq vlist (nreverse vlist)) (with-temp-buffer (setq gnus-newsgroup-name name gnus-newsgroup-marked marked @@ -3530,12 +3576,11 @@ buffer that was in action when the last article was fetched." gnus-reffed-article-number reffed gnus-current-score-file score-file gnus-newsgroup-charset default-charset) - (let ((locals gnus-newsgroup-variables)) - (while locals - (if (consp (car locals)) - (set (caar locals) (pop vlist)) - (set (car locals) (pop vlist))) - (setq locals (cdr locals)))))))) + (dolist (local gnus-newsgroup-variables) + (set (if (consp local) + (car local) + local) + (pop vlist))))))) (defun gnus-summary-article-unread-p (article) "Say whether ARTICLE is unread or not." @@ -3623,19 +3668,23 @@ buffer that was in action when the last article was fetched." pos))) (setq gnus-summary-mark-positions pos)))) -(defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number) +(defun gnus-summary-insert-dummy-line (subject number) "Insert a dummy root in the summary buffer." (beginning-of-line) (add-text-properties - (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) - (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) + (point) (let ((gnus-tmp-subject subject) + (gnus-tmp-number number)) + (eval gnus-summary-dummy-line-format-spec t) + (point)) + (list 'gnus-number number 'gnus-intangible number))) (defun gnus-summary-extract-address-component (from) (or (car (funcall gnus-extract-address-components from)) from)) -(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from) - (let ((mail-parse-charset gnus-newsgroup-charset) +(defun gnus-summary-from-or-to-or-newsgroups (header from) + (let ((gnus-tmp-from from) + (mail-parse-charset gnus-newsgroup-charset) ;; Is it really necessary to do this next part for each summary line? ;; Luckily, doesn't seem to slow things down much. (mail-parse-ignored-charsets @@ -3662,25 +3711,31 @@ buffer that was in action when the last article was fetched." (and (memq 'Newsgroups gnus-extra-headers) (eq (car (gnus-find-method-for-group - gnus-newsgroup-name)) 'nntp) + gnus-newsgroup-name)) + 'nntp) (gnus-group-real-name gnus-newsgroup-name)))) (concat gnus-summary-newsgroup-prefix newsgroups))))) (bidi-string-mark-left-to-right (inline (gnus-summary-extract-address-component gnus-tmp-from)))))) -(defun gnus-summary-insert-line (gnus-tmp-header - gnus-tmp-level gnus-tmp-current - undownloaded gnus-tmp-unread gnus-tmp-replied - gnus-tmp-expirable gnus-tmp-subject-or-nil - &optional gnus-tmp-dummy gnus-tmp-score - gnus-tmp-process) - (if (>= gnus-tmp-level (length gnus-thread-indent-array)) +(defun gnus-summary-insert-line (header level current undownloaded + unread replied expirable subject-or-nil + &optional dummy score process) + (if (>= level (length gnus-thread-indent-array)) (gnus-make-thread-indent-array (max (* 2 (length gnus-thread-indent-array)) - gnus-tmp-level))) - (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) + level))) + (let* ((gnus-tmp-header header) + (gnus-tmp-level level) + (gnus-tmp-current current) + (gnus-tmp-unread unread) + (gnus-tmp-expirable expirable) + (gnus-tmp-subject-or-nil subject-or-nil) + (gnus-tmp-dummy dummy) + (gnus-tmp-process process) + (gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) - (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0)) + (gnus-tmp-score (or score gnus-summary-default-score 0)) (gnus-tmp-score-char (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) @@ -3693,7 +3748,7 @@ buffer that was in action when the last article was fetched." (cond (gnus-tmp-process gnus-process-mark) ((memq gnus-tmp-current gnus-newsgroup-cached) gnus-cached-mark) - (gnus-tmp-replied gnus-replied-mark) + (replied gnus-replied-mark) ((memq gnus-tmp-current gnus-newsgroup-forwarded) gnus-forwarded-mark) ((memq gnus-tmp-current gnus-newsgroup-saved) @@ -3849,20 +3904,20 @@ respectively." Returns \" ? \" if there's bad input or if another error occurs. Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." (condition-case () - (let* ((messy-date (float-time (gnus-date-get-time messy-date))) - (now (float-time)) + (let* ((messy-date (gnus-date-get-time messy-date)) + (now (current-time)) ;;If we don't find something suitable we'll use this one (my-format "%b %d '%y")) - (let* ((difference (- now messy-date)) + (let* ((difference (time-subtract now messy-date)) (templist gnus-user-date-format-alist) (top (eval (caar templist)))) - (while (if (numberp top) (< top difference) (not top)) + (while (if (numberp top) (time-less-p top difference) (not top)) (progn (setq templist (cdr templist)) (setq top (eval (caar templist))))) (if (stringp (cdr (car templist))) (setq my-format (cdr (car templist))))) - (format-time-string (eval my-format) (seconds-to-time messy-date))) + (format-time-string (eval my-format) messy-date)) (error " ? "))) (defun gnus-summary-set-local-parameters (group) @@ -3931,7 +3986,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Killed foreign groups can't be entered. ;; (when (and (not (gnus-group-native-p group)) - ;; (not (gnus-gethash group gnus-newsrc-hashtb))) + ;; (not (gethash group gnus-newsrc-hashtb))) ;; (error "Dead non-native groups can't be entered")) (gnus-message 7 "Retrieving newsgroup: %s..." (gnus-group-decoded-name group)) @@ -4161,7 +4216,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." "Gather threads by looking at Subject headers." (if (not gnus-summary-make-false-root) threads - (let ((hashtb (gnus-make-hashtable 1024)) + (let ((hashtb (gnus-make-hashtable 1000)) (prev threads) (result threads) subject hthread whole-subject) @@ -4170,7 +4225,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq whole-subject (mail-header-subject (caar threads))))) (when subject - (if (setq hthread (gnus-gethash subject hashtb)) + (if (setq hthread (gethash subject hashtb)) (progn ;; We enter a dummy root into the thread, if we ;; haven't done that already. @@ -4184,24 +4239,24 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setcdr prev (cdr threads)) (setq threads prev)) ;; Enter this thread into the hash table. - (gnus-sethash subject - (if gnus-summary-make-false-root-always - (progn - ;; If you want a dummy root above all - ;; threads... - (setcar threads (list whole-subject - (car threads))) - threads) - threads) - hashtb))) + (puthash subject + (if gnus-summary-make-false-root-always + (progn + ;; If you want a dummy root above all + ;; threads... + (setcar threads (list whole-subject + (car threads))) + threads) + threads) + hashtb))) (setq prev threads) (setq threads (cdr threads))) result))) (defun gnus-gather-threads-by-references (threads) "Gather threads by looking at References headers." - (let ((idhashtb (gnus-make-hashtable 1024)) - (thhashtb (gnus-make-hashtable 1024)) + (let ((idhashtb (gnus-make-hashtable 1000)) + (thhashtb (gnus-make-hashtable 1000)) (prev threads) (result threads) ids references id gthread gid entered ref) @@ -4212,11 +4267,11 @@ If SELECT-ARTICLES, only select those articles from GROUP." entered nil) (while (setq ref (pop ids)) (setq ids (delete ref ids)) - (if (not (setq gid (gnus-gethash ref idhashtb))) + (if (not (setq gid (gethash ref idhashtb))) (progn - (gnus-sethash ref id idhashtb) - (gnus-sethash id threads thhashtb)) - (setq gthread (gnus-gethash gid thhashtb)) + (puthash ref id idhashtb) + (puthash id threads thhashtb)) + (setq gthread (gethash gid thhashtb)) (unless entered ;; We enter a dummy root into the thread, if we ;; haven't done that already. @@ -4228,7 +4283,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setcdr (car gthread) (nconc (cdar gthread) (list (car threads))))) ;; Add it into the thread hash table. - (gnus-sethash id gthread thhashtb) + (puthash id gthread thhashtb) (setq entered t) ;; Remove it from the list of threads. (setcdr prev (cdr threads)) @@ -4261,12 +4316,12 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; We have found a loop. (let (ref-dep) (setcdr thread (delq (car th) (cdr thread))) - (if (boundp (setq ref-dep (intern "none" - gnus-newsgroup-dependencies))) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) + (if (setq ref-dep (gethash "none" + gnus-newsgroup-dependencies)) + (setcdr ref-dep + (nconc (cdr ref-dep) (list (car th)))) - (set ref-dep (list nil (car th)))) + (puthash ref-dep (list nil (car th)) gnus-newsgroup-dependencies)) (setq infloop 1 stack nil)) ;; Push all the subthreads onto the stack. @@ -4277,31 +4332,30 @@ If SELECT-ARTICLES, only select those articles from GROUP." "Go through the dependency hashtb and find the roots. Return all threads." (let (threads) (while (catch 'infloop - (mapatoms - (lambda (refs) + (maphash + (lambda (_id refs) ;; Deal with self-referencing References loops. - (when (and (car (symbol-value refs)) + (when (and (car refs) (not (zerop (apply '+ (mapcar (lambda (thread) (gnus-thread-loop-p - (car (symbol-value refs)) thread)) - (cdr (symbol-value refs))))))) + (car refs) thread)) + (cdr refs)))))) (setq threads nil) (throw 'infloop t)) - (unless (car (symbol-value refs)) + (unless (car refs) ;; These threads do not refer back to any other ;; articles, so they're roots. - (setq threads (append (cdr (symbol-value refs)) threads)))) + (setq threads (append (cdr refs) threads)))) gnus-newsgroup-dependencies))) threads)) ;; Build the thread tree. (defsubst gnus-dependencies-add-header (header dependencies force-new) "Enter HEADER into the DEPENDENCIES table if it is not already there. - If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even if it was already present. @@ -4312,33 +4366,38 @@ Message-ID before being entered. Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (let* ((id (mail-header-id header)) - (id-dep (and id (intern id dependencies))) + ;; An "id-dep" is a list holding the vector headers of this + ;; message, plus equivalent "id-deps" for each immediate + ;; child message. + (id-dep (and id (gethash id dependencies))) parent-id ref ref-dep ref-header replaced) ;; Enter this `header' in the `dependencies' table. (cond - ((not id-dep) + ((null id) + ;; Omit this article altogether if there is no Message-ID. (setq header nil)) - ;; The first two cases do the normal part: enter a new `header' - ;; in the `dependencies' table. - ((not (boundp id-dep)) - (set id-dep (list header))) - ((null (car (symbol-value id-dep))) - (setcar (symbol-value id-dep) header)) - + ;; Enter a new id and `header' in the `dependencies' table. + ((null id-dep) + (setq id-dep (puthash id (list header) dependencies))) + ;; A child message has already added this id, just insert the header. + ((null (car id-dep)) + (setcar (gethash id dependencies) header) + (setq id-dep (gethash id dependencies))) ;; From here the `header' was already present in the ;; `dependencies' table. (force-new ;; Overrides an existing entry; ;; just set the header part of the entry. - (setcar (symbol-value id-dep) header) + (setcar (gethash id dependencies) header) (setq replaced t)) ;; Renames the existing `header' to a unique Message-ID. ((not gnus-summary-ignore-duplicates) ;; An article with this Message-ID has already been seen. ;; We rename the Message-ID. - (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies)) - (list header)) + (setq id-dep (puthash (setq id (nnmail-message-id)) + (list header) + dependencies)) (mail-header-set-id header id)) ;; The last case ignores an existing entry, except it adds any @@ -4348,8 +4407,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; table was *not* modified. (t (mail-header-set-xref - (car (symbol-value id-dep)) - (concat (or (mail-header-xref (car (symbol-value id-dep))) + (car id-dep) + (concat (or (mail-header-xref (car id-dep)) "") (or (mail-header-xref header) ""))) (setq header nil))) @@ -4359,23 +4418,27 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq parent-id (gnus-parent-id (mail-header-references header))) (setq ref parent-id) (while (and ref - (setq ref-dep (intern-soft ref dependencies)) - (boundp ref-dep) - (setq ref-header (car (symbol-value ref-dep)))) + (setq ref-dep (gethash ref dependencies)) + (setq ref-header (car-safe ref-dep))) (if (string= id ref) ;; Yuk! This is a reference loop. Make the article be a ;; root article. (progn - (mail-header-set-references (car (symbol-value id-dep)) "none") + (mail-header-set-references (car id-dep) "none") (setq ref nil) (setq parent-id nil)) (setq ref (gnus-parent-id (mail-header-references ref-header))))) - (setq ref-dep (intern (or parent-id "none") dependencies)) - (if (boundp ref-dep) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) - (list (symbol-value id-dep)))) - (set ref-dep (list nil (symbol-value id-dep))))) + (setq ref (or parent-id "none") + ref-dep (gethash ref dependencies)) + ;; Add `header' to its parent's list of children, creating that + ;; list if the parent isn't yet registered in the dependency + ;; table. + (if ref-dep + (setcdr (gethash ref dependencies) + (nconc (cdr ref-dep) + (list id-dep))) + (puthash ref (list nil id-dep) + dependencies))) header)) (defun gnus-extract-message-id-from-in-reply-to (string) @@ -4437,16 +4500,15 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; build complete threads - if the roots haven't been expired by the ;; server, that is. (let ((mail-parse-charset gnus-newsgroup-charset) - id heads) - (mapatoms - (lambda (refs) - (when (not (car (symbol-value refs))) - (setq heads (cdr (symbol-value refs))) + heads) + (maphash + (lambda (id refs) + (when (not (car refs)) + (setq heads (cdr refs)) (while heads (if (memq (mail-header-number (caar heads)) gnus-newsgroup-dormant) (setq heads (cdr heads)) - (setq id (symbol-name refs)) (while (and (setq id (gnus-build-get-header id)) (not (car (gnus-id-to-thread id))))) (setq heads nil))))) @@ -4462,7 +4524,6 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; on the beginning of the line. (defsubst gnus-nov-parse-line (number dependencies &optional force-new) (let ((eol (point-at-eol)) - (buffer (current-buffer)) header references in-reply-to) ;; overview: [num subject from date id refs chars lines misc] @@ -4727,7 +4788,8 @@ If LINE, insert the rebuilt thread starting on line LINE." (defun gnus-id-to-thread (id) "Return the (sub-)thread where ID appears." - (gnus-gethash id gnus-newsgroup-dependencies)) + (when (hash-table-p gnus-newsgroup-dependencies) + (gethash id gnus-newsgroup-dependencies))) (defun gnus-id-to-article (id) "Return the article number of ID." @@ -4773,7 +4835,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (let (headers thread last-id) ;; First go up in this thread until we find the root. (setq last-id (gnus-root-id id) - headers (message-flatten-list (gnus-id-to-thread last-id))) + headers (flatten-tree (gnus-id-to-thread last-id))) ;; We have now found the real root of this thread. It might have ;; been gathered into some loose thread, so we have to search ;; through the threads to find the thread we wanted. @@ -4916,8 +4978,16 @@ Note that THREAD must never, ever be anything else than a variable - using some other form will lead to serious barfage." (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) ;; (8% speedup to gnus-summary-prepare, just for fun :-) - (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" - (vector thread) 2)) + (cond + ((and (boundp 'lexical-binding) lexical-binding) + ;; FIXME: This version could be a "defsubst" rather than a macro. + `(#[257 "\211:\203\16\0\211@;\203\15\0A@@\207" + [] 2] + ,thread)) + (t + ;; Not sure how XEmacs handles these things, so let's keep the old code. + (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" + (vector thread) 2)))) (defsubst gnus-article-sort-by-number (h1 h2) "Sort articles by article number." @@ -5069,7 +5139,7 @@ Unscored articles will be counted as having a score of zero." "Return the highest article number in THREAD." (apply 'max (mapcar (lambda (header) (mail-header-number header)) - (message-flatten-list thread)))) + (flatten-tree thread)))) (defun gnus-article-sort-by-most-recent-date (h1 h2) "Sort articles by number." @@ -5089,7 +5159,7 @@ Unscored articles will be counted as having a score of zero." (mapcar (lambda (header) (float-time (gnus-date-get-time (mail-header-date header)))) - (message-flatten-list thread)))) + (flatten-tree thread)))) (defun gnus-thread-total-score-1 (root) ;; This function find the total score of the thread below ROOT. @@ -5580,7 +5650,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual) t gnus-summary-ignore-duplicates)) - (info (nth 2 entry)) + (info (nth 1 entry)) charset articles fetched-articles cached) (unless (gnus-check-server @@ -5599,7 +5669,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (decode-coding-string group charset) (decode-coding-string (gnus-status-message group) charset)))) - (unless (gnus-request-group group t nil (gnus-get-info group)) + (unless (gnus-request-group group t nil info) (when (derived-mode-p 'gnus-summary-mode) (gnus-kill-buffer (current-buffer))) (error "Couldn't request group %s: %s" @@ -5948,7 +6018,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (min (car active)) (max (cdr active)) (types gnus-article-mark-lists) - marks var articles article mark mark-type + var articles article mark mark-type bgn end) ;; Hack to avoid adjusting marks for imap. (when (eq (car (gnus-find-method-for-group (gnus-info-group info))) @@ -6202,22 +6272,21 @@ The resulting hash table is returned, or nil if no Xrefs were found." (setq number (string-to-number (substring xrefs (match-beginning 2) (match-end 2)))) - (if (setq entry (gnus-gethash group xref-hashtb)) + (if (setq entry (gethash group xref-hashtb)) (setcdr entry (cons number (cdr entry))) - (gnus-sethash group (cons number nil) xref-hashtb))))) + (puthash group (cons number nil) xref-hashtb))))) (and start xref-hashtb))) (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads) "Look through all the headers and mark the Xrefs as read." (let ((virtual (gnus-virtual-group-p from-newsgroup)) - name info xref-hashtb idlist method nth4) + name info xref-hashtb method nth4) (with-current-buffer gnus-group-buffer (when (setq xref-hashtb (gnus-create-xref-hashtb from-newsgroup headers unreads)) - (mapatoms - (lambda (group) - (unless (string= from-newsgroup (setq name (symbol-name group))) - (setq idlist (symbol-value group)) + (maphash + (lambda (group idlist) + (unless (string= from-newsgroup group) ;; Dead groups are not updated. (and (prog1 (setq info (gnus-get-info name)) @@ -6243,7 +6312,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (defun gnus-compute-read-articles (group articles) (let* ((entry (gnus-group-entry group)) - (info (nth 2 entry)) + (info (nth 1 entry)) (active (gnus-active group)) ninfo) (when entry @@ -6280,7 +6349,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." "Update the info of GROUP to say that ARTICLES are read." (let* ((num 0) (entry (gnus-group-entry group)) - (info (nth 2 entry)) + (info (nth 1 entry)) (active (gnus-active group)) (set-marks (gnus-method-option-p @@ -7465,7 +7534,7 @@ The state which existed when entering the ephemeral is reset." (with-current-buffer buffer (gnus-deaden-summary)))))) -(defun gnus-summary-wake-up-the-dead (&rest args) +(defun gnus-summary-wake-up-the-dead (&rest _) "Wake up the dead summary buffer." (interactive) (gnus-dead-summary-mode -1) @@ -7691,6 +7760,12 @@ Given a prefix, will force an `article' buffer configuration." (gnus-article-setup-buffer)) (gnus-set-global-variables) (with-current-buffer gnus-article-buffer + ;; The buffer may be non-empty and even narrowed, so go back to + ;; a sane state. + (widen) + ;; We're going to erase the buffer anyway so do it now: it can save us from + ;; uselessly performing multibyte-conversion of the current content. + (let ((inhibit-read-only t)) (erase-buffer)) (setq gnus-article-charset gnus-newsgroup-charset) (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets) (mm-enable-multibyte)) @@ -7722,7 +7797,7 @@ be displayed." (unless (derived-mode-p 'gnus-summary-mode) (set-buffer gnus-summary-buffer)) (let ((article (or article (gnus-summary-article-number))) - (all-headers (not (not all-headers))) ;Must be t or nil. + (all-headers (and all-headers t)) ; Must be t or nil. gnus-summary-display-article-function) (and (not pseudo) (gnus-summary-article-pseudo-p article) @@ -7834,7 +7909,7 @@ If BACKWARD, the previous article is selected instead of the next." (gnus-summary-walk-group-buffer gnus-newsgroup-name cmd unread backward point)))))))) -(defun gnus-summary-walk-group-buffer (from-group cmd unread backward start) +(defun gnus-summary-walk-group-buffer (_from-group cmd unread backward start) (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1)) (?\C-p (gnus-group-prev-unread-group 1)))) (cursor-in-echo-area t) @@ -8128,7 +8203,7 @@ score higher than the default score." "Select the first unread subject that has a score over the default score." (interactive) (let ((data gnus-newsgroup-data) - article score) + article) (while (and (setq article (gnus-data-number (car data))) (or (gnus-data-read-p (car data)) (not (> (gnus-summary-article-score article) @@ -8541,7 +8616,7 @@ If UNREPLIED (the prefix), limit to unreplied articles." (gnus-summary-limit gnus-newsgroup-replied)) (gnus-summary-position-point)) -(defun gnus-summary-limit-exclude-marks (marks &optional reverse) +(defun gnus-summary-limit-exclude-marks (marks &optional _reverse) "Exclude articles that are marked with MARKS (e.g. \"DK\"). If REVERSE, limit the summary buffer to articles that are marked with MARKS. MARKS can either be a string of marks or a list of marks. @@ -8842,11 +8917,11 @@ fetch-old-headers verbiage, and so on." (null gnus-thread-expunge-below))) (push gnus-newsgroup-limit gnus-newsgroup-limits) (setq gnus-newsgroup-limit nil) - (mapatoms - (lambda (node) - (unless (car (symbol-value node)) + (maphash + (lambda (_id deps) + (unless (car deps) ;; These threads have no parents -- they are roots. - (let ((nodes (cdr (symbol-value node))) + (let ((nodes (cdr deps)) thread) (while nodes (if (and gnus-thread-expunge-below @@ -9501,6 +9576,9 @@ fetched headers for, whether they are displayed or not." (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) (case-fold-search t)) (dolist (header gnus-newsgroup-headers) + ;; FIXME: when called from gnus-summary-limit-include-thread via + ;; gnus-summary-limit-include-matching-articles, `regexp' is a decoded + ;; string whereas the header isn't decoded. (when (string-match regexp (funcall func header)) (push (mail-header-number header) articles))) (nreverse articles))) @@ -9515,7 +9593,7 @@ be taken into consideration. If NOT-CASE-FOLD, case won't be folded in the comparisons. If NOT-MATCHING, return a list of all articles that not match REGEXP on HEADER." (let ((case-fold-search (not not-case-fold)) - articles d func) + articles func) (if (consp header) (if (eq (car header) 'extra) (setq func @@ -9635,6 +9713,10 @@ to save in." (gnus-summary-remove-process-mark article)) (ps-despool filename)) +(defvar ps-right-header) +(defvar ps-left-header) +(defvar shr-ignore-cache) + (defun gnus-print-buffer () (let ((ps-left-header (list @@ -9860,7 +9942,7 @@ prefix specifies how many places to rotate each letter forward." ;; Create buttons and stuff... (gnus-treat-article nil)) -(defun gnus-summary-idna-message (&optional arg) +(defun gnus-summary-idna-message (&optional _arg) "Decode IDNA encoded domain names in the current articles. IDNA encoded domain names looks like `xn--bar'. If a string remain unencoded after running this function, it is likely an @@ -9868,7 +9950,7 @@ invalid IDNA string (`xn--bar' is invalid). You must have GNU Libidn (URL `https://www.gnu.org/software/libidn/') installed for this command to work." - (interactive "P") + (interactive) (gnus-summary-select-article) (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9880,9 +9962,9 @@ installed for this command to work." (replace-match (puny-decode-domain (match-string 1)))) (set-window-start (get-buffer-window (current-buffer)) start)))))) -(defun gnus-summary-morse-message (&optional arg) +(defun gnus-summary-morse-message (&optional _arg) "Morse decode the current article." - (interactive "P") + (interactive) (gnus-summary-select-article) (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9940,11 +10022,11 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (cond ((and (eq action 'move) (not (gnus-check-backend-function 'request-move-article gnus-newsgroup-name))) - (error "The current group does not support article moving")) + (user-error "The current group does not support article moving")) ((and (eq action 'crosspost) (not (gnus-check-backend-function 'request-replace-article gnus-newsgroup-name))) - (error "The current group does not support article editing"))) + (user-error "The current group does not support article editing"))) (let ((articles (gnus-summary-work-articles n)) (prefix (if (gnus-check-backend-function 'request-move-article gnus-newsgroup-name) @@ -9961,8 +10043,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (unless (assq action names) (error "Unknown action %s" action)) ;; Read the newsgroup name. - (when (and (not to-newsgroup) - (not select-method)) + (unless (or to-newsgroup select-method) (if (and gnus-move-split-methods (not (and (memq gnus-current-article articles) @@ -10007,6 +10088,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (or (car select-method) (gnus-group-decoded-name to-newsgroup)) articles) + ;; This `while' is not equivalent to a `dolist' (bug#33653#134). (while articles (setq article (pop articles)) ;; Set any marks that may have changed in the summary buffer. @@ -10017,8 +10099,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (cond ;; Move the article. ((eq action 'move) - ;; Remove this article from future suppression. - (gnus-dup-unsuppress-article article) + (when gnus-suppress-duplicates + ;; Remove this article from future suppression. + (gnus-dup-unsuppress-article article)) (let* ((from-method (gnus-find-method-for-group gnus-newsgroup-name)) (to-method (or select-method @@ -10209,7 +10292,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." to-newsgroup select-method)) - ;;;!!!Why is this necessary? + ;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) (when (eq action 'move) @@ -10575,7 +10658,7 @@ groups." (let ((mbl mml-buffer-list)) (setq mml-buffer-list nil) (let ((rfc2047-quote-decoded-words-containing-tspecials t)) - (mime-to-mml ,'current-handles)) + (mime-to-mml ',current-handles)) (let ((mbl1 mml-buffer-list)) (setq mml-buffer-list mbl) (set (make-local-variable 'mml-buffer-list) mbl1)) @@ -10863,8 +10946,8 @@ the actual number of articles unmarked is returned." (set var (cons article (symbol-value var))) (if (memq type '(processable cached replied forwarded recent saved)) (gnus-summary-update-secondary-mark article) - ;;; !!! This is bogus. We should find out what primary - ;;; !!! mark we want to set. + ;; !!! This is bogus. We should find out what primary + ;; !!! mark we want to set. (gnus-summary-update-mark gnus-del-mark 'unread))))) (defun gnus-summary-mark-as-expirable (n) @@ -11993,10 +12076,10 @@ Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'marks reverse)) -(defun gnus-summary-sort-by-original (&optional reverse) +(defun gnus-summary-sort-by-original (&optional _reverse) "Sort the summary buffer using the default sorting method. Argument REVERSE means reverse order." - (interactive "P") + (interactive) (let* ((inhibit-read-only t) (gnus-summary-prepare-hook nil)) ;; We do the sorting by regenerating the threads. @@ -12282,12 +12365,11 @@ save those articles instead." (nreverse split-name))) (defun gnus-valid-move-group-p (group) - (and (symbolp group) - (boundp group) - (symbol-name group) - (symbol-value group) - (gnus-get-function (gnus-find-method-for-group - (symbol-name group)) 'request-accept-article t))) + (when (and (stringp group) + (null (string-empty-p group))) + (gnus-get-function (gnus-find-method-for-group + group) + 'request-accept-article t))) (defun gnus-read-move-group-name (prompt default articles prefix) "Read a group name." @@ -12298,27 +12380,24 @@ save those articles instead." (if (> (length articles) 1) (format "these %d articles" (length articles)) "this article"))) - valid-names + (valid-names + (seq-filter #'gnus-valid-move-group-p + (hash-table-keys gnus-active-hashtb))) (to-newsgroup - (progn - (mapatoms (lambda (g) - (when (gnus-valid-move-group-p g) - (push g valid-names))) - gnus-active-hashtb) - (cond - ((null split-name) - (gnus-group-completing-read - prom - valid-names - nil prefix nil default)) - ((= 1 (length split-name)) - (gnus-group-completing-read - prom - valid-names - nil prefix 'gnus-group-history (car split-name))) - (t - (gnus-completing-read - prom (nreverse split-name) nil nil 'gnus-group-history))))) + (cond + ((null split-name) + (gnus-group-completing-read + prom + valid-names + nil prefix nil default)) + ((= 1 (length split-name)) + (gnus-group-completing-read + prom + valid-names + nil prefix 'gnus-group-history (car split-name))) + (t + (gnus-completing-read + prom (nreverse split-name) nil nil 'gnus-group-history)))) (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))) encoded) (when to-newsgroup @@ -12326,7 +12405,7 @@ save those articles instead." (string= to-newsgroup prefix)) (setq to-newsgroup default)) (unless to-newsgroup - (error "No group name entered")) + (user-error "No group name entered")) (setq encoded (encode-coding-string to-newsgroup (gnus-group-name-charset to-method to-newsgroup))) @@ -12338,7 +12417,7 @@ save those articles instead." (gnus-activate-group encoded nil nil to-method) (gnus-subscribe-group encoded)) (error "Couldn't create group %s" to-newsgroup))) - (error "No such group: %s" to-newsgroup)) + (user-error "No such group: %s" to-newsgroup)) encoded))) (defvar gnus-summary-save-parts-counter) @@ -12636,14 +12715,21 @@ If REVERSE, save parts that do not match TYPE." (c cond) (list gnus-summary-highlight)) (while list - (setcdr c (cons (list (caar list) (list 'quote (cdar list))) - nil)) + (setcdr c `((,(caar list) ',(cdar list)))) (setq c (cdr c) list (cdr list))) - (gnus-byte-compile (list 'lambda nil cond)))))) + (gnus-byte-compile + `(lambda () + (with-no-warnings ;See docstring of gnus-summary-highlight. + (defvar score) (defvar default) (defvar default-high) + (defvar default-low) (defvar mark) (defvar uncached)) + ,cond)))))) (defun gnus-summary-highlight-line () "Highlight current line according to `gnus-summary-highlight'." + (with-no-warnings ;See docstring of gnus-summary-highlight. + (defvar score) (defvar default) (defvar default-high) (defvar default-low) + (defvar mark) (defvar uncached)) (let* ((beg (point-at-bol)) (article (or (gnus-summary-article-number) gnus-current-article)) (score (or (cdr (assq article diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 06ffe9571f5..e2c728df8f4 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -1,6 +1,6 @@ ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Ilja Weis <kult@uni-paderborn.de> ;; Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -31,6 +31,8 @@ (require 'gnus-group) (require 'gnus-start) (require 'gnus-util) +(eval-when-compile + (require 'subr-x)) (defgroup gnus-topic nil "Group topics." @@ -99,8 +101,7 @@ See Info node `(gnus)Formatting Variables'." (defun gnus-group-topic-name () "The name of the topic on the current line." - (let ((topic (get-text-property (point-at-bol) 'gnus-topic))) - (and topic (symbol-name topic)))) + (get-text-property (point-at-bol) 'gnus-topic)) (defun gnus-group-topic-level () "The level of the topic on the current line." @@ -144,8 +145,7 @@ See Info node `(gnus)Formatting Variables'." (defun gnus-topic-goto-topic (topic) (when topic - (gnus-goto-char (text-property-any (point-min) (point-max) - 'gnus-topic (intern topic))))) + (gnus-text-property-search 'gnus-topic topic nil 'goto))) (defun gnus-topic-jump-to-topic (topic) "Go to TOPIC." @@ -167,8 +167,7 @@ See Info node `(gnus)Formatting Variables'." (point) 'gnus-topic)) (get-text-property (max (1- (point)) (point-min)) 'gnus-topic)))))) - (when result - (symbol-name result)))) + result)) (defun gnus-current-topics (&optional topic) "Return a list of all current topics, lowest in hierarchy first. @@ -195,7 +194,7 @@ If RECURSIVE is t, return groups in its subtopics too." (while groups (when (setq group (pop groups)) (setq entry (gnus-group-entry group) - info (nth 2 entry) + info (nth 1 entry) params (gnus-info-params info) active (gnus-active group) unread (or (car entry) @@ -462,7 +461,7 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." (gnus-group-prepare-flat-list-dead (seq-remove (lambda (group) (or (gnus-group-entry group) - (gnus-gethash group gnus-killed-hashtb))) + (gethash group gnus-killed-hashtb))) not-in-list) gnus-level-killed ?K regexp))) @@ -536,7 +535,7 @@ articles in the topic and its subtopics." (funcall regexp entry)) ((null regexp) t) (t nil)))) - (setq info (nth 2 entry)) + (setq info (nth 1 entry)) (gnus-group-prepare-logic (gnus-info-group info) (and (or (not gnus-group-listed-groups) @@ -557,7 +556,7 @@ articles in the topic and its subtopics." (car active)) nil) ;; Living groups. - (when (setq info (nth 2 entry)) + (when (setq info (nth 1 entry)) (gnus-group-insert-group-line (gnus-info-group info) (gnus-info-level info) (gnus-info-marks info) @@ -646,7 +645,7 @@ articles in the topic and its subtopics." (point) (prog1 (1+ (point)) (eval gnus-topic-line-format-spec)) - (list 'gnus-topic (intern name) + (list 'gnus-topic name 'gnus-topic-level level 'gnus-topic-unread unread 'gnus-active active-topic @@ -844,10 +843,9 @@ articles in the topic and its subtopics." ;; they belong to some topic. (let* ((tgroups (apply 'append (mapcar 'cdr gnus-topic-alist))) (entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist))) - (newsrc (cdr gnus-newsrc-alist)) - group) - (while newsrc - (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups) + (groups (cdr gnus-group-list))) + (dolist (group groups) + (unless (member group tgroups) (setcdr entry (list group)) (setq entry (cdr entry))))) ;; Go through all topics and make sure they contain only living groups. @@ -888,7 +886,7 @@ articles in the topic and its subtopics." (while (setq group (pop topic)) (when (and (or (gnus-active group) (gnus-info-method (gnus-get-info group))) - (not (gnus-gethash group gnus-killed-hashtb))) + (not (gethash group gnus-killed-hashtb))) (push group filtered-topic))) (push (cons topic-name (nreverse filtered-topic)) result))) (setq gnus-topic-alist (nreverse result)))) @@ -898,7 +896,7 @@ articles in the topic and its subtopics." (with-current-buffer gnus-group-buffer (let ((inhibit-read-only t)) (unless gnus-topic-inhibit-change-level - (gnus-group-goto-group (or (car (nth 2 previous)) group)) + (gnus-group-goto-group (or (car (nth 1 previous)) group)) (when (and gnus-topic-mode gnus-topic-alist (not gnus-topic-inhibit-change-level)) @@ -956,7 +954,7 @@ articles in the topic and its subtopics." (if (not group) (if (not (memq 'gnus-topic props)) (goto-char (point-max)) - (let ((topic (symbol-name (cadr (memq 'gnus-topic props))))) + (let ((topic (cadr (memq 'gnus-topic props)))) (or (gnus-topic-goto-topic topic) (gnus-topic-goto-topic (gnus-topic-next-topic topic))))) (if (gnus-group-goto-group group) @@ -992,12 +990,8 @@ articles in the topic and its subtopics." ;; First we make sure that we have really read the active file. (when (or force (not gnus-topic-active-alist)) - (let (groups) - ;; Get a list of all groups available. - (mapatoms (lambda (g) (when (symbol-value g) - (push (symbol-name g) groups))) - gnus-active-hashtb) - (setq groups (sort groups 'string<)) + ;; Get a list of all groups available. + (let ((groups (sort (hash-table-keys gnus-active-hashtb) #'string<))) ;; Init the variables. (setq gnus-topic-active-topology (list (list "" 'visible))) (setq gnus-topic-active-alist nil) @@ -1202,7 +1196,7 @@ If performed over a topic line, toggle folding the topic." (save-excursion (gnus-message 5 "Expiring groups in %s..." topic) (let ((gnus-group-marked - (mapcar (lambda (entry) (car (nth 2 entry))) + (mapcar (lambda (entry) (car (nth 1 entry))) (gnus-topic-find-groups topic gnus-level-killed t nil t)))) (gnus-group-expire-articles nil)) @@ -1216,7 +1210,7 @@ Also see `gnus-group-catchup'." (call-interactively 'gnus-group-catchup-current) (save-excursion (let* ((groups - (mapcar (lambda (entry) (car (nth 2 entry))) + (mapcar (lambda (entry) (car (nth 1 entry))) (gnus-topic-find-groups topic gnus-level-killed t nil t))) (inhibit-read-only t) @@ -1449,7 +1443,7 @@ If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics." (not non-recursive)))) (while groups (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) - (gnus-info-group (nth 2 (pop groups))))))))) + (gnus-info-group (nth 1 (pop groups))))))))) (defun gnus-topic-unmark-topic (topic &optional _dummy non-recursive) "Remove the process mark from all groups in the TOPIC. diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el index d487262c931..179679a8298 100644 --- a/lisp/gnus/gnus-undo.el +++ b/lisp/gnus/gnus-undo.el @@ -1,6 +1,6 @@ ;;; gnus-undo.el --- minor mode for undoing in Gnus -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index e69aa2cc6a8..6b0f29b0afb 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1,6 +1,6 @@ ;;; gnus-util.el --- utility functions for Gnus -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -35,6 +35,7 @@ (eval-when-compile (require 'cl-lib)) (require 'time-date) +(require 'text-property-search) (defcustom gnus-completing-read-function 'gnus-emacs-completing-read "Function use to do completing read." @@ -104,13 +105,6 @@ This is a compatibility function for different Emacsen." (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) -(defmacro gnus-intern-safe (string hashtable) - "Get hash value. Arguments are STRING and HASHTABLE." - `(let ((symbol (intern ,string ,hashtable))) - (or (boundp symbol) - (set symbol nil)) - symbol)) - (defsubst gnus-goto-char (point) (and point (goto-char point))) @@ -139,7 +133,7 @@ This is a compatibility function for different Emacsen." (defun gnus-extract-address-components (from) "Extract address components from a From header. -Given an RFC-822 address FROM, extract full name and canonical address. +Given an RFC-822 (or later) address FROM, extract name and address. Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). Much more simple solution than `mail-header-parse-address', which works much better, but is slower." @@ -199,6 +193,36 @@ is slower." (search-forward ":" eol t) (point))))) +(defun gnus-text-property-search (prop value &optional forward-only goto end) + "Search current buffer for text property PROP with VALUE. +Behaves like a combination of `text-property-any' and +`text-property-search-forward'. Searches for the beginning of a +text property `equal' to VALUE. Returns the value of point at +the beginning of the matching text property span. + +If FORWARD-ONLY is non-nil, only search forward from point. + +If GOTO is non-nil, move point to the beginning of that span +instead. + +If END is non-nil, use the end of the span instead." + (let* ((start (point)) + (found (progn + (unless forward-only + (goto-char (point-min))) + (text-property-search-forward + prop value #'equal))) + (target (when found + (if end + (prop-match-end found) + (prop-match-beginning found))))) + (when target + (if goto + (goto-char target) + (prog1 + target + (goto-char start)))))) + (declare-function gnus-find-method-for-group "gnus" (group &optional info)) (declare-function gnus-group-name-decode "gnus-group" (string charset)) (declare-function gnus-group-name-charset "gnus-group" (method group)) @@ -390,22 +414,9 @@ Cache the result as a text property stored in DATE." "Quote all \"%\"'s in STRING." (replace-regexp-in-string "%" "%%" string)) -;; Make a hash table (default and minimum size is 256). -;; Optional argument HASHSIZE specifies the table size. -(defun gnus-make-hashtable (&optional hashsize) - (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 256) 256) 0)) - -;; Make a number that is suitable for hashing; bigger than MIN and -;; equal to some 2^x. Many machines (such as sparcs) do not have a -;; hardware modulo operation, so they implement it in software. On -;; many sparcs over 50% of the time to intern is spent in the modulo. -;; Yes, it's slower than actually computing the hash from the string! -;; So we use powers of 2 so people can optimize the modulo to a mask. -(defun gnus-create-hash-size (min) - (let ((i 1)) - (while (< i min) - (setq i (* 2 i))) - i)) +(defsubst gnus-make-hashtable (&optional size) + "Make a hash table of SIZE, testing on `equal'." + (make-hash-table :size (or size 300) :test #'equal)) (defcustom gnus-verbose 6 "Integer that says how verbose Gnus should be. @@ -1174,18 +1185,16 @@ ARG is passed to the first function." ;; The buffer should be in the unibyte mode because group names ;; are ASCII text or encoded non-ASCII text (i.e., unibyte). (mm-disable-multibyte) - (mapatoms - (lambda (sym) - (when (and sym - (boundp sym) - (symbol-value sym)) - (insert (format "%S %d %d y\n" + (maphash + (lambda (group active) + (when active + (insert (format "%s %d %d y\n" (if full-names - sym - (intern (gnus-group-real-name (symbol-name sym)))) - (or (cdr (symbol-value sym)) - (car (symbol-value sym))) - (car (symbol-value sym)))))) + group + (gnus-group-real-name group)) + (or (cdr active) + (car active)) + (car active))))) hashtb) (goto-char (point-max)) (while (search-backward "\\." nil t) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index a171a385956..253ee24f32c 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -1,6 +1,6 @@ ;;; gnus-uu.el --- extract (uu)encoded files in Gnus -;; Copyright (C) 1985-1987, 1993-1998, 2000-2018 Free Software +;; Copyright (C) 1985-1987, 1993-1998, 2000-2019 Free Software ;; Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el index 24235d9c718..6042365c74f 100644 --- a/lisp/gnus/gnus-vm.el +++ b/lisp/gnus/gnus-vm.el @@ -1,6 +1,6 @@ ;;; gnus-vm.el --- vm interface for Gnus -;; Copyright (C) 1994-2018 Free Software Foundation, Inc. +;; Copyright (C) 1994-2019 Free Software Foundation, Inc. ;; Author: Per Persson <pp@gnu.ai.mit.edu> ;; Keywords: news, mail diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index ff3073a6794..5f7154c5456 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el @@ -1,6 +1,6 @@ ;;; gnus-win.el --- window configuration functions for Gnus -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 1ac02b4531c..989347c9fd1 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1,6 +1,6 @@ ;;; gnus.el --- a newsreader for GNU Emacs -*- lexical-binding:t -*- -;; Copyright (C) 1987-1990, 1993-1998, 2000-2018 Free Software +;; Copyright (C) 1987-1990, 1993-1998, 2000-2019 Free Software ;; Foundation, Inc. ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> @@ -29,7 +29,8 @@ (run-hooks 'gnus-load-hook) -(eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'cl-lib) + (require 'subr-x)) (require 'wid-edit) (require 'mm-util) (require 'nnheader) @@ -2453,28 +2454,37 @@ such as a mark that says whether an article is stored in the cache gnus-registry.el will populate this if it's loaded.") (defvar gnus-newsrc-hashtb nil - "Hashtable of `gnus-newsrc-alist'.") + "Hash table of `gnus-newsrc-alist'.") + +(defvar gnus-group-list nil + "Ordered list of group names as strings. +This variable only exists to provide easy access to the ordering +of `gnus-newsrc-alist'.") (defvar gnus-killed-list nil "List of killed newsgroups.") (defvar gnus-killed-hashtb nil - "Hash table equivalent of `gnus-killed-list'.") + "Hash table equivalent of `gnus-killed-list'. +This is a hash table purely for the fast membership test: values +are always t.") (defvar gnus-zombie-list nil "List of almost dead newsgroups.") (defvar gnus-description-hashtb nil - "Descriptions of newsgroups.") + "Hash table mapping group names to their descriptions.") (defvar gnus-list-of-killed-groups nil "List of newsgroups that have recently been killed by the user.") (defvar gnus-active-hashtb nil - "Hashtable of active articles.") + "Hash table mapping group names to their active entry.") (defvar gnus-moderated-hashtb nil - "Hashtable of moderated newsgroups.") + "Hash table of moderated groups. +This is a hash table purely for the fast membership test: values +are always t.") ;; Save window configuration. (defvar gnus-prev-winconf nil) @@ -2800,36 +2810,21 @@ See Info node `(gnus)Formatting Variables'." (defun gnus-header-from (header) (mail-header-from header)) -(defmacro gnus-gethash (string hashtable) - "Get hash value of STRING in HASHTABLE." - `(symbol-value (intern-soft ,string ,hashtable))) - -(defmacro gnus-gethash-safe (string hashtable) - "Get hash value of STRING in HASHTABLE. -Return nil if not defined." - `(let ((sym (intern-soft ,string ,hashtable))) - (and (boundp sym) (symbol-value sym)))) - -(defmacro gnus-sethash (string value hashtable) - "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." - `(set (intern ,string ,hashtable) ,value)) -(put 'gnus-sethash 'edebug-form-spec '(form form form)) - (defmacro gnus-group-unread (group) "Get the currently computed number of unread articles in GROUP." - `(car (gnus-gethash ,group gnus-newsrc-hashtb))) + `(car (gethash ,group gnus-newsrc-hashtb))) (defmacro gnus-group-entry (group) "Get the newsrc entry for GROUP." - `(gnus-gethash ,group gnus-newsrc-hashtb)) + `(gethash ,group gnus-newsrc-hashtb)) (defmacro gnus-active (group) "Get active info on GROUP." - `(gnus-gethash ,group gnus-active-hashtb)) + `(gethash ,group gnus-active-hashtb)) (defmacro gnus-set-active (group active) "Set GROUP's active info." - `(gnus-sethash ,group ,active gnus-active-hashtb)) + `(puthash ,group ,active gnus-active-hashtb)) ;; Info access macros. @@ -2893,10 +2888,10 @@ Return nil if not defined." (setcar rank (cons (car rank) ,score))))) (defmacro gnus-get-info (group) - `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb))) + `(nth 1 (gethash ,group gnus-newsrc-hashtb))) (defun gnus-set-info (group info) - (setcar (nthcdr 2 (gnus-gethash group gnus-newsrc-hashtb)) + (setcdr (gethash group gnus-newsrc-hashtb) info)) @@ -3185,7 +3180,7 @@ that that variable is buffer-local to the summary buffers." (defun gnus-kill-ephemeral-group (group) "Remove ephemeral GROUP from relevant structures." - (gnus-sethash group nil gnus-newsrc-hashtb)) + (remhash group gnus-newsrc-hashtb)) (defun gnus-simplify-mode-line () "Make mode lines a bit simpler." @@ -3751,7 +3746,7 @@ just the host name." ;; otherwise collapse to select method. (let* ((colon (string-match ":" group)) (server (and colon (substring group 0 colon))) - (plus (and server (string-match "+" server)))) + (plus (and server (string-match "\\+" server)))) (when server (if plus (setq foreign (substring server (+ 1 plus) diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el index d13aaccd748..781176307e4 100644 --- a/lisp/gnus/gssapi.el +++ b/lisp/gnus/gssapi.el @@ -1,6 +1,6 @@ ;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs -;; Copyright (C) 2011-2018 Free Software Foundation, Inc. +;; Copyright (C) 2011-2019 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon@josefsson.org> ;; Lars Magne Ingebrigtsen <larsi@gnus.org> diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el index 128886e03c4..5d5be444e44 100644 --- a/lisp/gnus/legacy-gnus-agent.el +++ b/lisp/gnus/legacy-gnus-agent.el @@ -1,6 +1,6 @@ ;;; gnus-agent.el --- Legacy unplugged support for Gnus -;; Copyright (C) 2004-2018 Free Software Foundation, Inc. +;; Copyright (C) 2004-2019 Free Software Foundation, Inc. ;; Author: Kevin Greiner <kgreiner@xpediantsolutions.com> ;; Keywords: news diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 5af292091e8..7514e64e7c2 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -1,6 +1,6 @@ ;;; mail-source.el --- functions for fetching mail -;; Copyright (C) 1999-2018 Free Software Foundation, Inc. +;; Copyright (C) 1999-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news, mail @@ -647,9 +647,9 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) ;; Don't check for old incoming files more than once per day to ;; save a lot of file accesses. (when (or (null mail-source-incoming-last-checked-time) - (> (float-time - (time-since mail-source-incoming-last-checked-time)) - (* 24 60 60))) + (time-less-p + (* 24 60 60) + (time-since mail-source-incoming-last-checked-time))) (setq mail-source-incoming-last-checked-time (current-time)) (mail-source-delete-old-incoming mail-source-delete-incoming diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index fdaa4e82727..c8b6f0ee685 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1,6 +1,6 @@ ;;; message.el --- composing mail and news messages -*- lexical-binding: t -*- -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: mail, news @@ -1285,11 +1285,10 @@ called and its result is inserted." (goto-char (point-min)) (let ((case-fold-search nil)) (re-search-forward "^OR\\>" nil t)))) - ;; According to RFC822, "The field-name must be composed of printable - ;; ASCII characters (i. e., characters that have decimal values between - ;; 33 and 126, except colon)", i. e., any chars except ctl chars, - ;; space, or colon. - '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) + ;; According to RFC 822 and its successors, the field name must + ;; consist of printable US-ASCII characters other than colon, + ;; i.e., decimal 33-56 and 59-126. + '(looking-at "[ \t]\\|[][!\"#$%&'()*+,./0-9;<=>?@A-Z\\^_`a-z{|}~-]+:")) "Set this non-nil if the system's mailer runs the header and body together. \(This problem exists on Sunos 4 when sendmail is run in remote mode.) The value should be an expression to test whether the problem will @@ -1733,7 +1732,7 @@ no, only reply back to the author." :type 'boolean) (defcustom message-user-fqdn nil - "Domain part of Message-Ids." + "Domain part of Message-IDs." :version "22.1" :group 'message-headers :link '(custom-manual "(message)News Headers") @@ -1791,8 +1790,8 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (concat "From " - ;; Many things can happen to an RFC 822 mailbox before it is put into - ;; a `From' line. The leading phrase can be stripped, e.g. + ;; Many things can happen to an RFC 822 (or later) mailbox before it is + ;; put into a `From' line. The leading phrase can be stripped, e.g. ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g. ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF ;; can be removed, e.g. @@ -5400,6 +5399,17 @@ Otherwise, generate and save a value for `canlock-password' first." (message "Denied posting -- only quoted text.") nil))))))) +(defun message--rotate-fixnum-left (n) + "Rotate the fixnum N left by one bit in a fixnum word. +The result is a fixnum." + (logior (if (natnump n) 0 1) + (ash (cond ((< (ash most-positive-fixnum -1) n) + (logior n most-negative-fixnum)) + ((< n (ash most-negative-fixnum -1)) + (logand n most-positive-fixnum)) + (n)) + 1))) + (defun message-checksum () "Return a \"checksum\" for the current buffer." (let ((sum 0)) @@ -5409,7 +5419,7 @@ Otherwise, generate and save a value for `canlock-password' first." (concat "^" (regexp-quote mail-header-separator) "$")) (while (not (eobp)) (when (not (looking-at "[ \t\n]")) - (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1) + (setq sum (logxor (message--rotate-fixnum-left sum) (char-after)))) (forward-char 1))) sum)) @@ -5531,7 +5541,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." (let* ((cur (decode-time)) (nday (+ days (nth 3 cur)))) (setf (nth 3 cur) nday) - (message-make-date (apply 'encode-time cur)))) + (message-make-date (encode-time cur)))) (defun message-make-message-id () "Make a unique Message-ID." @@ -5721,7 +5731,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." (insert fullname) (goto-char (point-min)) ;; Look for a character that cannot appear unquoted - ;; according to RFC 822. + ;; according to RFC 822 (or later). (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) ;; Quote fullname, escaping specials. (goto-char (point-min)) @@ -5735,8 +5745,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." (let ((fullname-start (point))) (insert fullname) (goto-char fullname-start) - ;; RFC 822 says \ and nonmatching parentheses - ;; must be escaped in comments. + ;; \ and nonmatching parentheses must be escaped in comments. ;; Escape every instance of ()\ ... (while (re-search-forward "[()\\]" nil 1) (replace-match "\\\\\\&" t)) @@ -8015,18 +8024,11 @@ regular text mode tabbing command." (skip-chars-backward "^, \t\n") (point)))) (completion-ignore-case t) (e (progn (skip-chars-forward "^,\t\n ") (point))) - group collection) - (when (and (boundp 'gnus-active-hashtb) - gnus-active-hashtb) - (mapatoms - (lambda (symbol) - (setq group (symbol-name symbol)) - (push (if (string-match "[^\000-\177]" group) - (gnus-group-decoded-name group) - group) - collection)) - gnus-active-hashtb)) - (completion-in-region b e collection))) + (collection (when (and (boundp 'gnus-active-hashtb) + gnus-active-hashtb) + (hash-table-keys gnus-active-hashtb)))) + (when collection + (completion-in-region b e collection)))) (defun message-expand-name () (cond ((and (memq 'eudc message-expand-name-databases) @@ -8051,7 +8053,7 @@ regular text mode tabbing command." If SHOW is non-nil, the arguments TEXT... are displayed in a temp buffer. The following arguments may contain lists of values." (if (and show - (setq text (message-flatten-list text))) + (setq text (flatten-tree text))) (save-window-excursion (with-output-to-temp-buffer " *MESSAGE information message*" (with-current-buffer " *MESSAGE information message*" @@ -8061,15 +8063,7 @@ The following arguments may contain lists of values." (funcall ask question)) (funcall ask question))) -(defun message-flatten-list (list) - "Return a new, flat list that contains all elements of LIST. - -\(message-flatten-list \\='(1 (2 3 (4 5 (6))) 7)) -=> (1 2 3 4 5 6 7)" - (cond ((consp list) - (apply 'append (mapcar 'message-flatten-list list))) - (list - (list list)))) +(define-obsolete-function-alias 'message-flatten-list #'flatten-tree "27.1") (defun message-generate-new-buffer-clone-locals (name &optional varstr) "Create and return a buffer with name based on NAME using `generate-new-buffer'. diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el index 6c6361a1083..7e2a91401bb 100644 --- a/lisp/gnus/mm-archive.el +++ b/lisp/gnus/mm-archive.el @@ -1,6 +1,6 @@ ;;; mm-archive.el --- Functions for parsing archive files as MIME -;; Copyright (C) 2012-2018 Free Software Foundation, Inc. +;; Copyright (C) 2012-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; This file is part of GNU Emacs. diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index e292dac16fe..e1e1a12cc59 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -1,6 +1,6 @@ ;;; mm-bodies.el --- Functions for decoding MIME things -;; Copyright (C) 1998-2018 Free Software Foundation, Inc. +;; Copyright (C) 1998-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> @@ -35,7 +35,7 @@ ;; BS, vertical TAB, form feed, and ^_ ;; ;; Note that CR is *not* included, as that would allow a non-paired CR -;; in the body contrary to RFC 2822: +;; in the body contrary to RFC 822 (or later): ;; ;; - CR and LF MUST only occur together as CRLF; they MUST NOT ;; appear independently in the body. diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 3e6883b2a4b..3f255419e7e 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -1,6 +1,6 @@ ;;; mm-decode.el --- Functions for decoding MIME things -*- lexical-binding:t -*- -;; Copyright (C) 1998-2018 Free Software Foundation, Inc. +;; Copyright (C) 1998-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> @@ -190,45 +190,45 @@ before the external MIME handler is invoked." :group 'mime-display) (defcustom mm-inline-media-tests - '(("image/p?jpeg" + `(("image/p?jpeg" mm-inline-image - (lambda (handle) + ,(lambda (handle) (mm-valid-and-fit-image-p 'jpeg handle))) ("image/png" mm-inline-image - (lambda (handle) + ,(lambda (handle) (mm-valid-and-fit-image-p 'png handle))) ("image/gif" mm-inline-image - (lambda (handle) + ,(lambda (handle) (mm-valid-and-fit-image-p 'gif handle))) ("image/tiff" mm-inline-image - (lambda (handle) + ,(lambda (handle) (mm-valid-and-fit-image-p 'tiff handle))) ("image/xbm" mm-inline-image - (lambda (handle) + ,(lambda (handle) (mm-valid-and-fit-image-p 'xbm handle))) ("image/x-xbitmap" mm-inline-image - (lambda (handle) + ,(lambda (handle) (mm-valid-and-fit-image-p 'xbm handle))) ("image/xpm" mm-inline-image - (lambda (handle) + ,(lambda (handle) (mm-valid-and-fit-image-p 'xpm handle))) ("image/x-xpixmap" mm-inline-image - (lambda (handle) + ,(lambda (handle) (mm-valid-and-fit-image-p 'xpm handle))) ("image/bmp" mm-inline-image - (lambda (handle) + ,(lambda (handle) (mm-valid-and-fit-image-p 'bmp handle))) ("image/x-portable-bitmap" mm-inline-image - (lambda (handle) + ,(lambda (handle) (mm-valid-and-fit-image-p 'pbm handle))) ("text/plain" mm-inline-text identity) ("text/enriched" mm-inline-text identity) @@ -246,13 +246,14 @@ before the external MIME handler is invoked." ("text/x-org" mm-display-org-inline identity) ("text/html" mm-inline-text-html - (lambda (handle) + ,(lambda (_handle) mm-text-html-renderer)) ("text/x-vcard" mm-inline-text-vcard - (lambda (handle) + ,(lambda (_handle) (or (featurep 'vcard) (locate-library "vcard")))) + ("text/calendar" gnus-icalendar-mm-inline identity) ("message/delivery-status" mm-inline-text identity) ("message/rfc822" mm-inline-message identity) ("message/partial" mm-inline-partial identity) @@ -261,13 +262,13 @@ before the external MIME handler is invoked." ("application/x-.?tar\\(-.*\\)?" mm-archive-dissect-and-inline identity) ("application/zip" mm-archive-dissect-and-inline identity) ("audio/wav" mm-inline-audio - (lambda (handle) - (and (or (featurep 'nas-sound) (featurep 'native-sound)) + ,(lambda (_handle) + (and (fboundp 'device-sound-enabled-p) (device-sound-enabled-p)))) ("audio/au" mm-inline-audio - (lambda (handle) - (and (or (featurep 'nas-sound) (featurep 'native-sound)) + ,(lambda (_handle) + (and (fboundp 'device-sound-enabled-p) (device-sound-enabled-p)))) ("application/pgp-signature" ignore identity) ("application/x-pkcs7-signature" ignore identity) @@ -279,7 +280,7 @@ before the external MIME handler is invoked." ("multipart/related" ignore identity) ("image/.*" mm-inline-image - (lambda (handle) + ,(lambda (handle) (and (mm-valid-image-format-p 'imagemagick) (mm-with-unibyte-buffer (mm-insert-part handle) @@ -331,6 +332,7 @@ a list of regexps." (defcustom mm-automatic-display '("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-verbatim" + "text/calendar" "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*" "message/rfc822" "text/x-patch" "text/dns" "application/pgp-signature" "application/emacs-lisp" "application/x-emacs-lisp" @@ -763,7 +765,7 @@ MIME-Version header before proceeding." (mb enable-multibyte-characters) beg) (goto-char (point-min)) - (search-forward-regexp "^\n" nil t) + (search-forward-regexp "^\n" nil 'move) ;; There might be no body. (setq beg (point)) (with-current-buffer (generate-new-buffer " *mm*") @@ -890,6 +892,7 @@ external if displayed external." (when method (message "Viewing with %s" method)) (let ((mm (current-buffer)) + (attachment-filename (mm-handle-filename handle)) (non-viewer (assq 'non-viewer (mailcap-mime-info (mm-handle-media-type handle) t)))) @@ -899,6 +902,9 @@ external if displayed external." (when (and (boundp 'gnus-summary-buffer) (bufferp gnus-summary-buffer) (buffer-name gnus-summary-buffer)) + (when attachment-filename + (with-current-buffer mm + (rename-buffer (format "*mm* %s" attachment-filename) t))) ;; So that we pop back to the right place, sort of. (switch-to-buffer gnus-summary-buffer) (switch-to-buffer mm)) diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el index 361e85fbe1f..7d1040961fd 100644 --- a/lisp/gnus/mm-encode.el +++ b/lisp/gnus/mm-encode.el @@ -1,6 +1,6 @@ ;;; mm-encode.el --- Functions for encoding MIME things -;; Copyright (C) 1998-2018 Free Software Foundation, Inc. +;; Copyright (C) 1998-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el index fbae669ce94..c3054432d51 100644 --- a/lisp/gnus/mm-extern.el +++ b/lisp/gnus/mm-extern.el @@ -1,6 +1,6 @@ ;;; mm-extern.el --- showing message/external-body -*- lexical-binding:t -*- -;; Copyright (C) 2000-2018 Free Software Foundation, Inc. +;; Copyright (C) 2000-2019 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> ;; Keywords: message external-body diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el index 51dc8b89e3a..c68ab4a7c13 100644 --- a/lisp/gnus/mm-partial.el +++ b/lisp/gnus/mm-partial.el @@ -1,6 +1,6 @@ ;;; mm-partial.el --- showing message/partial -;; Copyright (C) 2000-2018 Free Software Foundation, Inc. +;; Copyright (C) 2000-2019 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> ;; Keywords: message partial diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index 1008c60a173..b53a1bcd303 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -1,6 +1,6 @@ ;;; mm-url.el --- a wrapper of url functions/commands for Gnus -;; Copyright (C) 2001-2018 Free Software Foundation, Inc. +;; Copyright (C) 2001-2019 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index ba54b4e7074..00a8a532d27 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -1,6 +1,6 @@ ;;; mm-util.el --- Utility functions for Mule and low level things -*- lexical-binding:t -*- -;; Copyright (C) 1998-2018 Free Software Foundation, Inc. +;; Copyright (C) 1998-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index cf6d6d17ed5..a00d64015f2 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -1,6 +1,6 @@ ;;; mm-uu.el --- Return uu stuff as mm handles -;; Copyright (C) 1998-2018 Free Software Foundation, Inc. +;; Copyright (C) 1998-2019 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> ;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 15eac11fb9e..1e1d264b994 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -1,6 +1,6 @@ ;;; mm-view.el --- functions for viewing MIME objects -;; Copyright (C) 1998-2018 Free Software Foundation, Inc. +;; Copyright (C) 1998-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; This file is part of GNU Emacs. @@ -370,10 +370,12 @@ (enriched-decode (point-min) (point-max)))) (mm-handle-set-undisplayer handle - `(lambda () - (let ((inhibit-read-only t)) - (delete-region ,(copy-marker (point-min) t) - ,(point-max-marker)))))))) + (if (= (point-min) (point-max)) + #'ignore + `(lambda () + (let ((inhibit-read-only t)) + (delete-region ,(copy-marker (point-min) t) + ,(point-max-marker))))))))) (defun mm-insert-inline (handle text) "Insert TEXT inline from HANDLE." @@ -474,28 +476,32 @@ If MODE is not set, try to find mode automatically." (mm-decode-string text charset)) (t text))) - (require 'font-lock) - ;; I find font-lock a bit too verbose. - (let ((font-lock-verbose nil) - (font-lock-support-mode nil) + (let ((font-lock-verbose nil) ; font-lock is a bit too verbose. (enable-local-variables nil)) - ;; Disable support modes, e.g., jit-lock, lazy-lock, etc. - ;; Note: XEmacs people use `font-lock-mode-hook' to run those modes. + ;; We used to set font-lock-mode-hook to nil to avoid enabling + ;; support modes, but now that we use font-lock-ensure, support modes + ;; aren't a problem any more. So we could probably get rid of this + ;; setting now, but it seems harmless and potentially still useful. (set (make-local-variable 'font-lock-mode-hook) nil) (setq buffer-file-name (mm-handle-filename handle)) (with-demoted-errors - (if mode - (save-window-excursion - (switch-to-buffer (current-buffer)) - (funcall mode)) + (if mode + (save-window-excursion + ;; According to Katsumi Yamaoka <yamaoka@jpl.org>, org-mode + ;; requires the buffer to be temporarily displayed here, but + ;; I could not reproduce this problem. Furthermore, if + ;; there's such a problem, we should fix org-mode rather than + ;; use switch-to-buffer which can have undesirable + ;; side-effects! + ;;(switch-to-buffer (current-buffer)) + (funcall mode)) (let ((auto-mode-alist (delq (rassq 'doc-view-mode-maybe auto-mode-alist) (copy-sequence auto-mode-alist)))) - (set-auto-mode))) - ;; The mode function might have already turned on font-lock. + (set-auto-mode) + (setq mode major-mode))) ;; Do not fontify if the guess mode is fundamental. - (unless (or font-lock-mode - (eq major-mode 'fundamental-mode)) + (unless (eq major-mode 'fundamental-mode) (font-lock-ensure)))) (setq text (buffer-string)) (when (eq mode 'diff-mode) @@ -505,7 +511,7 @@ If MODE is not set, try to find mode automatically." ;; Set buffer unmodified to avoid confirmation when killing the ;; buffer. (set-buffer-modified-p nil)) - (let ((b (1- (point)))) + (let ((b (- (point) (save-restriction (widen) (point-min))))) (mm-insert-inline handle text) (dolist (ov ovs) (move-overlay (nth 0 ov) (+ (nth 1 ov) b) diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index 9a64853edf6..db7489fbf1c 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -1,6 +1,6 @@ ;;; mml-sec.el --- A package with security functions for MML documents -;; Copyright (C) 2000-2018 Free Software Foundation, Inc. +;; Copyright (C) 2000-2019 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon@josefsson.org> @@ -659,6 +659,8 @@ The passphrase is read and cached." (catch 'break (dolist (uid uids nil) (if (and (stringp (epg-user-id-string uid)) + (car (mail-header-parse-address + (epg-user-id-string uid))) (equal (downcase (car (mail-header-parse-address (epg-user-id-string uid)))) (downcase (car (mail-header-parse-address diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index 9df33d09377..78fac8ac301 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -1,6 +1,6 @@ ;;; mml-smime.el --- S/MIME support for MML -;; Copyright (C) 2000-2018 Free Software Foundation, Inc. +;; Copyright (C) 2000-2019 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon@josefsson.org> ;; Keywords: Gnus, MIME, S/MIME, MML diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index e232128245a..f6d358dfc09 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1,6 +1,6 @@ ;;; mml.el --- A package for parsing and validating MML documents -;; Copyright (C) 1998-2018 Free Software Foundation, Inc. +;; Copyright (C) 1998-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; This file is part of GNU Emacs. @@ -29,6 +29,7 @@ (require 'mml-sec) (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'url)) +(eval-when-compile (require 'gnus-util)) (autoload 'message-make-message-id "message") (declare-function gnus-setup-posting-charset "gnus-msg" (group)) @@ -982,8 +983,10 @@ If HANDLES is non-nil, use it instead reparsing the buffer." (unless handles (setq handles (mm-dissect-buffer t))) (goto-char (point-min)) - (search-forward "\n\n" nil t) - (delete-region (point) (point-max)) + (if (search-forward "\n\n" nil 'move) + (delete-region (point) (point-max)) + ;; No content in the part that is the sole part of this message. + (insert (if (bolp) "\n" "\n\n"))) (if (stringp (car handles)) (mml-insert-mime handles) (mml-insert-mime handles t)) @@ -1545,7 +1548,6 @@ Should be adopted if code in `message-send-mail' is changed." (defvar mml-preview-buffer nil) -(autoload 'gnus-make-hashtable "gnus-util") (autoload 'widget-button-press "wid-edit" nil t) (declare-function widget-event-point "wid-edit" (event)) ;; If gnus-buffer-configuration is bound this is loaded. diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index b2056b2fd0d..ce282ec65fb 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -1,6 +1,6 @@ ;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML -;; Copyright (C) 1998-2018 Free Software Foundation, Inc. +;; Copyright (C) 1998-2019 Free Software Foundation, Inc. ;; Author: Sascha Lüdecke <sascha@meta-x.de>, ;; Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue) diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 403b5e1af6a..d7876a3aef0 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -1,6 +1,6 @@ ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP) -;; Copyright (C) 2000-2018 Free Software Foundation, Inc. +;; Copyright (C) 2000-2019 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> ;; Keywords: PGP MIME MML diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el index 1b2b13ebe4d..64f3a861810 100644 --- a/lisp/gnus/nnagent.el +++ b/lisp/gnus/nnagent.el @@ -1,6 +1,6 @@ ;;; nnagent.el --- offline backend for Gnus -;; Copyright (C) 1997-2018 Free Software Foundation, Inc. +;; Copyright (C) 1997-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news, mail diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el index 9f80a755713..3b316454107 100644 --- a/lisp/gnus/nnbabyl.el +++ b/lisp/gnus/nnbabyl.el @@ -1,6 +1,6 @@ ;;; nnbabyl.el --- rmail mbox access for Gnus -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> @@ -624,7 +624,7 @@ (defun nnbabyl-check-mbox () "Go through the nnbabyl mbox and make sure that no article numbers are reused." (interactive) - (let ((idents (make-vector 1000 0)) + (let ((idents (gnus-make-hashtable 1000)) id) (save-excursion (when (or (not nnbabyl-mbox-buffer) @@ -633,13 +633,13 @@ (set-buffer nnbabyl-mbox-buffer) (goto-char (point-min)) (while (re-search-forward "^X-Gnus-Newsgroup: \\([^ ]+\\) " nil t) - (if (intern-soft (setq id (match-string 1)) idents) + (if (gethash (setq id (match-string 1)) idents) (progn (delete-region (point-at-bol) (progn (forward-line 1) (point))) (nnheader-message 7 "Moving %s..." id) (nnbabyl-save-mail (nnmail-article-group 'nnbabyl-active-number))) - (intern id idents))) + (puthash id t idents))) (when (buffer-modified-p (current-buffer)) (save-buffer)) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 0b300c1a16f..c8b7eed9870 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -1,6 +1,6 @@ ;;; nndiary.el --- A diary back end for Gnus -;; Copyright (C) 1999-2018 Free Software Foundation, Inc. +;; Copyright (C) 1999-2019 Free Software Foundation, Inc. ;; Author: Didier Verna <didier@xemacs.org> ;; Maintainer: Didier Verna <didier@xemacs.org> @@ -1278,28 +1278,28 @@ all. This may very well take some time.") (push (cond ((eq (cdr reminder) 'minute) (time-subtract - (apply 'encode-time 0 (nthcdr 1 date-elts)) - (seconds-to-time (* (car reminder) 60.0)))) + (apply #'encode-time 0 (nthcdr 1 date-elts)) + (encode-time (* (car reminder) 60.0)))) ((eq (cdr reminder) 'hour) (time-subtract - (apply 'encode-time 0 0 (nthcdr 2 date-elts)) - (seconds-to-time (* (car reminder) 3600.0)))) + (apply #'encode-time 0 0 (nthcdr 2 date-elts)) + (encode-time (* (car reminder) 3600.0)))) ((eq (cdr reminder) 'day) (time-subtract - (apply 'encode-time 0 0 0 (nthcdr 3 date-elts)) - (seconds-to-time (* (car reminder) 86400.0)))) + (apply #'encode-time 0 0 0 (nthcdr 3 date-elts)) + (encode-time (* (car reminder) 86400.0)))) ((eq (cdr reminder) 'week) (time-subtract - (apply 'encode-time 0 0 0 monday (nthcdr 4 date-elts)) - (seconds-to-time (* (car reminder) 604800.0)))) + (apply #'encode-time 0 0 0 monday (nthcdr 4 date-elts)) + (encode-time (* (car reminder) 604800.0)))) ((eq (cdr reminder) 'month) (time-subtract - (apply 'encode-time 0 0 0 1 (nthcdr 4 date-elts)) - (seconds-to-time (* (car reminder) 18748800.0)))) + (apply #'encode-time 0 0 0 1 (nthcdr 4 date-elts)) + (encode-time (* (car reminder) 18748800.0)))) ((eq (cdr reminder) 'year) (time-subtract - (apply 'encode-time 0 0 0 1 1 (nthcdr 5 date-elts)) - (seconds-to-time (* (car reminder) 400861056.0))))) + (apply #'encode-time 0 0 0 1 1 (nthcdr 5 date-elts)) + (encode-time (* (car reminder) 400861056.0))))) res)) (sort res 'time-less-p))) diff --git a/lisp/gnus/nndir.el b/lisp/gnus/nndir.el index 6dc6c338082..82502dfbd19 100644 --- a/lisp/gnus/nndir.el +++ b/lisp/gnus/nndir.el @@ -1,6 +1,6 @@ ;;; nndir.el --- single directory newsgroup access for Gnus -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 76e785d2ad6..532ba11fa09 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -1,6 +1,6 @@ ;;; nndoc.el --- single file access for Gnus -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> @@ -701,7 +701,7 @@ from the document.") (defun nndoc-lanl-gov-announce-type-p () (when (let ((case-fold-search nil)) - (re-search-forward "^\\\\\\\\\n\\(Paper\\( (\\*cross-listing\\*)\\)?: [a-zA-Z-\\.]+/[0-9]+\\|arXiv:\\)" nil t)) + (re-search-forward "^\\\\\\\\\n\\(Paper\\( (\\*cross-listing\\*)\\)?: [a-zA-Z\\.-]+/[0-9]+\\|arXiv:\\)" nil t)) t)) (defun nndoc-transform-lanl-gov-announce (article) @@ -732,7 +732,7 @@ from the document.") (save-restriction (narrow-to-region (car entry) (nth 1 entry)) (goto-char (point-min)) - (when (looking-at "^\\(Paper.*: \\|arXiv:\\)\\([0-9a-zA-Z-\\./]+\\)") + (when (looking-at "^\\(Paper.*: \\|arXiv:\\)\\([0-9a-zA-Z\\./-]+\\)") (setq subject (concat " (" (match-string 2) ")")) (when (re-search-forward "^From: \\(.*\\)" nil t) (setq from (concat "<" diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index cee7c92b3f1..bc475ee2951 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -1,6 +1,6 @@ ;;; nndraft.el --- draft article access for Gnus -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index ced75c8725e..f64007aaf79 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -1,6 +1,6 @@ ;;; nneething.el --- arbitrary file access for Gnus -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> @@ -319,7 +319,7 @@ included.") "Subject: " (file-name-nondirectory file) (or extra-msg "") "\n" "Message-ID: <nneething-" (nneething-encode-file-name file) "@" (system-name) ">\n" - (if (zerop (float-time (file-attribute-modification-time atts))) "" + (if (time-equal-p 0 (file-attribute-modification-time atts)) "" (concat "Date: " (current-time-string (file-attribute-modification-time atts)) "\n")) diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 8ef6f2a0582..1c83045e45e 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -1,6 +1,6 @@ ;;; nnfolder.el --- mail folder access for Gnus -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon@josefsson.org> ;; ShengHuo Zhu <zsh@cs.rochester.edu> (adding NOV) diff --git a/lisp/gnus/nngateway.el b/lisp/gnus/nngateway.el index 8b7898c1893..92e36a2e4f9 100644 --- a/lisp/gnus/nngateway.el +++ b/lisp/gnus/nngateway.el @@ -1,6 +1,6 @@ ;;; nngateway.el --- posting news via mail gateways -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news, mail diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index ca9f804036b..090b8420842 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -1,6 +1,6 @@ ;;; nnheader.el --- header access macros for Gnus and its backends -;; Copyright (C) 1987-1990, 1993-1998, 2000-2018 Free Software +;; Copyright (C) 1987-1990, 1993-1998, 2000-2019 Free Software ;; Foundation, Inc. ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> @@ -1042,12 +1042,7 @@ See `find-file-noselect' for the arguments." ;; When changing this function, consider changing `pop3-accept-process-output' ;; as well. (defun nnheader-accept-process-output (process) - (accept-process-output - process - (truncate nnheader-read-timeout) - (truncate (* (- nnheader-read-timeout - (truncate nnheader-read-timeout)) - 1000)))) + (accept-process-output process nnheader-read-timeout)) (defun nnheader-update-marks-actions (backend-marks actions) (dolist (action actions) @@ -1080,7 +1075,7 @@ See `find-file-noselect' for the arguments." (defvar nnheader-last-message-time '(0 0)) (defun nnheader-message-maybe (&rest args) (let ((now (current-time))) - (when (> (float-time (time-subtract now nnheader-last-message-time)) 1) + (when (time-less-p 1 (time-subtract now nnheader-last-message-time)) (setq nnheader-last-message-time now) (apply 'nnheader-message args)))) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 1a3b05ddb37..ac1d28644f7 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -1,6 +1,6 @@ ;;; nnimap.el --- IMAP interface for Gnus -;; Copyright (C) 2010-2018 Free Software Foundation, Inc. +;; Copyright (C) 2010-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Simon Josefsson <simon@josefsson.org> @@ -386,12 +386,12 @@ textual parts.") (with-current-buffer buffer (when (and nnimap-object (nnimap-last-command-time nnimap-object) - (> (float-time - (time-subtract - now - (nnimap-last-command-time nnimap-object))) - ;; More than five minutes since the last command. - (* 5 60))) + (time-less-p + ;; More than five minutes since the last command. + (* 5 60) + (time-subtract + now + (nnimap-last-command-time nnimap-object)))) (ignore-errors ;E.g. "buffer foo has no process". (nnimap-send-command "NOOP")))))))) @@ -413,8 +413,11 @@ textual parts.") nil stream))) +;; This is only needed for Windows XP or earlier (defun nnimap-map-port (port) - (if (equal port "imaps") + (if (and (eq system-type 'windows-nt) + (<= (car (x-server-version)) 5) + (equal port "imaps")) "993" port)) @@ -804,7 +807,7 @@ textual parts.") (insert "\n--" boundary "--\n"))) (defun nnimap-find-wanted-parts (structure) - (message-flatten-list (nnimap-find-wanted-parts-1 structure ""))) + (flatten-tree (nnimap-find-wanted-parts-1 structure ""))) (defun nnimap-find-wanted-parts-1 (structure prefix) (let ((num 1) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 62ac5048641..37a38a58d46 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -1,6 +1,6 @@ ;;; nnir.el --- Search mail with various search engines -*- lexical-binding:t -*- -;; Copyright (C) 1998-2018 Free Software Foundation, Inc. +;; Copyright (C) 1998-2019 Free Software Foundation, Inc. ;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de> ;; Swish-e and Swish++ backends by: @@ -1185,7 +1185,7 @@ returning the one at the supplied position." (defun nnir-imap-end-of-input () "Are we at the end of input?" - (skip-chars-forward "[[:blank:]]") + (skip-chars-forward "[:blank:]") (looking-at "$")) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 13c4303291c..b6dbbea74cc 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -1,6 +1,6 @@ ;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news, mail @@ -489,7 +489,7 @@ Example: (from . "from\\|sender\\|resent-from") (nato . "to\\|cc\\|resent-to\\|resent-cc") (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc") - (list . "list-id\\|list-post\\|x-mailing-list\||x-beenthere\\|x-loop")) + (list . "list-id\\|list-post\\|x-mailing-list\\|x-beenthere\\|x-loop")) "Alist of abbreviations allowed in `nnmail-split-fancy'." :group 'nnmail-split :type '(repeat (cons :format "%v" symbol regexp))) @@ -663,7 +663,7 @@ nn*-request-list should have been called before calling this function." (narrow-to-region (point) (point-at-eol)) (setq group (read buffer)) (unless (stringp group) - (setq group (symbol-name group))) + (setq group (encode-coding-string (symbol-name group) 'latin-1))) (if (and (numberp (setq max (read buffer))) (numberp (setq min (read buffer)))) (push (list group (cons min max)) @@ -1543,11 +1543,8 @@ See the documentation for the variable `nnmail-split-fancy' for details." (format "%s-active-timestamp" backend))) (error 'none)))) - (not (consp timestamp)) - (equal timestamp '(0 0)) - (> (nth 0 file-time) (nth 0 timestamp)) - (and (= (nth 0 file-time) (nth 0 timestamp)) - (> (nth 1 file-time) (nth 1 timestamp)))))) + (eq timestamp 'none) + (time-less-p timestamp file-time)))) (save-excursion (or (eq timestamp 'none) (set (intern (format "%s-active-timestamp" backend)) @@ -1885,7 +1882,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 nil days) + (time-since 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 afaf3dcfcff..9d02773d6f2 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -68,7 +68,9 @@ (require 'message) (require 'nnmail) -(eval-when-compile (require 'cl-lib)) +(eval-when-compile + (require 'cl-lib) + (require 'subr-x)) (defconst nnmaildir-version "Gnus") @@ -135,11 +137,10 @@ This variable is set by `nnmaildir-request-article'.") (defconst nnmaildir--delivery-pid (concat "P" (number-to-string (emacs-pid)))) (defvar nnmaildir--delivery-count nil) -;; An obarry containing symbols whose names are server names and whose values -;; are servers: -(defvar nnmaildir--servers (make-vector 3 0)) -;; The current server: -(defvar nnmaildir--cur-server nil) +(defvar nnmaildir--servers nil + "Alist mapping server name strings to servers.") +(defvar nnmaildir--cur-server nil + "The current server.") ;; A copy of nnmail-extra-headers (defvar nnmaildir--extra nil) @@ -172,17 +173,17 @@ This variable is set by `nnmaildir-request-article'.") (nov nil :type vector)) ;; cached nov structure, or nil (cl-defstruct nnmaildir--grp - (name nil :type string) ;; "group.name" - (new nil :type list) ;; new/ modtime - (cur nil :type list) ;; cur/ modtime - (min 1 :type natnum) ;; minimum article number - (count 0 :type natnum) ;; count of articles - (nlist nil :type list) ;; list of articles, ordered descending by number - (flist nil :type vector) ;; obarray mapping filename prefix->article - (mlist nil :type vector) ;; obarray mapping message-id->article - (cache nil :type vector) ;; nov cache - (index nil :type natnum) ;; index of next cache entry to replace - (mmth nil :type vector)) ;; obarray mapping mark name->dir modtime + (name nil :type string) ;; "group.name" + (new nil :type list) ;; new/ modtime + (cur nil :type list) ;; cur/ modtime + (min 1 :type natnum) ;; minimum article number + (count 0 :type natnum) ;; count of articles + (nlist nil :type list) ;; list of articles, ordered descending by number + (flist nil :type hash-table) ;; hash table mapping filename prefix->article + (mlist nil :type hash-table) ;; hash table mapping message-id->article + (cache nil :type vector) ;; nov cache + (index nil :type natnum) ;; index of next cache entry to replace + (mmth nil :type hash-table)) ;; hash table mapping mark name->dir modtime ; ("Mark Mod Time Hash") (cl-defstruct nnmaildir--srv @@ -191,7 +192,7 @@ This variable is set by `nnmaildir-request-article'.") (prefix nil :type string) ;; "nnmaildir+address:" (dir nil :type string) ;; "/expanded/path/to/server/dir/" (ls nil :type function) ;; directory-files function - (groups nil :type vector) ;; obarray mapping group name->group + (groups nil :type hash-table) ;; hash table mapping group name->group (curgrp nil :type nnmaildir--grp) ;; current group, or nil (error nil :type string) ;; last error message, or nil (mtime nil :type list) ;; modtime of dir @@ -238,17 +239,17 @@ This variable is set by `nnmaildir-request-article'.") (setf (nnmaildir--grp-count group) count) (setf (nnmaildir--grp-nlist group) new-nlist) (setcdr nlist-pre nlist-post) - (unintern prefix flist) - (unintern msgid mlist)))) + (remhash prefix flist) + (remhash msgid mlist)))) (defun nnmaildir--nlist-art (group num) (let ((entry (assq num (nnmaildir--grp-nlist group)))) (if entry (cdr entry)))) (defmacro nnmaildir--flist-art (list file) - `(symbol-value (intern-soft ,file ,list))) + `(gethash ,file ,list)) (defmacro nnmaildir--mlist-art (list msgid) - `(symbol-value (intern-soft ,msgid ,list))) + `(gethash ,msgid ,list)) (defun nnmaildir--pgname (server gname) (let ((prefix (nnmaildir--srv-prefix server))) @@ -337,12 +338,12 @@ This variable is set by `nnmaildir-request-article'.") (if (null server) (unless (setq server nnmaildir--cur-server) (throw 'return nil)) - (unless (setq server (intern-soft server nnmaildir--servers)) + (unless (setq server (alist-get server nnmaildir--servers + nil nil #'equal)) (throw 'return nil)) - (setq server (symbol-value server) - nnmaildir--cur-server server)) + (setq nnmaildir--cur-server server)) (let ((groups (nnmaildir--srv-groups server))) - (when groups + (when (and groups (null (hash-table-empty-p groups))) (unless (nnmaildir--srv-method server) (setf (nnmaildir--srv-method server) (or (gnus-server-to-method @@ -350,7 +351,7 @@ This variable is set by `nnmaildir-request-article'.") (throw 'return nil)))) (if (null group) (nnmaildir--srv-curgrp server) - (symbol-value (intern-soft group groups))))))) + (gethash group groups)))))) (defun nnmaildir--tab-to-space (string) (let ((pos 0)) @@ -574,15 +575,15 @@ This variable is set by `nnmaildir-request-article'.") (if insert-nlist (setcdr nlist (cons (cons num article) nlist-cdr)) (setf (nnmaildir--grp-nlist group) nlist)) - (set (intern (nnmaildir--art-prefix article) - (nnmaildir--grp-flist group)) - article) - (set (intern (nnmaildir--art-msgid article) - (nnmaildir--grp-mlist group)) - article) - (set (intern (nnmaildir--grp-name group) - (nnmaildir--srv-groups server)) - group)) + (puthash (nnmaildir--art-prefix article) + article + (nnmaildir--grp-flist group)) + (puthash (nnmaildir--art-msgid article) + article + (nnmaildir--grp-mlist group)) + (puthash (nnmaildir--grp-name group) + group + (nnmaildir--srv-groups server))) (nnmaildir--cache-nov group article nov) t))) @@ -650,9 +651,6 @@ This variable is set by `nnmaildir-request-article'.") (if (< (car entry) low) (throw 'iterate-loop nil)) (funcall func (cdr entry))))))) -(defun nnmaildir--up2-1 (n) - (if (zerop n) 1 (1- (ash 1 (1+ (logb n)))))) - (defun nnmaildir--system-name () (replace-regexp-in-string ":" "\\072" @@ -677,19 +675,20 @@ This variable is set by `nnmaildir-request-article'.") (nnmaildir--srv-groups nnmaildir--cur-server) t)) -(defun nnmaildir-open-server (server &optional defs) - (let ((x server) - dir size) +(defun nnmaildir-open-server (server-string &optional defs) + (let ((server (alist-get server-string nnmaildir--servers + nil nil #'equal)) + dir size x) (catch 'return - (setq server (intern-soft x nnmaildir--servers)) (if server - (and (setq server (symbol-value server)) - (nnmaildir--srv-groups server) + (and (nnmaildir--srv-groups server) (setq nnmaildir--cur-server server) (throw 'return t)) - (setq server (make-nnmaildir--srv :address x)) + (setq server (make-nnmaildir--srv :address server-string)) (let ((inhibit-quit t)) - (set (intern x nnmaildir--servers) server))) + (setf (alist-get server-string nnmaildir--servers + nil nil #'equal) + server))) (setq dir (assq 'directory defs)) (unless dir (setf (nnmaildir--srv-error server) @@ -713,8 +712,7 @@ This variable is set by `nnmaildir-request-article'.") (concat "Not a function: " (prin1-to-string x))) (throw 'return nil))) (setf (nnmaildir--srv-ls server) x) - (setq size (length (funcall x dir nil "\\`[^.]" 'nosort)) - size (nnmaildir--up2-1 size)) + (setq size (length (funcall x dir nil "\\`[^.]" 'nosort))) (and (setq x (assq 'get-new-mail defs)) (setq x (cdr x)) (car x) @@ -734,7 +732,8 @@ This variable is set by `nnmaildir-request-article'.") x (file-name-as-directory x)) (setf (nnmaildir--srv-target-prefix server) x)) (setf (nnmaildir--srv-target-prefix server) ""))) - (setf (nnmaildir--srv-groups server) (make-vector size 0)) + (setf (nnmaildir--srv-groups server) + (gnus-make-hashtable size)) (setq nnmaildir--cur-server server) t))) @@ -764,7 +763,7 @@ This variable is set by `nnmaildir-request-article'.") (defun nnmaildir--scan (gname scan-msgs groups _method srv-dir srv-ls) (catch 'return - (let ((36h-ago (- (float-time) 129600)) + (let ((36h-ago (time-since 129600)) absdir nndir tdir ndir cdir nattr cattr isnew pgname read-only ls files num dir flist group x) (setq absdir (nnmaildir--srvgrp-dir srv-dir gname) @@ -833,10 +832,10 @@ This variable is set by `nnmaildir-request-article'.") (cons (match-string 1 f) (match-string 2 f))) files))) (when isnew - (setq num (nnmaildir--up2-1 (length files))) - (setf (nnmaildir--grp-flist group) (make-vector num 0)) - (setf (nnmaildir--grp-mlist group) (make-vector num 0)) - (setf (nnmaildir--grp-mmth group) (make-vector 1 0)) + (setq num (length files)) + (setf (nnmaildir--grp-flist group) (gnus-make-hashtable num)) + (setf (nnmaildir--grp-mlist group) (gnus-make-hashtable num)) + (setf (nnmaildir--grp-mmth group) (gnus-make-hashtable 1)) (setq num (nnmaildir--param pgname 'nov-cache-size)) (if (numberp num) (if (< num 1) (setq num 1)) (setq num 16 @@ -862,7 +861,7 @@ This variable is set by `nnmaildir-request-article'.") (cl-incf num))))) (setf (nnmaildir--grp-cache group) (make-vector num nil)) (let ((inhibit-quit t)) - (set (intern gname groups) group)) + (puthash gname group groups)) (or scan-msgs (throw 'return t))) (setq flist (nnmaildir--grp-flist group) files (mapcar @@ -901,49 +900,46 @@ This variable is set by `nnmaildir-request-article'.") groups (nnmaildir--srv-groups nnmaildir--cur-server) target-prefix (nnmaildir--srv-target-prefix nnmaildir--cur-server)) (nnmaildir--with-work-buffer - (save-match-data - (if (stringp scan-group) - (if (nnmaildir--scan scan-group t groups method srv-dir srv-ls) - (if (nnmaildir--srv-gnm nnmaildir--cur-server) - (nnmail-get-new-mail 'nnmaildir nil nil scan-group)) - (unintern scan-group groups)) - (setq x (file-attribute-modification-time (file-attributes srv-dir)) - scan-group (null scan-group)) - (if (equal x (nnmaildir--srv-mtime nnmaildir--cur-server)) - (if scan-group - (mapatoms (lambda (sym) - (nnmaildir--scan (symbol-name sym) t groups - method srv-dir srv-ls)) - groups)) - (setq dirs (funcall srv-ls srv-dir nil "\\`[^.]" 'nosort) - dirs (if (zerop (length target-prefix)) - dirs - (seq-remove - (lambda (dir) - (and (>= (length dir) (length target-prefix)) - (string= (substring dir 0 - (length target-prefix)) - target-prefix))) - dirs)) - seen (nnmaildir--up2-1 (length dirs)) - seen (make-vector seen 0)) - (dolist (grp-dir dirs) - (if (nnmaildir--scan grp-dir scan-group groups method srv-dir - srv-ls) - (intern grp-dir seen))) - (setq x nil) - (mapatoms (lambda (group) - (setq group (symbol-name group)) - (unless (intern-soft group seen) - (setq x (cons group x)))) - groups) - (dolist (grp x) - (unintern grp groups)) - (setf (nnmaildir--srv-mtime nnmaildir--cur-server) - (file-attribute-modification-time (file-attributes srv-dir)))) - (and scan-group - (nnmaildir--srv-gnm nnmaildir--cur-server) - (nnmail-get-new-mail 'nnmaildir nil nil)))))) + (save-match-data + (if (stringp scan-group) + (if (nnmaildir--scan scan-group t groups method srv-dir srv-ls) + (when (nnmaildir--srv-gnm nnmaildir--cur-server) + (nnmail-get-new-mail 'nnmaildir nil nil scan-group)) + (remhash scan-group groups)) + (setq x (file-attribute-modification-time (file-attributes srv-dir)) + scan-group (null scan-group)) + (if (equal x (nnmaildir--srv-mtime nnmaildir--cur-server)) + (when scan-group + (maphash (lambda (group-name _group) + (nnmaildir--scan group-name t groups + method srv-dir srv-ls)) + groups)) + (setq dirs (funcall srv-ls srv-dir nil "\\`[^.]" 'nosort) + dirs (if (zerop (length target-prefix)) + dirs + (seq-remove + (lambda (dir) + (and (>= (length dir) (length target-prefix)) + (string= (substring dir 0 + (length target-prefix)) + target-prefix))) + dirs))) + (dolist (grp-dir dirs) + (when (nnmaildir--scan grp-dir scan-group groups + method srv-dir srv-ls) + (push grp-dir seen))) + (setq x nil) + (maphash (lambda (gname _group) + (unless (member gname seen) + (push gname x))) + groups) + (dolist (grp x) + (remhash grp groups)) + (setf (nnmaildir--srv-mtime nnmaildir--cur-server) + (file-attribute-modification-time (file-attributes srv-dir)))) + (and scan-group + (nnmaildir--srv-gnm nnmaildir--cur-server) + (nnmail-get-new-mail 'nnmaildir nil nil)))))) t) (defun nnmaildir-request-list (&optional server) @@ -952,10 +948,9 @@ This variable is set by `nnmaildir-request-article'.") (nnmaildir--prepare server nil) (nnmaildir--with-nntp-buffer (erase-buffer) - (mapatoms (lambda (group) - (setq pgname (symbol-name group) - pgname (nnmaildir--pgname nnmaildir--cur-server pgname) - group (symbol-value group) + (maphash (lambda (gname group) + (setq pgname (nnmaildir--pgname nnmaildir--cur-server gname) + ro (nnmaildir--param pgname 'read-only)) (insert (replace-regexp-in-string " " "\\ " @@ -1035,8 +1030,7 @@ This variable is set by `nnmaildir-request-article'.") (append (mapcar 'cdr nnmaildir-flag-mark-mapping) (mapcar 'intern (funcall ls dir nil "\\`[^.]" 'nosort)))) - new-mmth (nnmaildir--up2-1 (length all-marks)) - new-mmth (make-vector new-mmth 0) + new-mmth (make-hash-table :size (length all-marks)) old-mmth (nnmaildir--grp-mmth group)) (dolist (mark all-marks) (setq markdir (nnmaildir--subdir dir (symbol-name mark)) @@ -1063,8 +1057,8 @@ This variable is set by `nnmaildir-request-article'.") curdir-mtime) (t markdir-mtime)))) - (set (intern (symbol-name mark) new-mmth) mtime) - (when (equal mtime (symbol-value (intern-soft (symbol-name mark) old-mmth))) + (puthash mark mtime new-mmth) + (when (equal mtime (gethash mark old-mmth)) (setq ranges (assq mark old-marks)) (if ranges (setq ranges (cdr ranges))) (throw 'got-ranges nil)) @@ -1126,7 +1120,7 @@ This variable is set by `nnmaildir-request-article'.") (nnmaildir--prepare server nil) (catch 'return (let ((target-prefix (nnmaildir--srv-target-prefix nnmaildir--cur-server)) - srv-dir dir groups) + srv-dir dir) (when (zerop (length gname)) (setf (nnmaildir--srv-error nnmaildir--cur-server) "Invalid (empty) group name") @@ -1140,8 +1134,8 @@ This variable is set by `nnmaildir-request-article'.") (concat "Invalid characters (null, tab, or /) in group name: " gname)) (throw 'return nil)) - (setq groups (nnmaildir--srv-groups nnmaildir--cur-server)) - (when (intern-soft gname groups) + (when (gethash + gname (nnmaildir--srv-groups nnmaildir--cur-server)) (setf (nnmaildir--srv-error nnmaildir--cur-server) (concat "Group already exists: " gname)) (throw 'return nil)) @@ -1186,7 +1180,7 @@ This variable is set by `nnmaildir-request-article'.") new-name)) (throw 'return nil)) (if (string-equal gname new-name) (throw 'return t)) - (when (intern-soft new-name + (when (gethash new-name (nnmaildir--srv-groups nnmaildir--cur-server)) (setf (nnmaildir--srv-error nnmaildir--cur-server) (concat "Group already exists: " new-name)) @@ -1199,16 +1193,18 @@ This variable is set by `nnmaildir-request-article'.") (setf (nnmaildir--srv-error nnmaildir--cur-server) (concat "Error renaming link: " (prin1-to-string err))) (throw 'return nil))) + ;; FIXME: Why are we making copies of the group and the groups + ;; hashtable? Why not just set the group's new name, and puthash the + ;; group under that new name? (setq x (nnmaildir--srv-groups nnmaildir--cur-server) - groups (make-vector (length x) 0)) - (mapatoms (lambda (sym) - (unless (eq (symbol-value sym) group) - (set (intern (symbol-name sym) groups) - (symbol-value sym)))) + groups (gnus-make-hashtable (hash-table-size x))) + (maphash (lambda (gname g) + (unless (eq g group) + (puthash gname g groups))) x) (setq group (copy-sequence group)) (setf (nnmaildir--grp-name group) new-name) - (set (intern new-name groups) group) + (puthash new-name group groups) (setf (nnmaildir--srv-groups nnmaildir--cur-server) groups) t))) @@ -1231,7 +1227,7 @@ This variable is set by `nnmaildir-request-article'.") (throw 'return nil)) (if (eq group (nnmaildir--srv-curgrp nnmaildir--cur-server)) (setf (nnmaildir--srv-curgrp nnmaildir--cur-server) nil)) - (unintern gname (nnmaildir--srv-groups nnmaildir--cur-server)) + (remhash gname (nnmaildir--srv-groups nnmaildir--cur-server)) (if (not force) (progn (setq grp-dir (directory-file-name grp-dir)) @@ -1332,10 +1328,9 @@ This variable is set by `nnmaildir-request-article'.") article (nnmaildir--mlist-art list num-msgid)) (if article (setq num-msgid (nnmaildir--art-num article)) (catch 'found - (mapatoms - (lambda (group-sym) - (setq group (symbol-value group-sym) - list (nnmaildir--grp-mlist group) + (maphash + (lambda (_gname group) + (setq list (nnmaildir--grp-mlist group) article (nnmaildir--mlist-art list num-msgid)) (when article (setq num-msgid (nnmaildir--art-num article)) @@ -1467,7 +1462,7 @@ This variable is set by `nnmaildir-request-article'.") (unless (string-equal nnmaildir--delivery-time file) (setq nnmaildir--delivery-time file nnmaildir--delivery-count 0)) - (setq file (concat file "M" (number-to-string (caddr time)))) + (setq file (concat file (format-time-string "M%6N" time))) (setq file (concat file nnmaildir--delivery-pid) file (concat file "Q" (number-to-string nnmaildir--delivery-count)) file (concat file "." (nnmaildir--system-name)) @@ -1522,7 +1517,7 @@ This variable is set by `nnmaildir-request-article'.") (setq groups (nnmaildir--srv-groups nnmaildir--cur-server) ga (car group-art) group-art (cdr group-art) gname (car ga)) - (or (intern-soft gname groups) + (or (gethash gname groups) (nnmaildir-request-create-group gname) (throw 'return nil)) ;; not that nnmail bothers to check :( (unless (nnmaildir-request-accept-article gname) @@ -1539,7 +1534,7 @@ This variable is set by `nnmaildir-request-article'.") (mapcar (lambda (ga) (setq gname (car ga)) - (and (or (intern-soft gname groups) + (and (or (gethash gname groups) (nnmaildir-request-create-group gname)) (nnmaildir-request-accept-article gname) ga)) @@ -1553,7 +1548,7 @@ This variable is set by `nnmaildir-request-article'.") (defun nnmaildir-request-expire-articles (ranges &optional gname server force) (let ((no-force (not force)) (group (nnmaildir--prepare server gname)) - pgname time boundary bound-iter high low target dir nlist + pgname time boundary high low target dir nlist didnt nnmaildir--file nnmaildir-article-file-name deactivate-mark) (catch 'return @@ -1577,14 +1572,7 @@ This variable is set by `nnmaildir-request-article'.") (when no-force (unless (integerp time) ;; handle 'never (throw 'return (gnus-uncompress-range ranges))) - (setq boundary (current-time) - high (- (car boundary) (/ time 65536)) - low (- (cadr boundary) (% time 65536))) - (if (< low 0) - (setq low (+ low 65536) - high (1- high))) - (setcar (cdr boundary) low) - (setcar boundary high)) + (setq boundary (time-since time))) (setq dir (nnmaildir--srv-dir nnmaildir--cur-server) dir (nnmaildir--srvgrp-dir dir gname) dir (nnmaildir--cur dir) @@ -1602,15 +1590,8 @@ This variable is set by `nnmaildir-request-article'.") ((null time) (nnmaildir--expired-article group article)) ((and no-force - (progn - (setq time (file-attribute-modification-time time) - bound-iter boundary) - (while (and bound-iter time - (= (car bound-iter) (car time))) - (setq bound-iter (cdr bound-iter) - time (cdr time))) - (and bound-iter time - (car-less-than-car bound-iter time)))) + (time-less-p boundary + (file-attribute-modification-time time))) (setq didnt (cons (nnmaildir--art-num article) didnt))) (t (setq nnmaildir-article-file-name nnmaildir--file @@ -1763,36 +1744,38 @@ This variable is set by `nnmaildir-request-article'.") (lambda (dir) (cons dir (funcall ls dir nil "\\`[^.]" 'nosort))) dirs) - files (funcall ls msgdir nil "\\`[^.]" 'nosort) - flist (nnmaildir--up2-1 (length files)) - flist (make-vector flist 0)) + files (funcall ls msgdir nil "\\`[^.]" 'nosort)) (save-match-data (dolist (file files) (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file) - (intern (match-string 1 file) flist))) + (push (match-string 1 file) flist))) (dolist (dir dirs) (setq files (cdr dir) dir (file-name-as-directory (car dir))) (dolist (file files) - (unless (or (intern-soft file flist) (string= file ":")) + (unless (or (member file flist) (string= file ":")) (setq file (concat dir file)) (delete-file file)))) t))) (defun nnmaildir-close-server (&optional server) - (nnmaildir--prepare server nil) - (when nnmaildir--cur-server + "Close SERVER, or the current maildir server." + (when (nnmaildir--prepare server nil) (setq server nnmaildir--cur-server nnmaildir--cur-server nil) - (unintern (nnmaildir--srv-address server) nnmaildir--servers)) + + ;; This slightly obscure invocation of `alist-get' removes SERVER from + ;; `nnmaildir-servers'. + (setf (alist-get (nnmaildir--srv-address server) + nnmaildir--servers server 'remove #'equal) + server)) t) (defun nnmaildir-request-close () - (let (servers buffer) - (mapatoms (lambda (server) - (setq servers (cons (symbol-name server) servers))) - nnmaildir--servers) - (mapc 'nnmaildir-close-server servers) + (let ((servers + (mapcar #'car nnmaildir--servers)) + buffer) + (mapc #'nnmaildir-close-server servers) (setq buffer (get-buffer " *nnmaildir work*")) (if buffer (kill-buffer buffer)) (setq buffer (get-buffer " *nnmaildir nov*")) diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index c8cf2d64d2d..501ea1d3903 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -1,6 +1,6 @@ ;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader -;; Copyright (C) 2007-2018 Free Software Foundation, Inc. +;; Copyright (C) 2007-2019 Free Software Foundation, Inc. ;; Author: David Engster <dengste@eml.cc> ;; Keywords: mail searching diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el index 05342dae001..bba41336dd9 100644 --- a/lisp/gnus/nnmbox.el +++ b/lisp/gnus/nnmbox.el @@ -1,6 +1,6 @@ ;;; nnmbox.el --- mail mbox access for Gnus -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index d0f8ec256e7..f4b36dc007f 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -1,6 +1,6 @@ ;;; nnmh.el --- mhspool access for Gnus -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index e7a5b99835f..205e9e48034 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -1,6 +1,6 @@ ;;; nnml.el --- mail spool access for Gnus -;; Copyright (C) 1995-2018 Free Software Foundation, Inc. +;; Copyright (C) 1995-2019 Free Software Foundation, Inc. ;; Authors: Didier Verna <didier@xemacs.org> (adding compaction) ;; Simon Josefsson <simon@josefsson.org> @@ -259,7 +259,7 @@ non-nil.") (t (nnheader-re-read-dir nnml-current-directory) (nnmail-activate 'nnml) - (let ((active (nth 1 (assoc group nnml-group-alist)))) + (let ((active (nth 1 (assoc-string group nnml-group-alist)))) (if (not active) (nnheader-report 'nnml "No such group: %s" decoded) (nnheader-report 'nnml "Selected group %s" decoded) @@ -295,7 +295,7 @@ non-nil.") (nnheader-report 'nnml "%s is a file" (directory-file-name (nnml-group-pathname group nil server)))) - ((assoc group nnml-group-alist) + ((assoc-string group nnml-group-alist) t) (t (let (active) @@ -379,7 +379,7 @@ non-nil.") (nnml-nov-delete-article group number)) (push number rest))) (push number rest))) - (let ((active (nth 1 (assoc group nnml-group-alist)))) + (let ((active (nth 1 (assoc-string group nnml-group-alist)))) (when active (setcar active (or (and active-articles (apply 'min active-articles)) @@ -520,7 +520,7 @@ non-nil.") (nnheader-report 'nnml "No such directory: %s/" file)) ;; Remove the group from all structures. (setq nnml-group-alist - (delq (assoc group nnml-group-alist) nnml-group-alist) + (delq (assoc-string group nnml-group-alist) nnml-group-alist) nnml-current-group nil nnml-current-directory nil) ;; Save the active file. @@ -549,7 +549,7 @@ non-nil.") (when (<= (length (directory-files old-dir)) 2) (ignore-errors (delete-directory old-dir))) ;; That went ok, so we change the internal structures. - (let ((entry (assoc group nnml-group-alist))) + (let ((entry (assoc-string group nnml-group-alist))) (when entry (setcar entry new-name)) (setq nnml-current-directory nil @@ -597,7 +597,7 @@ non-nil.") (when (setq path (nnml-article-to-file article)) (when (file-writable-p path) (or (not nnmail-keep-last-article) - (not (eq (cdr (nth 1 (assoc group nnml-group-alist))) + (not (eq (cdr (nth 1 (assoc-string group nnml-group-alist))) article))))))) ;; Find an article number in the current group given the Message-ID. @@ -742,7 +742,7 @@ article number. This function is called narrowed to an article." "Compute the next article number in GROUP on SERVER." (let* ((encoded (if nnmail-group-names-not-encoded-p (nnml-encoded-group-name group server))) - (active (cadr (assoc (or encoded group) nnml-group-alist)))) + (active (cadr (assoc-string (or encoded group) nnml-group-alist)))) ;; The group wasn't known to nnml, so we just create an active ;; entry for it. (unless active @@ -783,7 +783,7 @@ article number. This function is called narrowed to an article." (cdr nnml-incremental-nov-buffer-alist))))) (defun nnml-open-incremental-nov (group) - (or (cdr (assoc group nnml-incremental-nov-buffer-alist)) + (or (cdr (assoc-string group nnml-incremental-nov-buffer-alist)) (let ((buffer (nnml-get-nov-buffer group t))) (push (cons group buffer) nnml-incremental-nov-buffer-alist) buffer))) diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el index 1e69af65a3b..0cf2362b36a 100644 --- a/lisp/gnus/nnoo.el +++ b/lisp/gnus/nnoo.el @@ -1,6 +1,6 @@ ;;; nnoo.el --- OO Gnus Backends -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news diff --git a/lisp/gnus/nnregistry.el b/lisp/gnus/nnregistry.el index bb00caa9d7a..4bc74ce5b9a 100644 --- a/lisp/gnus/nnregistry.el +++ b/lisp/gnus/nnregistry.el @@ -1,7 +1,7 @@ ;;; nnregistry.el --- access to articles via Gnus' message-id registry ;;; -*- coding: utf-8 -*- -;; Copyright (C) 2010-2018 Free Software Foundation, Inc. +;; Copyright (C) 2010-2019 Free Software Foundation, Inc. ;; Authors: Ludovic Courtès <ludo@gnu.org> ;; Keywords: news, mail diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index f80e2c51078..0bfecb28e09 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -1,6 +1,6 @@ ;;; nnrss.el --- interfacing with RSS -;; Copyright (C) 2001-2018 Free Software Foundation, Inc. +;; Copyright (C) 2001-2019 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> ;; Keywords: RSS @@ -340,10 +340,10 @@ for decoding when the cdr that the data specify is not available.") (let (elem) ;; There may be two or more entries in `nnrss-group-alist' since ;; this function didn't delete them formerly. - (while (setq elem (assoc group nnrss-group-alist)) + (while (setq elem (assoc-string group nnrss-group-alist)) (setq nnrss-group-alist (delq elem nnrss-group-alist)))) (setq nnrss-server-data - (delq (assoc group nnrss-server-data) nnrss-server-data)) + (delq (assoc-string group nnrss-server-data) nnrss-server-data)) (nnrss-save-server-data server) (ignore-errors (let ((file-name-coding-system nnmail-pathname-coding-system)) @@ -367,7 +367,7 @@ for decoding when the cdr that the data specify is not available.") (with-current-buffer nntp-server-buffer (erase-buffer) (dolist (group groups) - (let ((elem (assoc (gnus-group-decoded-name group) nnrss-server-data))) + (let ((elem (assoc-string (gnus-group-decoded-name group) nnrss-server-data))) (insert (format "%S %s 1 y\n" group (or (cadr elem) 0))))) 'active)) @@ -446,16 +446,16 @@ nnrss: %s: Not valid XML %s and libxml-parse-html-region doesn't work %s" (autoload 'timezone-parse-date "timezone") (defun nnrss-normalize-date (date) - "Return a date string of DATE in the RFC822 style. + "Return a date string of DATE in the style of RFC 822 and its successors. This function handles the ISO 8601 date format described in -URL `http://www.w3.org/TR/NOTE-datetime', and also the RFC822 style +URL `http://www.w3.org/TR/NOTE-datetime', and also the RFC 822 style which RSS 2.0 allows." (let (case-fold-search vector year month day time zone cts given) (cond ((null date)) ; do nothing for this case ;; if the date is just digits (unix time stamp): ((string-match "^[0-9]+$" date) - (setq given (seconds-to-time (string-to-number date)))) - ;; RFC822 + (setq given (encode-time (string-to-number date)))) + ;; RFC 822 ((string-match " [0-9]+ " date) (setq vector (timezone-parse-date date) year (string-to-number (aref vector 0))) @@ -539,7 +539,7 @@ which RSS 2.0 allows." (if (hash-table-p nnrss-group-hashtb) (clrhash nnrss-group-hashtb) (setq nnrss-group-hashtb (make-hash-table :test 'equal))) - (let ((pair (assoc group nnrss-server-data))) + (let ((pair (assoc-string group nnrss-server-data))) (setq nnrss-group-max (or (cadr pair) 0)) (setq nnrss-group-min (+ nnrss-group-max 1))) (let ((file (nnrss-make-filename group server)) @@ -644,8 +644,8 @@ which RSS 2.0 allows." (concat group ".xml")) nnrss-directory)))) (setq xml (nnrss-fetch file t)) - (setq url (or (nth 2 (assoc group nnrss-server-data)) - (cadr (assoc group nnrss-group-alist)))) + (setq url (or (nth 2 (assoc-string group nnrss-server-data)) + (cadr (assoc-string group nnrss-group-alist)))) (unless url (setq url (cdr @@ -653,7 +653,7 @@ which RSS 2.0 allows." (nnrss-discover-feed (read-string (format "URL to search for %s: " group) "http://"))))) - (let ((pair (assoc group nnrss-server-data))) + (let ((pair (assoc-string group nnrss-server-data))) (if pair (setcdr (cdr pair) (list url)) (push (list group nnrss-group-max url) nnrss-server-data))) @@ -721,7 +721,7 @@ which RSS 2.0 allows." (setq extra nil)) (when changed (nnrss-save-group-data group server) - (let ((pair (assoc group nnrss-server-data))) + (let ((pair (assoc-string group nnrss-server-data))) (if pair (setcar (cdr pair) nnrss-group-max) (push (list group nnrss-group-max) nnrss-server-data))) @@ -792,7 +792,7 @@ It is useful when `(setq nnrss-use-local t)'." (insert "RSSDIR='" (expand-file-name nnrss-directory) "'\n") (dolist (elem nnrss-server-data) (let ((url (or (nth 2 elem) - (cadr (assoc (car elem) nnrss-group-alist))))) + (cadr (assoc-string (car elem) nnrss-group-alist))))) (insert "$WGET -q -O \"$RSSDIR\"/'" (nnrss-translate-file-chars (concat (car elem) ".xml")) "' '" url "'\n")))) diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el index 2f16b653924..767631c6859 100644 --- a/lisp/gnus/nnspool.el +++ b/lisp/gnus/nnspool.el @@ -1,6 +1,6 @@ ;;; nnspool.el --- spool access for GNU Emacs -;; Copyright (C) 1988-1990, 1993-1998, 2000-2018 Free Software +;; Copyright (C) 1988-1990, 1993-1998, 2000-2019 Free Software ;; Foundation, Inc. ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> @@ -305,25 +305,18 @@ there.") (while (and (not (looking-at "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] ")) (zerop (forward-line -1)))) - ;; We require nnheader which requires gnus-util. - (let ((seconds (float-time (date-to-time date))) + (let ((seconds (encode-time (date-to-time date) 'integer)) groups) ;; Go through lines and add the latest groups to a list. (while (and (looking-at "\\([^ ]+\\) +[0-9]+ ") (progn - ;; We insert a .0 to make the list reader - ;; interpret the number as a float. It is far - ;; too big to be stored in a lisp integer. - (goto-char (1- (match-end 0))) - (insert ".0") - (> (progn - (goto-char (match-end 1)) - (read (current-buffer))) - seconds)) - (push (buffer-substring - (match-beginning 1) (match-end 1)) - groups) - (zerop (forward-line -1)))) + (goto-char (match-end 1)) + (< seconds (read (current-buffer)))) + (progn + (push (buffer-substring + (match-beginning 1) (match-end 1)) + groups) + (zerop (forward-line -1))))) (erase-buffer) (dolist (group groups) (insert group " 0 0 y\n"))) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index be9e4955105..e2fa1d85a36 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -1,6 +1,6 @@ ;;; nntp.el --- nntp access for Gnus -;; Copyright (C) 1987-1990, 1992-1998, 2000-2018 Free Software +;; Copyright (C) 1987-1990, 1992-1998, 2000-2019 Free Software ;; Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index 777c5c1bbe0..c80bbf61875 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -1,6 +1,6 @@ ;;; nnvirtual.el --- virtual newsgroups access for Gnus -;; Copyright (C) 1994-2018 Free Software Foundation, Inc. +;; Copyright (C) 1994-2019 Free Software Foundation, Inc. ;; Author: David Moore <dmoore@ucsd.edu> ;; Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -234,14 +234,12 @@ component group will show up when you enter the virtual group.") nnvirtual-mapping-marks nil nnvirtual-info-installed nil) (when nnvirtual-component-regexp - ;; Go through the newsrc alist and find all component groups. - (let ((newsrc (cdr gnus-newsrc-alist)) - group) - (while (setq group (car (pop newsrc))) - (when (string-match nnvirtual-component-regexp group) ; Match - ;; Add this group to the list of component groups. - (setq nnvirtual-component-groups - (cons group (delete group nnvirtual-component-groups))))))) + ;; Go through the list of groups and find all component groups. + (dolist (group (cdr gnus-group-list)) + (when (string-match nnvirtual-component-regexp group) ; Match + ;; Add this group to the list of component groups. + (setq nnvirtual-component-groups + (cons group (delete group nnvirtual-component-groups)))))) (if (not nnvirtual-component-groups) (nnheader-report 'nnvirtual "No component groups: %s" server) t))) @@ -372,7 +370,7 @@ component group will show up when you enter the virtual group.") (defun nnvirtual-convert-headers () "Convert HEAD headers into NOV headers." (with-current-buffer nntp-server-buffer - (let* ((dependencies (make-vector 100 0)) + (let* ((dependencies (make-hash-table :test #'equal)) (headers (gnus-get-newsgroup-headers dependencies))) (erase-buffer) (mapc 'nnheader-insert-nov headers)))) diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index a64f10f98a7..7b87502d0e0 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -1,6 +1,6 @@ ;;; nnweb.el --- retrieving articles via web search engines -;; Copyright (C) 1996-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news @@ -109,7 +109,7 @@ Valid types include `google', `dejanews', and `gmane'.") (deffoo nnweb-request-scan (&optional group server) (nnweb-possibly-change-server group server) (if nnweb-ephemeral-p - (setq nnweb-hashtb (gnus-make-hashtable 4095)) + (setq nnweb-hashtb (gnus-make-hashtable 4000)) (unless nnweb-articles (nnweb-read-overview group))) (funcall (nnweb-definition 'map)) @@ -229,11 +229,11 @@ Valid types include `google', `dejanews', and `gmane'.") (nnheader-insert-nov (cadr (pop articles))))))) (defun nnweb-set-hashtb (header data) - (gnus-sethash (nnweb-identifier (mail-header-xref header)) + (puthash (nnweb-identifier (mail-header-xref header)) data nnweb-hashtb)) (defun nnweb-get-hashtb (url) - (gnus-gethash (nnweb-identifier url) nnweb-hashtb)) + (gethash (nnweb-identifier url) nnweb-hashtb)) (defun nnweb-identifier (ident) (funcall (nnweb-definition 'identifier) ident)) @@ -268,7 +268,7 @@ Valid types include `google', `dejanews', and `gmane'.") (unless nnweb-group-alist (nnweb-read-active)) (unless nnweb-hashtb - (setq nnweb-hashtb (gnus-make-hashtable 4095))) + (setq nnweb-hashtb (make-hash-table :size 4000 :test #'equal))) (when group (setq nnweb-group group))) diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el index 9bceb4ead90..8ba1eae1abc 100644 --- a/lisp/gnus/score-mode.el +++ b/lisp/gnus/score-mode.el @@ -1,6 +1,6 @@ ;;; score-mode.el --- mode for editing Gnus score files -;; Copyright (C) 1996, 2001-2018 Free Software Foundation, Inc. +;; Copyright (C) 1996, 2001-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news, mail diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el index 226a4cecdcb..fb1e8de9c06 100644 --- a/lisp/gnus/smiley.el +++ b/lisp/gnus/smiley.el @@ -1,6 +1,6 @@ ;;; smiley.el --- displaying smiley faces -;; Copyright (C) 2000-2018 Free Software Foundation, Inc. +;; Copyright (C) 2000-2019 Free Software Foundation, Inc. ;; Author: Dave Love <fx@gnu.org> ;; Keywords: news mail multimedia diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index ab2a5b0f813..9a38a6c6976 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -1,6 +1,6 @@ ;;; smime.el --- S/MIME support library -*- lexical-binding:t -*- -;; Copyright (C) 2000-2018 Free Software Foundation, Inc. +;; Copyright (C) 2000-2019 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon@josefsson.org> ;; Keywords: SMIME X.509 PEM OpenSSL diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index e43c01b04f7..f611a213fdd 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -1,6 +1,6 @@ ;;; spam-report.el --- Reporting spam -;; Copyright (C) 2002-2018 Free Software Foundation, Inc. +;; Copyright (C) 2002-2019 Free Software Foundation, Inc. ;; Author: Ted Zlatanov <tzz@lifelogs.com> ;; Keywords: network, spam, mail, gmane, report diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index 3625132f8fe..6cf43df2a25 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -1,6 +1,6 @@ ;;; spam-stat.el --- detecting spam based on statistics -;; Copyright (C) 2002-2018 Free Software Foundation, Inc. +;; Copyright (C) 2002-2019 Free Software Foundation, Inc. ;; Author: Alex Schroeder <alex@gnu.org> ;; Keywords: network diff --git a/lisp/gnus/spam-wash.el b/lisp/gnus/spam-wash.el index 272d3d79e39..4d7975f8715 100644 --- a/lisp/gnus/spam-wash.el +++ b/lisp/gnus/spam-wash.el @@ -1,6 +1,6 @@ ;;; spam-wash.el --- wash spam before analysis -;; Copyright (C) 2004, 2007-2018 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2007-2019 Free Software Foundation, Inc. ;; Author: Andrew Cohen <cohen@andy.bu.edu> ;; Keywords: mail diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index e4731f36776..4d31d0a1f1c 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -1,6 +1,6 @@ ;;; spam.el --- Identifying spam -;; Copyright (C) 2002-2018 Free Software Foundation, Inc. +;; Copyright (C) 2002-2019 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Maintainer: Ted Zlatanov <tzz@lifelogs.com> |