;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
(require 'mail-utils)
(require 'timezone)
(require 'nnheader)
+(require 'message)
(eval-when-compile (require 'cl))
variable, or returned by the function) is a file name, the contents of
this file will be used as the organization.")
-(defvar gnus-use-generic-from nil
- "If nil, the full host name will be the system name prepended to the domain name.
-If this is a string, the full host name will be this string.
-If this is non-nil, non-string, the domain name will be used as the
-full host name.")
-
-(defvar gnus-use-generic-path nil
- "If nil, use the NNTP server name in the Path header.
-If stringp, use this; if non-nil, use no host name (user name only).")
-
;; Customization variables
;; Don't touch this variable.
(defvar gnus-group-faq-directory
'("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
+ "/ftp@sunsite.auc.dk:/pub/usenet/"
"/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
"/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
- "/ftp@rtfm.mit.edu:/pub/usenet/news.answers/"
+ "/ftp@rtfm.mit.edu:/pub/usenet/"
"/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
"/ftp@ftp.sunet.se:/pub/usenet/"
"/ftp@nctuccca.edu.tw:/USENET/FAQ/"
- "/ftp@hwarang.postech.ac.kr:/pub/usenet/news.answers/"
+ "/ftp@hwarang.postech.ac.kr:/pub/usenet/"
"/ftp@ftp.hk.super.net:/mirror/faqs/")
"*Directory where the group FAQs are stored.
This will most commonly be on a remote machine, and the file will be
North America: mirrors.aol.com /pub/rtfm/usenet
ftp.seas.gwu.edu /pub/rtfm
- rtfm.mit.edu /pub/usenet/news.answers
+ rtfm.mit.edu /pub/usenet
Europe: ftp.uni-paderborn.de /pub/FAQ
src.doc.ic.ac.uk /usenet/news-FAQS
ftp.sunet.se /pub/usenet
+ sunsite.auc.dk /pub/usenet
Asia: nctuccca.edu.tw /USENET/FAQ
- hwarang.postech.ac.kr /pub/usenet/news.answers
+ hwarang.postech.ac.kr /pub/usenet
ftp.hk.super.net /mirror/faqs")
(defvar gnus-group-archive-directory
(defvar gnus-signature-separator "^-- *$"
"Regexp matching signature separator.")
+(defvar gnus-signature-limit nil
+ "Provide a limit to what is considered a signature.
+If it is a number, no signature may not be longer (in characters) than
+that number. If it is a function, the function will be called without
+any parameters, and if it returns nil, there is no signature in the
+buffer. If it is a string, it will be used as a regexp. If it
+matches, the text in question is not a signature.")
+
(defvar gnus-auto-extend-newsgroup t
"*If non-nil, extend newsgroup forward and backward when requested.")
current article is unread.")
(defvar gnus-auto-center-summary t
- "*If non-nil, always center the current summary buffer.")
+ "*If non-nil, always center the current summary buffer.
+In particular, if `vertical' do only vertical recentering. If non-nil
+and non-`vertical', do both horizontal and vertical recentering.")
(defvar gnus-break-pages t
"*If non-nil, do page breaking on articles.
(vertical 1.0
(browse 1.0 point)
(if gnus-carpal '(browse-carpal 2))))
- (group-mail
+ (message
(vertical 1.0
- (mail 1.0 point)))
- (summary-mail
- (vertical 1.0
- (mail 1.0 point)))
- (summary-reply
- (vertical 1.0
- (article 0.5)
- (mail 1.0 point)))
+ (message 1.0 point)))
(pick
(vertical 1.0
(article 1.0 point)))
(post 1.0 point)))
(reply
(vertical 1.0
- (article 0.5)
- (mail 1.0 point)))
- (mail-forward
- (vertical 1.0
- (mail 1.0 point)))
- (post-forward
+ (article-copy 0.5)
+ (message 1.0 point)))
+ (forward
(vertical 1.0
- (post 1.0 point)))
+ (message 1.0 point)))
(reply-yank
(vertical 1.0
- (mail 1.0 point)))
+ (message 1.0 point)))
(mail-bounce
(vertical 1.0
(article 0.5)
- (mail 1.0 point)))
+ (message 1.0 point)))
(draft
(vertical 1.0
(draft 1.0 point)))
(summary 0.25 point)
(if gnus-carpal '(summary-carpal 4))
("*Shell Command Output*" 1.0)))
- (followup
+ (bug
(vertical 1.0
- (article 0.5)
- (post 1.0 point)))
- (followup-yank
+ ("*Gnus Help Bug*" 0.5)
+ ("*Gnus Bug*" 1.0 point)))
+ (compose-bounce
(vertical 1.0
- (post 1.0 point))))
+ (article 0.5)
+ (message 1.0 point))))
"Window configuration for all possible Gnus buffers.
This variable is a list of lists. Each of these lists has a NAME and
a RULE. The NAMEs are commonsense names like `group', which names a
(server-carpal . gnus-carpal-server-buffer)
(browse-carpal . gnus-carpal-browse-buffer)
(edit-score . gnus-score-edit-buffer)
- (mail . gnus-mail-buffer)
- (post . gnus-post-news-buffer)
+ (message . gnus-message-buffer)
(faq . gnus-faq-buffer)
(picons . "*Picons*")
(tree . gnus-tree-buffer)
(info . gnus-info-buffer)
+ (article-copy . gnus-article-copy)
(draft . gnus-draft-buffer))
"Mapping from short symbols to buffer names or buffer variables.")
%z Article zcore (character)
%t Number of articles under the current thread (number).
%e Whether the thread is empty or not (character).
-%l GroupLens score (number)
+%l GroupLens score (string).
%u User defined specifier. The next character in the format string should
be a letter. Gnus will call the function gnus-user-format-function-X,
where X is the letter following %u. The function will be passed the
"Property list to use for hiding text.")
(defvar gnus-modtime-botch nil
- "*Non-nil means .newsrc should be deleted prior to save. Its use is
-due to the bogus appearance that .newsrc was modified on disc.")
+ "*Non-nil means .newsrc should be deleted prior to save.
+Its use is due to the bogus appearance that .newsrc was modified on
+disc.")
;; Hooks.
(defvar gnus-get-new-news-hook nil
"*A hook run just before Gnus checks for new news.")
+(defvar gnus-after-getting-new-news-hook nil
+ "*A hook run after Gnus checks for new news.")
+
(defvar gnus-group-prepare-function 'gnus-group-prepare-flat
"*A function that is called to generate the group buffer.
The function is called with three arguments: The first is a number;
(defvar gnus-server-alist nil
"List of available servers.")
+(defvar gnus-group-indentation-function nil)
+
(defvar gnus-topic-indentation "") ;; Obsolete variable.
(defvar gnus-goto-missing-group-function nil)
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.44"
+(defconst gnus-version "September Gnus v0.69"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
(gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
gnus-newsgroup-adaptive-score-file
(gnus-newsgroup-expunged-tally . 0)
- gnus-cache-removeable-articles gnus-newsgroup-cached
+ gnus-cache-removable-articles gnus-newsgroup-cached
gnus-newsgroup-data gnus-newsgroup-data-reverse
gnus-newsgroup-limit gnus-newsgroup-limits)
"Variables that are buffer-local to the summary buffers.")
gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
("nnsoup" nnsoup-pack-replies)
+ ("gnus-scomo" :interactive t gnus-score-mode)
("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
gnus-Folder-save-name gnus-folder-save-name)
("gnus-mh" :interactive t gnus-summary-save-in-folder)
gnus-cache-possibly-remove-articles gnus-cache-request-article
gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
gnus-cache-enter-remove-article gnus-cached-article-p
- gnus-cache-open gnus-cache-close)
+ gnus-cache-open gnus-cache-close gnus-cache-update-article)
("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
gnus-cache-remove-article)
("gnus-score" :interactive t
("gnus-edit" :interactive t gnus-score-customize)
("gnus-topic" :interactive t gnus-topic-mode)
("gnus-topic" gnus-topic-remove-group)
- ("gnus-salt" :interactive t gnus-pick-mode)
+ ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
("gnus-uu" :interactive t
gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
(defmacro gnus-eval-in-buffer-window (buffer &rest forms)
"Pop to BUFFER, evaluate FORMS, and then return to the original window."
- `(let ((GnusStartBufferWindow (selected-window)))
- (unwind-protect
- (progn
- (pop-to-buffer ,buffer)
- ,@forms)
- (select-window GnusStartBufferWindow))))
+ (let ((tempvar (make-symbol "GnusStartBufferWindow")))
+ `(let ((,tempvar (selected-window)))
+ (unwind-protect
+ (progn
+ (pop-to-buffer ,buffer)
+ ,@forms)
+ (select-window ,tempvar)))))
(defmacro gnus-gethash (string hashtable)
"Get hash value of STRING in HASHTABLE."
(substring subject (match-end 0))
subject))
+(defsubst gnus-functionp (form)
+ "Return non-nil if FORM is funcallable."
+ (or (and (symbolp form) (fboundp form))
+ (and (listp form) (eq (car form) 'lambda))))
+
(defsubst gnus-goto-char (point)
(and point (goto-char point)))
(defmacro gnus-buffer-exists-p (buffer)
- `(and ,buffer
- (funcall (if (stringp ,buffer) 'get-buffer 'buffer-name)
- ,buffer)))
+ `(let ((buffer ,buffer))
+ (and buffer
+ (funcall (if (stringp buffer) 'get-buffer 'buffer-name)
+ buffer))))
(defmacro gnus-kill-buffer (buffer)
`(let ((buf ,buffer))
(require 'gnus-cus)
(require 'gnus-ems)
+\f
+;;;
+;;; Shutdown
+;;;
+
+(defvar gnus-shutdown-alist nil)
+
+(defun gnus-add-shutdown (function &rest symbols)
+ "Run FUNCTION whenever one of SYMBOLS is shut down."
+ (push (cons function symbols) gnus-shutdown-alist))
+
+(defun gnus-shutdown (symbol)
+ "Shut down everything that waits for SYMBOL."
+ (let ((alist gnus-shutdown-alist)
+ entry)
+ (while (setq entry (pop alist))
+ (when (memq symbol (cdr entry))
+ (funcall (car entry))))))
+
\f
;; Format specs. The chunks below are the machine-generated forms
"Return the value of the header FIELD of current article."
(save-excursion
(save-restriction
- (let ((case-fold-search t))
+ (let ((case-fold-search t)
+ (inhibit-point-motion-hooks t))
(nnheader-narrow-to-headers)
(mail-fetch-field field)))))
(push (list type new-format val) gnus-format-specs))
(set (intern (format "gnus-%s-line-format-spec" type)) val))))
- (gnus-update-group-mark-positions)
- (gnus-update-summary-mark-positions)
+ (unless (assq 'version gnus-format-specs)
+ (push (cons 'version emacs-version) gnus-format-specs))
- ;; See whether we need to read the description file.
- (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
- (not gnus-description-hashtb)
- gnus-read-active-file)
- (gnus-read-all-descriptions-files)))
+ (gnus-update-group-mark-positions)
+ (gnus-update-summary-mark-positions))
(defun gnus-update-summary-mark-positions ()
"Compute where the summary marks are to go."
;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
(defun gnus-simplify-buffer-fuzzy ()
(goto-char (point-min))
- (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*" nil t)
+ (while (search-forward "\t" nil t)
+ (replace-match " " t t))
+ (goto-char (point-min))
+ (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t)
(goto-char (match-beginning 0))
(while (or
- (looking-at "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*")
- (looking-at "^[[].*:[ \t].*[]]$"))
+ (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
+ (looking-at "^[[].*: .*[]]$"))
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*"
+ (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *"
nil t)
(replace-match "" t t))
(goto-char (point-min))
- (while (re-search-forward "^[[].*:[ \t].*[]]$" nil t)
+ (while (re-search-forward "^[[].*: .*[]]$" nil t)
(goto-char (match-end 0))
(delete-char -1)
(delete-region
(progn (goto-char (match-beginning 0)))
(re-search-forward ":"))))
(goto-char (point-min))
- (while (re-search-forward "[ \t\n]*[[{(][^()]*[]})][ \t]*$" nil t)
+ (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t)
(replace-match "" t t))
(goto-char (point-min))
- (while (re-search-forward "[ \t]+" nil t)
+ (while (re-search-forward " +" nil t)
(replace-match " " t t))
(goto-char (point-min))
- (while (re-search-forward "[ \t]+$" nil t)
+ (while (re-search-forward " $" nil t)
(replace-match "" t t))
(goto-char (point-min))
- (while (re-search-forward "^[ \t]+" nil t)
+ (while (re-search-forward "^ +" nil t)
(replace-match "" t t))
(goto-char (point-min))
- (if gnus-simplify-subject-fuzzy-regexp
- (if (listp gnus-simplify-subject-fuzzy-regexp)
- (let ((list gnus-simplify-subject-fuzzy-regexp))
- (while list
- (goto-char (point-min))
- (while (re-search-forward (car list) nil t)
- (replace-match "" t t))
- (setq list (cdr list))))
- (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
- (replace-match "" t t)))))
+ (when gnus-simplify-subject-fuzzy-regexp
+ (if (listp gnus-simplify-subject-fuzzy-regexp)
+ (let ((list gnus-simplify-subject-fuzzy-regexp))
+ (while list
+ (goto-char (point-min))
+ (while (re-search-forward (car list) nil t)
+ (replace-match "" t t))
+ (setq list (cdr list))))
+ (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
+ (replace-match "" t t)))))
(defun gnus-simplify-subject-fuzzy (subject)
"Siplify a subject string fuzzily."
gnus-active-hashtb nil
gnus-moderated-list nil
gnus-description-hashtb nil
+ gnus-current-headers nil
+ gnus-thread-indent-array nil
gnus-newsgroup-headers nil
gnus-newsgroup-name nil
gnus-server-alist nil
+ gnus-group-list-mode nil
gnus-opened-servers nil
gnus-current-select-method nil)
- ;; Reset any score variables.
- (when gnus-use-scoring
- (gnus-score-close))
+ (gnus-shutdown 'gnus)
;; Kill the startup file.
(and gnus-current-startup-file
(get-file-buffer gnus-current-startup-file)
(kill-buffer (get-file-buffer gnus-current-startup-file)))
- ;; Save any cache buffers.
- (when gnus-use-cache
- (gnus-cache-save-buffers))
;; Clear the dribble buffer.
(gnus-dribble-clear)
- ;; Close down NoCeM.
- (when gnus-use-nocem
- (gnus-nocem-close))
- ;; Shut down the demons.
- (when gnus-use-demon
- (gnus-demon-cancel))
;; Kill global KILL file buffer.
(when (get-file-buffer (gnus-newsgroup-kill-file nil))
(kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
(gnus-kill-buffer nntp-server-buffer)
- ;; Backlog.
- (when gnus-keep-backlog
- (gnus-backlog-shutdown))
;; Kill Gnus buffers.
(while gnus-buffer-list
(gnus-kill-buffer (pop gnus-buffer-list)))
(setq params nil))
;; Create a new frame?
(unless (setq frame (elt gnus-frame-list i))
- (nconc gnus-frame-list (list (setq frame (make-frame params)))))
- (push frame gnus-created-frames)
+ (nconc gnus-frame-list (list (setq frame (make-frame params))))
+ (push frame gnus-created-frames))
;; Is the old frame still alive?
(unless (frame-live-p frame)
(setcar (nthcdr i gnus-frame-list)
(let ((split (if (symbolp setting)
(cadr (assq setting gnus-buffer-configuration))
setting))
- (in-buf (current-buffer))
- rule val w height hor ohor heights sub jump-buffer
- rel total to-buf all-visible)
+ all-visible)
(setq gnus-frame-split-p nil)
(gnus-configure-frame split (get-buffer-window (current-buffer))))))
(defun gnus-all-windows-visible-p (split)
- (when (vectorp split)
- (setq split (append split nil)))
- (when (or (consp (car split))
- (vectorp (car split)))
- (push 1.0 split)
- (push 'vertical split))
- ;; The SPLIT might be something that is to be evaled to
- ;; return a new SPLIT.
- (while (and (not (assq (car split) gnus-window-to-buffer))
- (gnus-functionp (car split)))
- (setq split (eval split)))
- (let* ((type (elt split 0)))
- (cond
- ((null split)
- t)
- ((not (or (eq type 'horizontal) (eq type 'vertical) (eq type 'frame)))
- (let ((buffer (cond ((stringp type) type)
- (t (cdr (assq type gnus-window-to-buffer)))))
- win buf)
+ "Say whether all buffers in SPLIT are currently visible.
+In particular, the value returned will be the window that
+should have point."
+ (let ((stack (list split))
+ (all-visible t)
+ type buffer win buf)
+ (while (and (setq split (pop stack))
+ all-visible)
+ ;; Be backwards compatible.
+ (when (vectorp split)
+ (setq split (append split nil)))
+ (when (or (consp (car split))
+ (vectorp (car split)))
+ (push 1.0 split)
+ (push 'vertical split))
+ ;; The SPLIT might be something that is to be evaled to
+ ;; return a new SPLIT.
+ (while (and (not (assq (car split) gnus-window-to-buffer))
+ (gnus-functionp (car split)))
+ (setq split (eval split)))
+
+ (setq type (elt split 0))
+ (cond
+ ;; Nothing here.
+ ((null split) t)
+ ;; A buffer.
+ ((not (memq type '(horizontal vertical frame)))
+ (setq buffer (cond ((stringp type) type)
+ (t (cdr (assq type gnus-window-to-buffer)))))
(unless buffer
(error "Illegal buffer type: %s" type))
- (when (setq buf (get-buffer (if (symbolp buffer) (symbol-value buffer)
+ (when (setq buf (get-buffer (if (symbolp buffer)
+ (symbol-value buffer)
buffer)))
(setq win (get-buffer-window buf t)))
- (when win
- (if (memq 'point split)
- win
- t))))
- (t
- (when (eq type 'frame)
- (setq gnus-frame-split-p t))
- (let ((n (mapcar 'gnus-all-windows-visible-p
- (cddr split)))
- (win t))
- (while n
- (cond ((windowp (car n))
- (setq win (car n)))
- ((null (car n))
- (setq win nil)))
- (setq n (cdr n)))
- win)))))
+ (if win
+ (when (memq 'point split)
+ (setq all-visible win))
+ (setq all-visible nil)))
+ (t
+ (when (eq type 'frame)
+ (setq gnus-frame-split-p t))
+ (setq stack (append (cddr split) stack)))))
+ (unless (eq all-visible t)
+ all-visible)))
(defun gnus-window-top-edge (&optional window)
(nth 1 (window-edges window)))
(setq lowest-buf buf)))))
(setq buffers (cdr buffers)))
;; Remove windows on *all* summary buffers.
- (let (wins)
- (walk-windows
- (lambda (win)
- (let ((buf (window-buffer win)))
- (if (string-match "^\\*Summary" (buffer-name buf))
- (progn
- (setq bufs (cons buf bufs))
- (pop-to-buffer buf)
- (if (or (not lowest)
- (< (gnus-window-top-edge) lowest))
- (progn
- (setq lowest-buf buf)
- (setq lowest (gnus-window-top-edge))))))))))
+ (walk-windows
+ (lambda (win)
+ (let ((buf (window-buffer win)))
+ (if (string-match "^\\*Summary" (buffer-name buf))
+ (progn
+ (setq bufs (cons buf bufs))
+ (pop-to-buffer buf)
+ (if (or (not lowest)
+ (< (gnus-window-top-edge) lowest))
+ (progn
+ (setq lowest-buf buf)
+ (setq lowest (gnus-window-top-edge)))))))))
(and lowest-buf
(progn
(pop-to-buffer lowest-buf)
(memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
gnus-valid-select-methods)))
+(defun gnus-news-group-p (group &optional article)
+ "Return non-nil if GROUP (and ARTICLE) come from a news server."
+ (or (gnus-member-of-valid 'post group) ; Ordinary news group.
+ (and (gnus-member-of-valid 'post-mail group) ; Combined group.
+ (eq (gnus-request-type group article) 'news))))
+
(defsubst gnus-simplify-subject-fully (subject)
"Simplify a subject string according to the user's wishes."
(cond
"Return a string like DD-MMM from a big messy string"
(let ((datevec (timezone-parse-date messy-date)))
(format "%2s-%s"
- (or (aref datevec 2) "??")
+ (condition-case ()
+ ;; Make sure leading zeroes are stripped.
+ (number-to-string (string-to-number (aref datevec 2)))
+ (error "??"))
(capitalize
(or (car
(nth (1- (string-to-number (aref datevec 1)))
;; from `message'.
(apply 'format args)))
-(defun gnus-functionp (form)
- "Return non-nil if FORM is funcallable."
- (or (and (symbolp form) (fboundp form))
- (and (listp form) (eq (car form) 'lambda))))
-
;; Generate a unique new group name.
(defun gnus-generate-new-group-name (leaf)
(let ((name leaf)
(setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
name))
+(defsubst gnus-hide-text (b e props)
+ "Set text PROPS on the B to E region, extending `intangble' 1 past B."
+ (add-text-properties b e props)
+ (when (memq 'intangible props)
+ (put-text-property (max (1- b) (point-min))
+ b 'intangible (cddr (memq 'intangible props)))))
+
+(defsubst gnus-unhide-text (b e)
+ "Remove hidden text properties from region between B and E."
+ (remove-text-properties b e gnus-hidden-properties)
+ (when (memq 'intangible gnus-hidden-properties)
+ (put-text-property (max (1- b) (point-min))
+ b 'intangible nil)))
+
+(defun gnus-hide-text-type (b e type)
+ "Hide text of TYPE between B and E."
+ (gnus-hide-text b e (cons 'gnus-type (cons type gnus-hidden-properties))))
+
;; Find out whether the gnus-visual TYPE is wanted.
(defun gnus-visual-p (&optional type class)
(and gnus-visual ; Has to be non-nil, at least.
ids))
(nreverse ids)))
+(defun gnus-buffer-live-p (buffer)
+ "Say whether BUFFER is alive or not."
+ (and buffer
+ (get-buffer buffer)
+ (buffer-name (get-buffer buffer))))
+
(defun gnus-ephemeral-group-p (group)
"Say whether GROUP is ephemeral or not."
(gnus-group-get-parameter group 'quit-config))
(gnus-define-keys gnus-group-mode-map
" " gnus-group-read-group
"=" gnus-group-select-group
- "\M- " gnus-group-unhidden-select-group
"\r" gnus-group-select-group
"\M-\r" gnus-group-quick-select-group
"j" gnus-group-jump-to-group
(defun gnus-group-default-level (&optional level number-or-nil)
(cond
(gnus-group-use-permanent-levels
- (setq gnus-group-default-list-level
- (or level gnus-group-default-list-level))
- (or gnus-group-default-list-level gnus-level-subscribed))
+; (setq gnus-group-default-list-level
+; (or level gnus-group-default-list-level))
+ (or level gnus-group-default-list-level gnus-level-subscribed))
(number-or-nil
level)
(t
prompt the user for the name of an NNTP server to use.
As opposed to `gnus', this command will not connect to the local server."
(interactive "P")
+ (let ((gnus-group-use-permanent-levels t))
+ (gnus (or arg (1- gnus-level-default-subscribed)) t slave))
(make-local-variable 'gnus-group-use-permanent-levels)
- (setq gnus-group-use-permanent-levels t)
- (gnus (or arg (1- gnus-level-default-subscribed)) t slave))
+ (setq gnus-group-use-permanent-levels t))
;;;###autoload
(defun gnus-slave (&optional arg)
(gnus-summary-make-display-table)
;; Do the actual startup.
- (gnus-setup-news nil level)
+ (gnus-setup-news nil level dont-connect)
;; Generate the group buffer.
(gnus-group-list-groups level)
(gnus-group-first-unread-group)
(let ((case-fold-search nil)
(props (text-properties-at (gnus-point-at-bol)))
(group (gnus-group-group-name)))
+ (set-buffer gnus-group-buffer)
(funcall gnus-group-prepare-function level unread lowest)
(if (zerop (buffer-size))
(gnus-message 5 gnus-no-groups-message)
(<= (setq clevel (gnus-info-level info)) level)
(>= clevel lowest)
(or all ; We list all groups?
- (and gnus-group-list-inactive-groups
- (eq unread t)) ; We list unactivated groups
- (> unread 0) ; We list groups with unread articles
+ (if (eq unread t) ; Unactivated?
+ gnus-group-list-inactive-groups ; We list unactivated
+ (> unread 0)) ; We list groups with unread articles
(and gnus-list-groups-with-ticked-articles
(cdr (assq 'tick (gnus-info-marks info))))
; And groups with tickeds
;; 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 beg)
+ (let (group)
(if regexp
;; This loop is used when listing groups that match some
;; regexp.
;; select method, and return a select method.
(cond ((stringp method)
(gnus-server-to-method method))
+ ((equal method gnus-select-method)
+ gnus-select-method)
((and (stringp (car method)) group)
(gnus-server-extend-method group method))
+ ((and method (not group)
+ (equal (cadr method) ""))
+ method)
(t
(gnus-server-add-address method))))
(pop opened))
(caar opened))))
-(defmacro gnus-server-equal (ss1 ss2)
+(defmacro gnus-method-equal (ss1 ss2)
"Say whether two servers are equal."
`(let ((s1 ,ss1)
(s2 ,ss2))
(setq s1 (cdr s1)))
(null s1))))))
+(defun gnus-server-equal (m1 m2)
+ "Say whether two methods are equal."
+ (let ((m1 (cond ((null m1) gnus-select-method)
+ ((stringp m1) (gnus-server-to-method m1))
+ (t m1)))
+ (m2 (cond ((null m2) gnus-select-method)
+ ((stringp m2) (gnus-server-to-method m2))
+ (t m2))))
+ (gnus-method-equal m1 m2)))
+
+(defun gnus-servers-using-backend (backend)
+ "Return a list of known servers using BACKEND."
+ (let ((opened gnus-opened-servers)
+ out)
+ (while opened
+ (when (eq backend (caaar opened))
+ (push (caar opened) out))
+ (pop opened))
+ out))
+
(defun gnus-group-prefixed-name (group method)
"Return the whole name from GROUP and METHOD."
(and (stringp method) (setq method (gnus-server-to-method method)))
(if (and
(or (assoc (format "%s" (car method))
(gnus-methods-using 'address))
- (equal method gnus-message-archive-method))
+ (gnus-server-equal method gnus-message-archive-method))
+ (nth 1 method)
(not (string= (nth 1 method) "")))
(concat "+" (nth 1 method)))
":" group))
"Add SCORE to the GROUP score.
If SCORE is nil, add 1 to the score of GROUP."
(let ((info (gnus-get-info group)))
- (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))
+ (when info
+ (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
(defun gnus-summary-bubble-group ()
"Increase the score of the current group.
(or method-only-group (gnus-info-group info))
gnus-newsrc-hashtb))
(part-info info)
- (info (if method-only-group (nth 2 entry) info)))
+ (info (if method-only-group (nth 2 entry) info))
+ method)
(when method-only-group
(unless entry
(error "Trying to change non-existent group %s" method-only-group))
;; This is a new group, so we just create it.
(save-excursion
(set-buffer gnus-group-buffer)
- (if (gnus-info-method info)
+ (setq method (gnus-info-method info))
+ (when (gnus-server-equal method "native")
+ (setq method nil))
+ (if method
;; It's a foreign group...
(gnus-group-make-group
(gnus-group-real-name (gnus-info-group info))
- (prin1-to-string (car (gnus-info-method info)))
- (nth 1 (gnus-info-method info)))
+ (if (stringp method) method
+ (prin1-to-string (car method)))
+ (and (consp method)
+ (nth 1 (gnus-info-method info))))
;; It's a native group.
(gnus-group-make-group (gnus-info-group info)))
(gnus-message 6 "Note: New group created")
(setcar (nthcdr 2 entry) info)
(when (and (not (eq (car entry) t))
(gnus-active (gnus-info-group info)))
- (let ((marked (gnus-info-marks info)))
- (setcar entry (length (gnus-list-of-unread-articles
- (car info)))))))
+ (setcar entry (length (gnus-list-of-unread-articles (car info))))))
(error "No such group: %s" (gnus-info-group info)))))
(defun gnus-group-set-method-info (group select-method)
(- (1+ (cdr active)) (car active)) 0)
nil))))
-(defun gnus-group-insert-group-line
- (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number
- gnus-tmp-method)
+(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
+ gnus-tmp-marked number
+ gnus-tmp-method)
"Insert a group line in the group buffer."
(let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
(gnus-tmp-number-total
gnus-marked ,gnus-tmp-marked-mark
gnus-indentation ,gnus-group-indentation
gnus-level ,gnus-tmp-level))
- (when (gnus-visual-p 'group-highlight 'highlight)
+ (when (inline (gnus-visual-p 'group-highlight 'highlight))
(forward-line -1)
(run-hooks 'gnus-group-update-hook)
(forward-line))
(widen)
(let ((ident (gnus-intern-safe group gnus-active-hashtb))
(loc (point-min))
- found buffer-read-only visible)
+ found buffer-read-only)
;; Enter the current status into the dribble buffer.
(let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
(if (and entry (not (gnus-ephemeral-group-p group)))
(gnus-parse-format
gnus-group-mode-line-format
gnus-group-mode-line-format-alist))))
- (gnus-tmp-news-server (car (cdr gnus-select-method)))
+ (gnus-tmp-news-server (cadr gnus-select-method))
(gnus-tmp-news-method (car gnus-select-method))
(max-len 60)
gnus-tmp-header ;Dummy binding for user-defined formats
(defun gnus-group-group-indentation ()
"Get the indentation of the newsgroup on the current line."
- (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) ""))
+ (or (get-text-property (gnus-point-at-bol) 'gnus-indentation)
+ (and gnus-group-indentation-function
+ (funcall gnus-group-indentation-function))
+ ""))
(defun gnus-group-group-unread ()
"Get the number of unread articles of the newsgroup on the current line."
(defun gnus-group-unmark-all-groups ()
"Unmark all groups."
+ (interactive)
(let ((groups gnus-group-marked))
(save-excursion
(while groups
(defun gnus-group-set-mark (group)
"Set the process mark on GROUP."
- (if (gnus-group-goto-group group)
+ (if (gnus-group-goto-group group)
(save-excursion
(gnus-group-mark-group 1 nil t))
- (setq gnus-group-marked
- (cons group (delete group gnus-group-marked)))))
+ (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
(defun gnus-group-universal-argument (arg &optional groups func)
"Perform any command on all groups accoring to the process/prefix convention."
(interactive "sGroup name: ")
(or (get-buffer gnus-group-buffer)
(gnus))
- (gnus-group-select-group))
+ (gnus-group-read-group nil nil group))
;; Enter a group that is not in the group buffer. Non-nil is returned
;; if selection was successful.
(goto-char (point-min))
(let ((best 100000)
unread best-point)
- (while (setq unread (get-text-property (point) 'gnus-unread))
+ (while (not (eobp))
+ (setq unread (get-text-property (point) 'gnus-unread))
(if (and (numberp unread) (> unread 0))
(progn
- (if (and (< (get-text-property (point) 'gnus-level) best)
+ (if (and (get-text-property (point) 'gnus-level)
+ (< (get-text-property (point) 'gnus-level) best)
(or (not exclude-group)
(not (equal exclude-group (gnus-group-group-name)))))
(progn
(completing-read
"Method: " (append gnus-valid-select-methods gnus-server-alist)
nil t)))
- (if (assoc method gnus-valid-select-methods)
- (list method
- (if (memq 'prompt-address
- (assoc method gnus-valid-select-methods))
- (read-string "Address: ")
- ""))
- (list method "")))))
+ (cond ((assoc method gnus-valid-select-methods)
+ (list method
+ (if (memq 'prompt-address
+ (assoc method gnus-valid-select-methods))
+ (read-string "Address: ")
+ "")))
+ ((assoc method gnus-server-alist)
+ (list method))
+ (t
+ (list method ""))))))
(save-excursion
(set-buffer gnus-group-buffer)
(let* ((meth (and method (if address (list (intern method) address)
method)))
(nname (if method (gnus-group-prefixed-name name meth) name))
- info)
+ backend info)
(and (gnus-gethash nname gnus-newsrc-hashtb)
(error "Group %s already exists" nname))
(gnus-group-change-level
(concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
(gnus-group-insert-group-line-info nname)
- (when (assoc (symbol-name (car meth)) gnus-valid-select-methods)
- (require (car meth)))
+ (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
+ nil meth))))
+ gnus-valid-select-methods)
+ (require backend))
(gnus-check-server meth)
(and (gnus-check-backend-function 'request-create-group nname)
(gnus-request-create-group nname))
(gnus-message 6 "Deleting group %s...done" group)
(gnus-group-goto-group group)
(gnus-group-kill-group 1 t)
+ (gnus-sethash group nil gnus-active-hashtb)
t))
(gnus-group-position-point)))
(gnus-group-goto-group group)
(gnus-group-kill-group)
;; ... changing its name ...
- (setcar (cdr (car gnus-list-of-killed-groups))
- new-name)
+ (setcar (cdar gnus-list-of-killed-groups) new-name)
;; ... and then yanking it. Magic!
(gnus-group-yank-group)
(gnus-set-active new-name (gnus-active group))
(progn
(setq info (gnus-copy-sequence info))
(setcar info new-group)
- (setcar (cddddr info) method)
+ (unless (gnus-server-equal method "native")
+ (unless (nthcdr 3 info)
+ (nconc info (list nil nil)))
+ (unless (nthcdr 4 info)
+ (nconc info (list nil)))
+ (gnus-info-set-method info method))
(gnus-group-set-info info))
(gnus-group-set-info form (or new-group group) part))
(kill-buffer (current-buffer))
(message "Couldn't find doc group")
(gnus-group-make-group
(gnus-group-real-name name)
- (list 'nndoc name
+ (list 'nndoc "gnus-help"
(list 'nndoc-address file)
(list 'nndoc-article-type 'mbox)))))
(gnus-group-position-point))
(file-name-nondirectory file) '(nndoc "")))))
(gnus-group-make-group
(gnus-group-real-name name)
- (list 'nndoc name
+ (list 'nndoc (file-name-nondirectory file)
(list 'nndoc-address file)
(list 'nndoc-article-type (or type 'guess))))
(forward-line -1)
;; Group catching up.
+(defun gnus-group-clear-data (n)
+ "Clear all marks and read ranges from the current group."
+ (interactive "P")
+ (let ((groups (gnus-group-process-prefix n))
+ group info)
+ (while (setq group (pop groups))
+ (setq info (gnus-get-info group))
+ (gnus-info-set-read info nil)
+ (when (gnus-info-marks info)
+ (gnus-info-set-marks info nil))
+ (gnus-get-unread-articles-in-group info (gnus-active group) t)
+ (when (gnus-group-goto-group group)
+ (gnus-group-remove-mark group)
+ (gnus-group-update-group-line)))))
+
(defun gnus-group-catchup-current (&optional n all)
"Mark all articles not marked as unread in current newsgroup as read.
If prefix argument N is numeric, the ARG next newsgroups will be
(interactive
(list
current-prefix-arg
- (if (not (gnus-group-group-name))
- (error "No group on the current line")
- (string-to-int
- (let ((s (read-string
- (format "Level (default %s): " (gnus-group-group-level)))))
- (if (string-match "^\\s-*$" s)
- (int-to-string (gnus-group-group-level))
- s))))))
+ (string-to-int
+ (let ((s (read-string
+ (format "Level (default %s): "
+ (or (gnus-group-group-level)
+ gnus-level-default-subscribed)))))
+ (if (string-match "^\\s-*$" s)
+ (int-to-string (or (gnus-group-group-level)
+ gnus-level-default-subscribed))
+ s)))))
(or (and (>= level 1) (<= level gnus-level-killed))
(error "Illegal level: %d" level))
(let ((groups (gnus-group-process-prefix n))
(gnus-group-remove-mark group)
(setq level (gnus-group-group-level))
(gnus-delete-line)
- (if (and (not discard)
- (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
- (setq gnus-list-of-killed-groups
- (cons (cons (car entry) (nth 2 entry))
- gnus-list-of-killed-groups)))
+ (when (and (not discard)
+ (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
+ (push (cons (car entry) (nth 2 entry))
+ gnus-list-of-killed-groups))
(gnus-group-change-level
(if entry entry group) gnus-level-killed (if entry nil level)))
;; If there are lots and lots of groups to be killed, we use
((setq entry (gnus-gethash group gnus-newsrc-hashtb))
(push (cons (car entry) (nth 2 entry))
gnus-list-of-killed-groups)
- (setcdr (cdr entry) (cdr (cdr (cdr entry)))))
+ (setcdr (cdr entry) (cdddr entry)))
((member group gnus-zombie-list)
(setq gnus-zombie-list (delete group gnus-zombie-list)))))
(gnus-make-hashtable-from-newsrc-alist)))
;; first newsgroup.
(setq prev (gnus-group-group-name))
(gnus-group-change-level
- info (nth 2 info) gnus-level-killed
+ info (gnus-info-level (cdr info)) gnus-level-killed
(and prev (gnus-gethash prev gnus-newsrc-hashtb))
t)
(gnus-group-insert-group-line-info group))
(buffer-read-only nil))
(erase-buffer)
(while groups
- (gnus-group-insert-group-line-info (car groups))
- (setq groups (cdr groups)))
+ (gnus-group-insert-group-line-info (pop groups)))
(goto-char (point-min))))
(defun gnus-activate-all-groups (level)
(interactive "P")
(run-hooks 'gnus-get-new-news-hook)
;; We might read in new NoCeM messages here.
- (when gnus-use-nocem
+ (when (and gnus-use-nocem
+ (null arg))
(gnus-nocem-scan-groups))
;; If ARG is not a number, then we read the active file.
(when (and arg (not (numberp arg)))
(gnus-get-unread-articles arg))
(let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
(gnus-get-unread-articles arg)))
+ (run-hooks 'gnus-after-getting-new-news-hook)
(gnus-group-list-groups))
(defun gnus-group-get-new-news-this-group (&optional n)
(setq group (car groups)
groups (cdr groups))
(gnus-group-remove-mark group)
- (unless (gnus-get-new-news-in-group group)
+ (if (and group (gnus-activate-group group 'scan))
+ (progn
+ (gnus-get-unread-articles-in-group
+ (gnus-get-info group) (gnus-active group) t)
+ (gnus-close-group group)
+ (gnus-group-update-group group))
(ding)
(gnus-message 3 "%s error: %s" group (gnus-status-message group))))
(when gnus-goto-next-group-when-activating
(gnus-summary-position-point)
ret))
-(defun gnus-get-new-news-in-group (group)
- (when (and group (gnus-activate-group group 'scan))
- (gnus-get-unread-articles-in-group
- (gnus-get-info group) (gnus-active group) t)
- (when (gnus-group-goto-group group)
- (gnus-group-update-group-line))
- t))
-
(defun gnus-group-fetch-faq (group &optional faq-dir)
"Fetch the FAQ for the current group."
(interactive
(string-match regexp (symbol-name group))
(setq groups (cons (symbol-name group) groups))))
gnus-active-hashtb)
- ;; Go through all descriptions that are known to Gnus.
- (if search-description
- (mapatoms
- (lambda (group)
- (and (string-match regexp (symbol-value group))
- (gnus-active (symbol-name group))
- (setq groups (cons (symbol-name group) groups))))
- gnus-description-hashtb))
+ ;; Also go through all descriptions that are known to Gnus.
+ (when search-description
+ (mapatoms
+ (lambda (group)
+ (and (string-match regexp (symbol-value group))
+ (gnus-active (symbol-name group))
+ (setq groups (cons (symbol-name group) groups))))
+ gnus-description-hashtb))
(if (not groups)
(gnus-message 3 "No groups matched \"%s\"." regexp)
;; Print out all the groups.
(defun gnus-group-restart (&optional arg)
"Force Gnus to read the .newsrc file."
(interactive "P")
- (gnus-save-newsrc-file)
- (gnus-setup-news 'force)
- (gnus-group-list-groups arg))
+ (when (gnus-yes-or-no-p
+ (format "Are you sure you want to read %s? "
+ gnus-current-startup-file))
+ (gnus-save-newsrc-file)
+ (gnus-setup-news 'force)
+ (gnus-group-list-groups arg)))
(defun gnus-group-read-init-file ()
"Read the Gnus elisp init file."
gnus-expert-user
(gnus-y-or-n-p "Are you sure you want to quit reading news? "))
(run-hooks 'gnus-exit-gnus-hook)
- ;; Close down GroupLens.
- (when gnus-use-grouplens
- (bbb-logout))
;; Offer to save data from non-quitted summary buffers.
(gnus-offer-save-summaries)
;; Save the newsrc file(s).
(gnus-save-newsrc-file)
;; Kill-em-all.
(gnus-close-backends)
- ;; Shut down the cache.
- (when gnus-use-cache
- (gnus-cache-close))
;; Reset everything.
(gnus-clear-system)
;; Allow the user to do things after cleaning up.
(let ((methods gnus-valid-select-methods)
func)
(while methods
- (if (fboundp (setq func (intern (concat (car (car methods))
+ (if (fboundp (setq func (intern (concat (caar methods)
"-request-close"))))
(funcall func))
(setq methods (cdr methods)))))
(gnus-remove-some-windows))
(gnus-dribble-save)
(gnus-close-backends)
- ;; Shut down the cache.
- (when gnus-use-cache
- (gnus-cache-close))
(gnus-clear-system)
;; Allow the user to do things after cleaning up.
(run-hooks 'gnus-after-exiting-gnus-hook)))
"\M-p" gnus-summary-prev-unread-subject
"f" gnus-summary-first-unread-article
"b" gnus-summary-best-unread-article
+ "j" gnus-summary-goto-article
"g" gnus-summary-goto-subject
"l" gnus-summary-goto-last-article
"p" gnus-summary-pop-article)
(while locals
(if (consp (car locals))
(progn
- (make-local-variable (car (car locals)))
- (set (car (car locals)) (eval (cdr (car locals)))))
+ (make-local-variable (caar locals))
+ (set (caar locals) (eval (cdar locals))))
(make-local-variable (car locals))
(set (car locals) nil))
(setq locals (cdr locals))))
(let ((locals gnus-summary-local-variables))
(while locals
(if (consp (car locals))
- (and (vectorp (car (car locals)))
- (set (car (car locals)) nil))
+ (and (vectorp (caar locals))
+ (set (caar locals) nil))
(and (vectorp (car locals))
(set (car locals) nil)))
(setq locals (cdr locals)))))
(setcdr data (cons (gnus-data-make number mark pos header level)
(cdr data)))
(setq gnus-newsgroup-data-reverse nil)
- (gnus-data-update-list (cdr (cdr data)) offset)))
+ (gnus-data-update-list (cddr data) offset)))
(defun gnus-data-enter-list (after-article list &optional offset)
(when list
(setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
gnus-newsgroup-data-reverse nil)
(while (cdr data)
- (and (= (gnus-data-number (car (cdr data))) article)
+ (and (= (gnus-data-number (cadr data)) article)
(progn
- (setcdr data (cdr (cdr data)))
+ (setcdr data (cddr data))
(and offset (gnus-data-update-list (cdr data) offset))
(setq data nil
gnus-newsgroup-data-reverse nil)))
(defun gnus-summary-article-parent (&optional number)
(let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
(gnus-data-list t)))
- (level (gnus-data-level (car data)))
- l)
+ (level (gnus-data-level (car data))))
(if (zerop level)
() ; This is a root.
;; We search until we find an article with a level less than
(gnus-carpal-setup-buffer 'summary))
(unless gnus-single-article-buffer
(make-local-variable 'gnus-article-buffer)
+ (make-local-variable 'gnus-article-current)
(make-local-variable 'gnus-original-article-buffer))
(setq gnus-newsgroup-name group)
t)))
(unread gnus-newsgroup-unreads)
(headers gnus-current-headers)
(data gnus-newsgroup-data)
+ (summary gnus-summary-buffer)
(article-buffer gnus-article-buffer)
(original gnus-original-article-buffer)
+ (gac gnus-article-current)
(score-file gnus-current-score-file))
(save-excursion
(set-buffer gnus-group-buffer)
(setq gnus-newsgroup-unreads unread)
(setq gnus-current-headers headers)
(setq gnus-newsgroup-data data)
+ (setq gnus-article-current gac)
+ (setq gnus-summary-buffer summary)
(setq gnus-article-buffer article-buffer)
(setq gnus-original-article-buffer original)
(setq gnus-current-score-file score-file)))))
"Return whether ARTICLE is the last article in the buffer."
(if (not (setq article (or article (gnus-summary-article-number))))
t ; All non-existant numbers are the last article. :-)
- (cdr (gnus-data-find-list article))))
+ (not (cdr (gnus-data-find-list article)))))
(defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
"Insert a dummy root in the summary buffer."
(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
(defun gnus-make-thread-indent-array ()
(let ((n 200))
- (if (and gnus-thread-indent-array
- (= gnus-thread-indent-level gnus-thread-indent-array-level))
- nil
+ (unless (and gnus-thread-indent-array
+ (= gnus-thread-indent-level gnus-thread-indent-array-level))
(setq gnus-thread-indent-array (make-vector 201 "")
gnus-thread-indent-array-level gnus-thread-indent-level)
(while (>= n 0)
(make-local-variable (car elem))
(set (car elem) (eval (nth 1 elem))))))))
-(defun gnus-summary-read-group
- (group &optional show-all no-article kill-buffer no-display)
+(defun gnus-summary-read-group (group &optional show-all no-article
+ kill-buffer no-display)
"Start reading news in newsgroup GROUP.
If SHOW-ALL is non-nil, already read articles are also listed.
If NO-ARTICLE is non-nil, no article is selected initially.
(not no-display)
gnus-newsgroup-unreads
gnus-auto-select-first)
- (if (eq gnus-auto-select-first 'best)
- (gnus-summary-best-unread-article)
- (gnus-summary-first-unread-article))
+ (unless (if (eq gnus-auto-select-first 'best)
+ (gnus-summary-best-unread-article)
+ (gnus-summary-first-unread-article))
+ (gnus-configure-windows 'summary))
;; Don't select any articles, just move point to the first
;; article in the group.
(goto-char (point-min))
(result threads)
subject hthread whole-subject)
(while threads
- (setq whole-subject (mail-header-subject (car (car threads))))
+ (setq whole-subject (mail-header-subject (caar threads)))
+ (setq subject
+ (cond
+ ;; Truncate the subject.
+ ((numberp gnus-summary-gather-subject-limit)
+ (setq subject (gnus-simplify-subject-re whole-subject))
+ (if (> (length subject) gnus-summary-gather-subject-limit)
+ (substring subject 0 gnus-summary-gather-subject-limit)
+ subject))
+ ;; Fuzzily simplify it.
+ ((eq 'fuzzy gnus-summary-gather-subject-limit)
+ (gnus-simplify-subject-fuzzy whole-subject))
+ ;; Just remove the leading "Re:".
+ (t
+ (gnus-simplify-subject-re whole-subject))))
+
(if (and gnus-summary-gather-exclude-subject
(string-match gnus-summary-gather-exclude-subject
- whole-subject))
- () ; We don't want to do anything with this article.
+ subject))
+ () ; We don't want to do anything with this article.
;; We simplify the subject before looking it up in the
;; hash table.
- (setq subject
- (cond
- ;; Truncate the subject.
- ((numberp gnus-summary-gather-subject-limit)
- (setq subject (gnus-simplify-subject-re whole-subject))
- (if (> (length subject) gnus-summary-gather-subject-limit)
- (substring subject 0 gnus-summary-gather-subject-limit)
- subject))
- ;; Fuzzily simplify it.
- ((eq 'fuzzy gnus-summary-gather-subject-limit)
- (gnus-simplify-subject-fuzzy whole-subject))
- ;; Just remove the leading "Re:".
- (t
- (gnus-simplify-subject-re whole-subject))))
(if (setq hthread (gnus-gethash subject hashtb))
(progn
;; We enter a dummy root into the thread, if we
;; haven't done that already.
- (unless (stringp (car (car hthread)))
+ (unless (stringp (caar hthread))
(setcar hthread (list whole-subject (car hthread))))
;; We add this new gathered thread to this gathered
;; thread.
(setcdr (car hthread)
- (nconc (cdr (car hthread)) (list (car threads))))
+ (nconc (cdar hthread) (list (car threads))))
;; Remove it from the list of threads.
(setcdr prev (cdr threads))
(setq threads prev))
(setq threads (cdr threads)))
result)))
-(defun gnus-summary-gather-threads-by-references (threads)
+(defun gnus-gather-threads-by-references (threads)
"Gather threads by looking at References headers."
(let ((idhashtb (gnus-make-hashtable 1023))
(thhashtb (gnus-make-hashtable 1023))
"Sort subtreads inside each gathered thread by article number."
(let ((result threads))
(while threads
- (when (stringp (car (car threads)))
+ (when (stringp (caar threads))
(setcdr (car threads)
- (sort (cdr (car threads)) 'gnus-thread-sort-by-number)))
+ (sort (cdar threads) 'gnus-thread-sort-by-number)))
(setq threads (cdr threads)))
result))
(when (and (setq references (mail-header-references header))
(not (string= references "")))
(insert references)
- (setq child (downcase (mail-header-id header))
+ (setq child (mail-header-id header)
subject (mail-header-subject header))
(setq generation 0)
(while (search-backward ">" nil t)
(setq end (1+ (point)))
(when (search-backward "<" nil t)
(push (list (incf generation)
- child (setq child (downcase
- (buffer-substring (point) end)))
+ child (setq child (buffer-substring (point) end))
subject)
relations)))
(push (list (1+ generation) child nil subject) relations)
(when (not (car (symbol-value refs)))
(setq heads (cdr (symbol-value refs)))
(while heads
- (if (memq (mail-header-number (car (car heads)))
+ (if (memq (mail-header-number (caar heads))
gnus-newsgroup-dormant)
(setq heads (cdr heads))
(setq id (symbol-name refs))
(regexp-quote id))))
(or found (beginning-of-line 2)))
(when found
- (let (ref)
- (beginning-of-line)
- (and
- (setq header (gnus-nov-parse-line
- (read (current-buffer)) deps))
- (gnus-parent-id (mail-header-references header))))))
+ (beginning-of-line)
+ (and
+ (setq header (gnus-nov-parse-line
+ (read (current-buffer)) deps))
+ (gnus-parent-id (mail-header-references header)))))
(when header
(let ((number (mail-header-number header)))
(push number gnus-newsgroup-limit)
(defun gnus-summary-update-article (article &optional header)
"Update ARTICLE in the summary buffer."
- (let ((id (mail-header-id (gnus-summary-article-header article)))
- (data (gnus-data-find article)))
- (setcar (gnus-id-to-thread id) nil)
- (gnus-summary-insert-subject id)
- ;; Set the (possibly) new article number in the data structure.
- (gnus-data-set-number data (gnus-id-to-article id))))
+ (set-buffer gnus-summary-buffer)
+ (let* ((header (or header (gnus-summary-article-header article)))
+ (id (mail-header-id header))
+ (data (gnus-data-find article))
+ (thread (gnus-id-to-thread id))
+ (parent
+ (gnus-id-to-thread (or (gnus-parent-id
+ (mail-header-references header))
+ "tull")))
+ (buffer-read-only nil)
+ (old (car thread))
+ (number (mail-header-number header))
+ pos)
+ (when thread
+ (setcar thread nil)
+ (when parent
+ (delq thread parent))
+ (if (gnus-summary-insert-subject id header)
+ ;; Set the (possibly) new article number in the data structure.
+ (gnus-data-set-number data (gnus-id-to-article id))
+ (setcar thread old)
+ nil))))
(defun gnus-rebuild-thread (id)
"Rebuild the thread containing ID."
- (let ((dep gnus-newsgroup-dependencies)
- (buffer-read-only nil)
- current headers refs thread art data)
+ (let ((buffer-read-only nil)
+ current thread data)
(if (not gnus-show-threads)
(setq thread (list (car (gnus-id-to-thread id))))
;; Get the thread this article is part of.
(while thread
(unless (memq (setq thr (gnus-id-to-thread
(gnus-root-id
- (mail-header-id (car (car thread))))))
+ (mail-header-id (caar thread)))))
roots)
(push thr roots))
(setq thread (cdr thread)))
;; All the loose roots are now one solid root.
(setq thread (car roots))
(setq thread (cons subject (gnus-sort-threads roots))))))
- (let ((beg (point))
- threads)
+ (let (threads)
;; We then insert this thread into the summary buffer.
(let (gnus-newsgroup-data gnus-newsgroup-threads)
(gnus-summary-prepare-threads (list thread))
(defun gnus-id-to-thread (id)
"Return the (sub-)thread where ID appears."
- (gnus-gethash (downcase id) gnus-newsgroup-dependencies))
+ (gnus-gethash id gnus-newsgroup-dependencies))
(defun gnus-id-to-article (id)
"Return the article number of ID."
(defun gnus-root-id (id)
"Return the id of the root of the thread where ID appears."
(let (last-id prev)
- (while (and id (setq prev (car (gnus-gethash
- (downcase id)
- gnus-newsgroup-dependencies))))
+ (while (and id (setq prev (car (gnus-gethash
+ id gnus-newsgroup-dependencies))))
(setq last-id id
id (gnus-parent-id (mail-header-references prev))))
last-id))
(defun gnus-remove-thread (id &optional dont-remove)
"Remove the thread that has ID in it."
(let ((dep gnus-newsgroup-dependencies)
- headers thread prev last-id)
+ headers thread last-id)
;; First go up in this thread until we find the root.
(setq last-id (gnus-root-id id))
(setq headers (list (car (gnus-id-to-thread last-id))
- (car (car (cdr (gnus-id-to-thread last-id))))))
+ (caadr (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.
(progn
(setq sub (cdr sub))
(while sub
- (when (member (car (car sub)) headers)
+ (when (member (caar sub) headers)
(setq thread (car threads)
threads nil
sub nil))
(if thread
(unless dont-remove
(setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
- (setq thread (gnus-gethash (downcase last-id) dep)))
+ (setq thread (gnus-gethash last-id dep)))
(when thread
(prog1
thread ; We return this thread.
(gnus-data-remove number))
(setq thread (cdr thread))
(while thread
- (gnus-remove-thread-1 (car thread))
- (setq thread (cdr thread)))))
+ (gnus-remove-thread-1 (pop thread)))))
(defun gnus-sort-threads (threads)
"Sort THREADS."
(or (cdr (assq (mail-header-number root) gnus-newsgroup-scored))
gnus-summary-default-score 0)
(mapcar 'gnus-thread-total-score
- (cdr (gnus-gethash (downcase (mail-header-id root))
+ (cdr (gnus-gethash (mail-header-id root)
gnus-newsgroup-dependencies)))))
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(if (and (= gnus-tmp-level 0)
(not (setq gnus-tmp-dummy-line nil))
(or (not stack)
- (= (car (car stack)) 0))
+ (= (caar stack) 0))
(not gnus-tmp-false-parent)
(or gnus-tmp-new-adopts new-roots))
(if gnus-tmp-new-adopts
(setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
thread (list (car gnus-tmp-new-adopts))
- gnus-tmp-header (car (car thread))
+ gnus-tmp-header (caar thread)
gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
(if new-roots
(setq thread (list (car new-roots))
- gnus-tmp-header (car (car thread))
+ gnus-tmp-header (caar thread)
new-roots (cdr new-roots))))
(if threads
;; If there are some threads, we do them before the
;; threads on the stack.
(setq thread threads
- gnus-tmp-header (car (car thread)))
+ gnus-tmp-header (caar thread))
;; There were no current threads, so we pop something off
;; the stack.
(setq state (car stack)
gnus-tmp-level (car state)
thread (cdr state)
stack (cdr stack)
- gnus-tmp-header (car (car thread)))))
+ gnus-tmp-header (caar thread))))
(setq gnus-tmp-false-parent nil)
(setq gnus-tmp-root-expunged nil)
((eq gnus-summary-make-false-root 'adopt)
;; We let the first article adopt the rest.
(setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
- (cdr (cdr (car thread)))))
+ (cddar thread)))
(setq gnus-tmp-gathered
(nconc (mapcar
(lambda (h) (mail-header-number (car h)))
- (cdr (cdr (car thread))))
+ (cddar thread))
gnus-tmp-gathered))
- (setq thread (cons (list (car (car thread))
- (car (cdr (car thread))))
+ (setq thread (cons (list (caar thread)
+ (cadar thread))
(cdr thread)))
(setq gnus-tmp-level -1
gnus-tmp-false-parent t))
(setq gnus-tmp-gathered
(nconc (mapcar
(lambda (h) (mail-header-number (car h)))
- (cdr (cdr (car thread))))
+ (cddar thread))
gnus-tmp-gathered))
(setq gnus-tmp-level -1))
((eq gnus-summary-make-false-root 'dummy)
(setq gnus-tmp-gathered
(nconc (mapcar
(lambda (h) (mail-header-number (car h)))
- (cdr (car thread)))
+ (cdar thread))
gnus-tmp-gathered))
- (setq gnus-tmp-new-adopts (if (cdr (car thread))
+ (setq gnus-tmp-new-adopts (if (cdar thread)
(append gnus-tmp-new-adopts
- (cdr (car thread)))
+ (cdar thread))
gnus-tmp-new-adopts)
thread-end t
gnus-tmp-header nil)
(when (nth 1 thread)
(push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack))
(incf gnus-tmp-level)
- (setq threads (if thread-end nil (cdr (car thread))))
+ (setq threads (if thread-end nil (cdar thread)))
(unless threads
(setq gnus-tmp-level 0)))))
(gnus-message 7 "Generating summary...done"))
(or (and entry (not (eq (car entry) t))) ; Either it's active...
(gnus-activate-group group) ; Or we can activate it...
(progn ; Or we bug out.
- (kill-buffer (current-buffer))
+ (when (equal major-mode 'gnus-summary-mode)
+ (kill-buffer (current-buffer)))
(error "Couldn't request group %s: %s"
group (gnus-status-message group))))
(setq gnus-newsgroup-dependencies
(gnus-make-hashtable (length articles)))
;; Retrieve the headers and read them in.
- (gnus-message 5 "Fetching headers...")
+ (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
(setq gnus-newsgroup-headers
(if (eq 'nov
(setq gnus-headers-retrieved-by
(> (length articles) 1))))))
(gnus-get-newsgroup-headers-xover articles)
(gnus-get-newsgroup-headers)))
- (gnus-message 5 "Fetching headers...done")
+ (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
;; Kludge to avoid having cached articles nixed out in virtual groups.
(when cached
;; Check whether auto-expire is to be done in this group.
(setq gnus-newsgroup-auto-expire
(gnus-group-auto-expirable-p group))
+ ;; Set up the article buffer now, if necessary.
+ (unless gnus-single-article-buffer
+ (gnus-article-setup-buffer))
;; First and last article in this newsgroup.
(and gnus-newsgroup-headers
(setq gnus-newsgroup-begin
(let ((types gnus-article-mark-lists)
(info (gnus-get-info gnus-newsgroup-name))
(uncompressed '(score bookmark killed))
- var type list newmarked symbol)
+ type list newmarked symbol)
(when info
;; Add all marks lists that are non-nil to the list of marks lists.
(while types
marked m)
(or (not info)
(and (not (setq marked (nthcdr 3 info)))
- (setcdr (nthcdr 2 info)
- (list (list (cons type (gnus-compress-sequence
- articles t))))))
+ (or (null articles)
+ (setcdr (nthcdr 2 info)
+ (list (list (cons type (gnus-compress-sequence
+ articles t)))))))
(and (not (setq m (assq type (car marked))))
- (setcar marked
- (cons (cons type (gnus-compress-sequence articles t) )
- (car marked))))
+ (or (null articles)
+ (setcar marked
+ (cons (cons type (gnus-compress-sequence articles t) )
+ (car marked)))))
(if force
- (setcdr m (gnus-compress-sequence articles t))
+ (if (null articles)
+ (setcar (nthcdr 3 info)
+ (delq (assq type (car marked)) (car marked)))
+ (setcdr m (gnus-compress-sequence articles t)))
(setcdr m (gnus-compress-sequence
- (sort (nconc (gnus-uncompress-range m)
+ (sort (nconc (gnus-uncompress-range (cdr m))
(copy-sequence articles)) '<) t))))))
(defun gnus-set-mode-line (where)
(defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
"Go through the HEADERS list and add all Xrefs to a hash table.
The resulting hash table is returned, or nil if no Xrefs were found."
- (let* ((from-method (gnus-find-method-for-group from-newsgroup))
- (virtual (gnus-virtual-group-p from-newsgroup))
+ (let* ((virtual (gnus-virtual-group-p from-newsgroup))
(prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
(xref-hashtb (make-vector 63 0))
start group entry number xrefs header)
(setq start 0)
(while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
(setq start (match-end 0))
- (setq group (concat prefix (substring xrefs (match-beginning 1)
- (match-end 1))))
+ (setq group (if prefix
+ (concat prefix (substring xrefs (match-beginning 1)
+ (match-end 1)))
+ (substring xrefs (match-beginning 1) (match-end 1))))
(setq number
(string-to-int (substring xrefs (match-beginning 2)
(match-end 2))))
(while range
(if (numberp (car range))
(setq num (1+ num))
- (setq num (+ num (- (1+ (cdr (car range)))
- (car (car range))))))
+ (setq num (+ num (- (1+ (cdar range)) (caar range)))))
(setq range (cdr range)))
(setq num (- (cdr active) num))))
;; Update the number of unread articles.
(save-excursion
(set-buffer nntp-server-buffer)
(let ((case-fold-search t)
- in-reply-to header number p lines)
+ in-reply-to header p lines)
(goto-char (point-min))
;; Search to the beginning of the next header. Error messages
;; do not begin with 2 or 3.
(setq end (match-end 0))
(save-excursion
(setq ref
- (downcase
- (buffer-substring
- (progn
- (end-of-line)
- (search-backward ">" end t)
- (1+ (point)))
- (progn
- (search-backward "<" end t)
- (point)))))))
+ (buffer-substring
+ (progn
+ (end-of-line)
+ (search-backward ">" end t)
+ (1+ (point)))
+ (progn
+ (search-backward "<" end t)
+ (point))))))
;; Get the references from the in-reply-to header if there
;; were no references and the in-reply-to header looks
;; promising.
(if (and (search-forward "\nin-reply-to: " nil t)
(setq in-reply-to (gnus-header-value))
(string-match "<[^>]+>" in-reply-to))
- (prog1
- (setq ref (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (setq ref (downcase ref))))
- (setq ref "")))
+ (setq ref (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (setq ref ""))))
;; Chars.
0
;; Lines.
;; the same hash table. Some tippy-toeing around has to be
;; done in case an article has arrived before the article
;; which it refers to.
- (if (boundp (setq id-dep (intern (downcase id) dependencies)))
+ (if (boundp (setq id-dep (intern id dependencies)))
(if (and (car (symbol-value id-dep))
(not force-new))
;; An article with this Message-ID has already
'(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
;; Goes through the xover lines and returns a list of vectors
-(defun gnus-get-newsgroup-headers-xover (sequence &optional force-new)
+(defun gnus-get-newsgroup-headers-xover (sequence &optional
+ force-new dependencies)
"Parse the news overview data in the server buffer, and return a
list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
;; Get the Xref when the users reads the articles since most/some
;; NNTP servers do not include Xrefs when using XOVER.
(setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
(let ((cur nntp-server-buffer)
- (dependencies gnus-newsgroup-dependencies)
+ (dependencies (or dependencies gnus-newsgroup-dependencies))
number headers header)
(save-excursion
(set-buffer nntp-server-buffer)
(search-forward "\t" eol)
(if (search-backward ">" beg t)
(setq ref
- (downcase
- (buffer-substring
- (1+ (point))
- (progn
- (search-backward "<" beg t)
- (point)))))
+ (buffer-substring
+ (1+ (point))
+ (search-backward "<" beg t)))
(setq ref nil))))
(gnus-nov-field)) ; refs
(gnus-nov-read-integer) ; chars
;; We build the thread tree.
(when header
- (if (boundp (setq id-dep (intern (downcase id) dependencies)))
+ (if (boundp (setq id-dep (intern id dependencies)))
(if (and (car (symbol-value id-dep))
(not force-new))
;; An article with this Message-ID has already been seen,
(progn (end-of-line) (point))))
(mail-header-set-xref headers xref))))))))
-(defun gnus-summary-insert-subject (id)
+(defun gnus-summary-insert-subject (id &optional old-header)
"Find article ID and insert the summary line for that article."
(let ((header (gnus-read-header id))
- (number (and (numberp id) id)))
+ (number (and (numberp id) id))
+ pos)
(when header
;; Rebuild the thread that this article is part of and go to the
;; article we have fetched.
+ (when old-header
+ (when (setq pos (text-property-any
+ (point-min) (point-max) 'gnus-number
+ (mail-header-number old-header)))
+ (goto-char pos)
+ (gnus-delete-line)
+ (gnus-data-remove (mail-header-number old-header))))
(gnus-rebuild-thread (mail-header-id header))
(gnus-summary-goto-subject (setq number (mail-header-number header))))
(when (and (numberp number)
(setq gnus-newsgroup-unselected
(delq number gnus-newsgroup-unselected)))
;; Report back a success?
- (and header number)))
+ (and header (mail-header-number header))))
(defun gnus-summary-work-articles (n)
"Return a list of articles to be worked upon. The prefix argument,
(defun gnus-recenter (&optional n)
"Center point in window and redisplay frame.
Also do horizontal recentering."
- (interactive)
- (gnus-horizontal-recenter)
+ (interactive "P")
+ (when (and gnus-auto-center-summary
+ (not (eq gnus-auto-center-summary 'vertical)))
+ (gnus-horizontal-recenter))
(recenter n))
(defun gnus-summary-recenter ()
window (min bottom (save-excursion
(forward-line (- top)) (point)))))
;; Do horizontal recentering while we're at it.
- (when (get-buffer-window (current-buffer) t)
+ (when (and (get-buffer-window (current-buffer) t)
+ (not (eq gnus-auto-center-summary 'vertical)))
(let ((selected (selected-window)))
(select-window (get-buffer-window (current-buffer) t))
(gnus-summary-position-point)
(setq first (1+ (cdr read)))
;; `read' is a list of ranges.
(if (/= (setq nlast (or (and (numberp (car read)) (car read))
- (car (car read)))) 1)
+ (caar read))) 1)
(setq first 1))
(while read
(if first
(while (< first nlast)
(setq unread (cons first unread))
(setq first (1+ first))))
- (setq first (1+ (if (atom (car read)) (car read) (cdr (car read)))))
- (setq nlast (if (atom (car (cdr read)))
- (car (cdr read))
- (car (car (cdr read)))))
+ (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
+ (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
(setq read (cdr read)))))
;; And add the last unread articles.
(while (<= first last)
(unless (listp (cdr gnus-newsgroup-killed))
(setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
(let ((headers gnus-newsgroup-headers))
- (gnus-close-group group)
(run-hooks 'gnus-exit-group-hook)
(unless gnus-save-score
(setq gnus-newsgroup-scored nil))
(quit-config (gnus-group-quit-config gnus-newsgroup-name))
(mode major-mode)
(buf (current-buffer)))
- (run-hooks 'gnus-summary-prepare-exit-hook)
+ (unless temporary
+ (run-hooks 'gnus-summary-prepare-exit-hook))
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
- (gnus-kill-buffer gnus-original-article-buffer))
+ (gnus-kill-buffer gnus-original-article-buffer)
+ (setq gnus-article-current nil))
(when gnus-use-cache
(gnus-cache-possibly-remove-articles)
(gnus-cache-save-buffers))
;; Make all changes in this group permanent.
(unless quit-config
(gnus-summary-update-info))
+ (gnus-close-group group)
;; Make sure where I was, and go to next newsgroup.
(set-buffer gnus-group-buffer)
(unless quit-config
(gnus-group-jump-to-group group)
(gnus-group-next-unread-group 1))
(run-hooks 'gnus-summary-exit-hook)
+ (unless gnus-single-article-buffer
+ (setq gnus-article-current nil))
(if temporary
nil ;Nothing to do.
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
- (gnus-kill-buffer gnus-original-article-buffer))
+ (gnus-kill-buffer gnus-original-article-buffer)
+ (setq gnus-article-current nil))
(set-buffer buf)
(if (not gnus-kill-summary-on-exit)
(gnus-deaden-summary)
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
- (gnus-kill-buffer gnus-original-article-buffer))
+ (gnus-kill-buffer gnus-original-article-buffer)
+ (setq gnus-article-current nil))
(if (not gnus-kill-summary-on-exit)
(gnus-deaden-summary)
(gnus-close-group group)
(gnus-summary-clear-local-variables)
(when (get-buffer gnus-summary-buffer)
(kill-buffer gnus-summary-buffer)))
+ (unless gnus-single-article-buffer
+ (setq gnus-article-current nil))
(when gnus-use-trees
(gnus-tree-close group))
(when (get-buffer gnus-article-buffer)
(setq n (1- n)))
(if (/= 0 n) (gnus-message 7 "No more%s articles"
(if unread " unread" "")))
- (or dont-display
- (progn
- (gnus-summary-recenter)
- (gnus-summary-position-point)))
+ (unless dont-display
+ (gnus-summary-recenter)
+ (gnus-summary-position-point))
n))
(defun gnus-summary-next-unread-subject (n)
(not (equal (car gnus-article-current)
gnus-newsgroup-name))))
(and (not gnus-single-article-buffer)
- (null gnus-current-article))
+ (or (null gnus-current-article)
+ (not (eq gnus-current-article article))))
force)
;; The requested article is different from the current article.
(prog1
If BACKWARD, the previous article is selected instead of the next."
(interactive "P")
(gnus-set-global-variables)
- (let (header)
- (cond
- ;; Is there such an article?
- ((and (gnus-summary-search-forward unread subject backward)
- (or (gnus-summary-display-article (gnus-summary-article-number))
- (eq (gnus-summary-article-mark) gnus-canceled-mark)))
- (gnus-summary-position-point))
- ;; If not, we try the first unread, if that is wanted.
- ((and subject
- gnus-auto-select-same
- (or (gnus-summary-first-unread-article)
- (eq (gnus-summary-article-mark) gnus-canceled-mark)))
- (gnus-summary-position-point)
- (gnus-message 6 "Wrapped"))
- ;; Try to get next/previous article not displayed in this group.
- ((and gnus-auto-extend-newsgroup
- (not unread) (not subject))
- (gnus-summary-goto-article
- (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
- nil t))
- ;; Go to next/previous group.
- (t
- (or (gnus-ephemeral-group-p gnus-newsgroup-name)
- (gnus-summary-jump-to-group gnus-newsgroup-name))
- (let ((cmd last-command-char)
- (group
- (if (eq gnus-keep-same-level 'best)
- (gnus-summary-best-group gnus-newsgroup-name)
- (gnus-summary-search-group backward gnus-keep-same-level))))
- ;; For some reason, the group window gets selected. We change
- ;; it back.
- (select-window (get-buffer-window (current-buffer)))
- ;; Select next unread newsgroup automagically.
- (cond
- ((not gnus-auto-select-next)
- (gnus-message 7 "No more%s articles" (if unread " unread" "")))
- ((or (eq gnus-auto-select-next 'quietly)
- (and (eq gnus-auto-select-next 'slightly-quietly)
- push)
- (and (eq gnus-auto-select-next 'almost-quietly)
- (gnus-summary-last-article-p)))
- ;; Select quietly.
- (if (gnus-ephemeral-group-p gnus-newsgroup-name)
- (gnus-summary-exit)
- (gnus-message 7 "No more%s articles (%s)..."
- (if unread " unread" "")
- (if group (concat "selecting " group)
- "exiting"))
- (gnus-summary-next-group nil group backward)))
- (t
- (gnus-summary-walk-group-buffer
- gnus-newsgroup-name cmd unread backward))))))))
+ (cond
+ ;; Is there such an article?
+ ((and (gnus-summary-search-forward unread subject backward)
+ (or (gnus-summary-display-article (gnus-summary-article-number))
+ (eq (gnus-summary-article-mark) gnus-canceled-mark)))
+ (gnus-summary-position-point))
+ ;; If not, we try the first unread, if that is wanted.
+ ((and subject
+ gnus-auto-select-same
+ (or (gnus-summary-first-unread-article)
+ (eq (gnus-summary-article-mark) gnus-canceled-mark)))
+ (gnus-summary-position-point)
+ (gnus-message 6 "Wrapped"))
+ ;; Try to get next/previous article not displayed in this group.
+ ((and gnus-auto-extend-newsgroup
+ (not unread) (not subject))
+ (gnus-summary-goto-article
+ (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
+ nil t))
+ ;; Go to next/previous group.
+ (t
+ (or (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (gnus-summary-jump-to-group gnus-newsgroup-name))
+ (let ((cmd last-command-char)
+ (group
+ (if (eq gnus-keep-same-level 'best)
+ (gnus-summary-best-group gnus-newsgroup-name)
+ (gnus-summary-search-group backward gnus-keep-same-level))))
+ ;; For some reason, the group window gets selected. We change
+ ;; it back.
+ (select-window (get-buffer-window (current-buffer)))
+ ;; Select next unread newsgroup automagically.
+ (cond
+ ((not gnus-auto-select-next)
+ (gnus-message 7 "No more%s articles" (if unread " unread" "")))
+ ((or (eq gnus-auto-select-next 'quietly)
+ (and (eq gnus-auto-select-next 'slightly-quietly)
+ push)
+ (and (eq gnus-auto-select-next 'almost-quietly)
+ (gnus-summary-last-article-p)))
+ ;; Select quietly.
+ (if (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (gnus-summary-exit)
+ (gnus-message 7 "No more%s articles (%s)..."
+ (if unread " unread" "")
+ (if group (concat "selecting " group)
+ "exiting"))
+ (gnus-summary-next-group nil group backward)))
+ (t
+ (gnus-summary-walk-group-buffer
+ gnus-newsgroup-name cmd unread backward)))))))
(defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
(let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
(switch-to-buffer gnus-group-buffer)
(and group
(gnus-group-jump-to-group group))
- (eval (car (cdr (assq key keystrokes))))
+ (eval (cadr (assq key keystrokes)))
(setq group (gnus-group-group-name))
(switch-to-buffer obuf))
(setq ended nil))
(gnus-message 3 "End of message"))
((null lines)
(if (and (eq gnus-summary-goto-unread 'never)
- (not (eq article gnus-newsgroup-end)))
+ (not (gnus-summary-last-article-p article)))
(gnus-summary-next-article)
(gnus-summary-next-unread-article))))))
(gnus-summary-recenter)
(interactive "p")
(gnus-set-global-variables)
(gnus-configure-windows 'article)
+ (gnus-summary-show-thread)
(when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
(gnus-eval-in-buffer-window
gnus-article-buffer
(setq best score
article (gnus-data-number (car data))))
(setq data (cdr data)))
- (if article
- (gnus-summary-goto-article article)
- (error "No unread articles"))
- (gnus-summary-position-point)))
+ (prog1
+ (if article
+ (gnus-summary-goto-article article)
+ (error "No unread articles"))
+ (gnus-summary-position-point))))
(defun gnus-summary-last-subject ()
"Go to the last displayed subject line in the group."
(defsubst gnus-cut-thread (thread)
"Go forwards in the thread until we find an article that we want to display."
- (if (eq gnus-fetch-old-headers 'some)
- (while (and thread
- (memq (mail-header-number (car thread))
- gnus-newsgroup-ancient)
- (<= (length (cdr thread)) 1))
- (setq thread (cadr thread)))
+ (when (eq gnus-fetch-old-headers 'some)
+ ;; Deal with old-fetched headers.
+ (while (and thread
+ (memq (mail-header-number (car thread))
+ gnus-newsgroup-ancient)
+ (<= (length (cdr thread)) 1))
+ (setq thread (cadr thread))))
+ ;; Deal with sparse threads.
+ (when (or (eq gnus-build-sparse-threads 'some)
+ (eq gnus-build-sparse-threads 'more))
(while (and thread
(memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
(= (length (cdr thread)) 1))
(while th
(setcar th (gnus-cut-thread (car th)))
(setq th (cdr th)))))
- threads)
+ ;; Remove nixed out threads.
+ (delq nil threads))
(defun gnus-summary-initial-limit (&optional show-if-empty)
"Figure out what the initial limit is supposed to be on group entry.
(setq message-id (concat "<" message-id)))
(unless (string-match ">$" message-id)
(setq message-id (concat message-id ">")))
- (let ((header (car (gnus-gethash (downcase message-id)
+ (let ((header (car (gnus-gethash message-id
gnus-newsgroup-dependencies))))
(if header
;; The article is present in the buffer, to we just go to it.
(gnus-summary-goto-article (mail-header-number header) nil t)
;; We fetch the article
- (let ((gnus-override-method gnus-refer-article-method)
+ (let ((gnus-override-method
+ (and (gnus-news-group-p gnus-newsgroup-name)
+ gnus-refer-article-method))
number)
;; Start the special refer-article method, if necessary.
(when gnus-refer-article-method
If N is nil and any articles have been marked with the process mark,
move those articles instead.
If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
-If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
+If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
re-spool using this method.
For this function to work, both the current newsgroup and the
(crosspost "crosspost" "Crossposting")))
(copy-buf (save-excursion
(nnheader-set-temp-buffer " *copy article*")))
- art-group to-method new-xref article)
+ art-group to-method new-xref article to-groups)
(unless (assq action names)
(error "Unknown action %s" action))
;; Read the newsgroup name.
(cadr (assq action names))
gnus-current-move-group articles prefix))
(set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
- (setq to-method (if select-method (list select-method "")
- (gnus-find-method-for-group to-newsgroup)))
- ;;(when (equal to-newsgroup gnus-newsgroup-name)
- ;;(error "Can't %s to the same group you're already in" action))
+ (setq to-method (or select-method
+ (gnus-find-method-for-group to-newsgroup)))
;; Check the method we are to move this article to...
(or (gnus-check-backend-function 'request-accept-article (car to-method))
(error "%s does not support article copying" (car to-method)))
(error "Can't open server %s" (car to-method)))
(gnus-message 6 "%s to %s: %s..."
(caddr (assq action names))
- (or select-method to-newsgroup) articles)
+ (or (car select-method) to-newsgroup) articles)
(while articles
(setq article (pop articles))
(setq
(nth 1 (gnus-find-method-for-group
gnus-newsgroup-name)) ; Server
(list 'gnus-request-accept-article
- (if select-method
- (list 'quote select-method)
- to-newsgroup)
+ to-newsgroup (list 'quote select-method)
(not articles)) ; Accept form
(not articles))) ; Only save nov last time
;; Copy the article.
(set-buffer copy-buf)
(gnus-request-article-this-buffer article gnus-newsgroup-name)
(gnus-request-accept-article
- (if select-method select-method to-newsgroup)
- (not articles))))
+ to-newsgroup select-method (not articles))))
;; Crosspost the article.
((eq action 'crosspost)
(let ((xref (mail-header-xref (gnus-summary-article-header article))))
(gnus-request-article-this-buffer article gnus-newsgroup-name)
(nnheader-replace-header "xref" new-xref)
(gnus-request-accept-article
- (if select-method select-method to-newsgroup)
- (not articles)))))))
+ to-newsgroup select-method (not articles)))))))
(if (not art-group)
(gnus-message 1 "Couldn't %s article %s"
(cadr (assq action names)) article)
(gnus-gethash
(gnus-group-prefixed-name
(car art-group)
- (if select-method (list select-method "")
- (gnus-find-method-for-group to-newsgroup)))
+ (or select-method
+ (gnus-find-method-for-group to-newsgroup)))
gnus-newsrc-hashtb)))
- (info (nth 2 entry)))
+ (info (nth 2 entry))
+ (to-group (gnus-info-group info)))
;; Update the group that has been moved to.
(when (and info
(memq action '(move copy)))
+ (unless (member to-group to-groups)
+ (push to-group to-groups))
+
(unless (memq article gnus-newsgroup-unreads)
(gnus-info-set-read
info (gnus-add-to-range (gnus-info-read info)
;; See whether the article is to be put in the cache.
(when gnus-use-cache
(gnus-cache-possibly-enter-article
- (gnus-info-group info) to-article
+ to-group to-article
(let ((header (copy-sequence
(gnus-summary-article-header article))))
(mail-header-set-number header to-article)
(when (memq article (symbol-value
(intern (format "gnus-newsgroup-%s"
(caar marks)))))
+ ;; If the other group is the same as this group,
+ ;; then we have to add the mark to the list.
+ (when (equal to-group gnus-newsgroup-name)
+ (set (intern (format "gnus-newsgroup-%s" (caar marks)))
+ (cons to-article
+ (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks)))))))
+ ;; Copy mark to other group.
(gnus-add-marked-articles
- (gnus-info-group info) (cdar marks)
- (list to-article) info))
+ to-group (cdar marks) (list to-article) info))
(setq marks (cdr marks)))))
;; Update the Xref header in this article to point to
(when (eq action 'move)
(gnus-summary-mark-article article gnus-canceled-mark)))
(gnus-summary-remove-process-mark article))
+ ;; Re-activate all groups that have been moved to.
+ (while to-groups
+ (gnus-activate-group (pop to-groups)))
+
(gnus-kill-buffer copy-buf)
(gnus-summary-position-point)
(gnus-set-mode-line 'summary)))
(defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
"Move the current article to a different newsgroup.
If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
-If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
+If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
re-spool using this method."
(interactive "P")
- (gnus-summary-move-article n nil nil 'copy))
+ (gnus-summary-move-article n nil select-method 'copy))
(defun gnus-summary-crosspost-article (&optional n)
"Crosspost the current article to some other group."
(interactive "P")
(gnus-summary-move-article n nil nil 'crosspost))
-(defun gnus-summary-respool-article (&optional n respool-method)
+(defun gnus-summary-respool-article (&optional n method)
"Respool the current article.
The article will be squeezed through the mail spooling process again,
which means that it will be put in some mail newsgroup or other
In the former case, the articles in question will be moved from the
current group into whatever groups they are destined to. In the
latter case, they will be copied into the relevant groups."
- (interactive "P")
+ (interactive
+ (list current-prefix-arg
+ (let* ((methods (gnus-methods-using 'respool))
+ (methname
+ (symbol-name (car (gnus-find-method-for-group
+ gnus-newsgroup-name))))
+ (method
+ (completing-read
+ "What backend do you want to use when respooling? "
+ methods nil t (cons methname 0)))
+ ms)
+ (cond
+ ((zerop (length (setq ms (gnus-servers-using-backend method))))
+ (list (intern method) ""))
+ ((= 1 (length ms))
+ (car ms))
+ (t
+ (cdr (completing-read
+ "Server name: "
+ (mapcar (lambda (m) (cons (cadr m) m)) ms) nil t)))))))
(gnus-set-global-variables)
- (let ((respool-methods (gnus-methods-using 'respool))
- (methname
- (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name)))))
- (or respool-method
- (setq respool-method
- (completing-read
- "What method do you want to use when respooling? "
- respool-methods nil t methname)))
- (or (string= respool-method "")
- (if (assoc (symbol-name
- (car (gnus-find-method-for-group gnus-newsgroup-name)))
- respool-methods)
- (gnus-summary-move-article n nil (intern respool-method))
- (gnus-summary-copy-article n nil (intern respool-method))))))
+ (unless method
+ (error "No method given for respooling"))
+ (if (assoc (symbol-name
+ (car (gnus-find-method-for-group gnus-newsgroup-name)))
+ (gnus-methods-using 'respool))
+ (gnus-summary-move-article n nil method)
+ (gnus-summary-copy-article n nil method)))
(defun gnus-summary-import-article (file)
"Import a random file into a mail newsgroup."
"Message-ID: " (gnus-inews-message-id) "\n"
"Lines: " (int-to-string lines) "\n"
"Chars: " (int-to-string (nth 7 atts)) "\n\n"))
- (gnus-request-accept-article group t)
+ (gnus-request-accept-article group nil t)
(kill-buffer (current-buffer)))))
(defun gnus-summary-expire-articles ()
(gnus-message
1 "The current newsgroup does not support article editing.")
(ding))
- (let ((buf (buffer-substring-no-properties (point-min) (point-max))))
+ (let ((buf (format "%s" (buffer-string))))
(erase-buffer)
(insert buf)
(if (not (gnus-request-replace-article
(setq buffer-read-only t)
(buffer-disable-undo (current-buffer))
(gnus-configure-windows 'summary)
- (gnus-summary-update-article (cdr gnus-article-current)))
+ (gnus-summary-update-article (cdr gnus-article-current))
+ (when gnus-use-cache
+ (gnus-cache-update-article
+ (cdr gnus-article-current) (car gnus-article-current))))
(run-hooks 'gnus-article-display-hook)
(and (gnus-visual-p 'summary-highlight 'highlight)
(run-hooks 'gnus-visual-mark-article-hook)))))
(let ((scored gnus-newsgroup-scored)
headers h)
(while scored
- (or (gnus-summary-goto-subject (car (car scored)))
- (and (setq h (gnus-summary-article-header (car (car scored))))
- (< (cdr (car scored)) gnus-summary-expunge-below)
+ (or (gnus-summary-goto-subject (caar scored))
+ (and (setq h (gnus-summary-article-header (caar scored)))
+ (< (cdar scored) gnus-summary-expunge-below)
(setq headers (cons h headers))))
(setq scored (cdr scored)))
(or headers (error "No expunged articles hidden."))
(gnus-summary-select-article t t nil current-article)
(set-buffer gnus-article-buffer)
(setq buffer-read-only nil)
- (let ((buf (buffer-substring-no-properties (point-min) (point-max))))
+ (let ((buf (format "%s" (buffer-string))))
(erase-buffer)
(insert buf))
(goto-char (point-min))
(gnus-set-global-variables)
(let ((buffer-read-only nil)
(start (point))
- (article (gnus-summary-article-number))
- end)
+ (article (gnus-summary-article-number)))
(goto-char start)
;; Go forward until either the buffer ends or the subthread
;; ends.
(when (and (not (eobp))
(or (zerop (gnus-summary-next-thread 1 t))
(goto-char (point-max))))
- (setq end (point))
(prog1
(if (and (> (point) start)
(search-backward "\n" start t))
"Go to the same level (or less) next thread.
If PREVIOUS is non-nil, go to previous thread instead.
Return the article number moved to, or nil if moving was impossible."
- (let* ((level (gnus-summary-thread-level))
- (article (gnus-summary-article-number))
- (data (cdr (gnus-data-find-list article (gnus-data-list previous))))
- oart)
- (while data
- (if (<= (gnus-data-level (car data)) level)
- (setq oart (gnus-data-number (car data))
- data nil)
- (setq data (cdr data))))
- (and oart
- (gnus-summary-goto-subject oart))))
+ (let ((level (gnus-summary-thread-level))
+ (way (if previous -1 1))
+ (beg (point)))
+ (forward-line way)
+ (while (and (not (eobp))
+ (< level (gnus-summary-thread-level)))
+ (forward-line way))
+ (if (eobp)
+ (progn
+ (goto-char beg)
+ nil)
+ (setq beg (point))
+ (prog1
+ (gnus-summary-article-number)
+ (goto-char beg)))))
+
+(defun gnus-summary-go-to-next-thread-old (&optional previous)
+ "Go to the same level (or less) next thread.
+If PREVIOUS is non-nil, go to previous thread instead.
+Return the article number moved to, or nil if moving was impossible."
+ (if (and (eq gnus-summary-make-false-root 'dummy)
+ (gnus-summary-article-intangible-p))
+ (let ((beg (point)))
+ (while (and (zerop (forward-line 1))
+ (not (gnus-summary-article-intangible-p))
+ (not (zerop (save-excursion
+ (gnus-summary-thread-level))))))
+ (if (eobp)
+ (progn
+ (goto-char beg)
+ nil)
+ (point)))
+ (let* ((level (gnus-summary-thread-level))
+ (article (gnus-summary-article-number))
+ (data (cdr (gnus-data-find-list article (gnus-data-list previous))))
+ oart)
+ (while data
+ (if (<= (gnus-data-level (car data)) level)
+ (setq oart (gnus-data-number (car data))
+ data nil)
+ (setq data (cdr data))))
+ (and oart
+ (gnus-summary-goto-subject oart)))))
(defun gnus-summary-next-thread (n &optional silent)
"Go to the same level next N'th thread.
(gnus-set-global-variables)
(let ((backward (< n 0))
(n (abs n))
- old dum)
+ old dum int)
(while (and (> n 0)
- (setq old (save-excursion (forward-line 1) (point)))
(gnus-summary-go-to-next-thread backward))
- (when (and (eq gnus-summary-make-false-root 'dummy)
- (setq dum (text-property-not-all
- old (point) 'gnus-intangible nil)))
- (goto-char dum))
(decf n))
(unless silent
(gnus-summary-position-point))
(while methods
(goto-char (point-min))
(setq method (pop methods))
- (setq match (pop method))
+ (setq match (car method))
(when (cond
((stringp match)
;; Regular expression.
(save-restriction
(widen)
(setq result (eval match)))))
- (setq split-name (append (cdr methods) split-name))
+ (setq split-name (append (cdr method) split-name))
(cond ((stringp result)
(push result split-name))
((consp result)
(concat prompt " ") split-name nil nil)))
(concat gnus-article-save-directory
(if (string= result "")
- (car (car split-name))
+ (caar split-name)
result)))))))
;; If we have read a directory, we append the default file name.
(when (file-directory-p file)
(setq files (list (cdr (assq 'name (car ps)))))
(while (and ps (cdr ps)
(string= (or action "1")
- (or (cdr (assq 'action (car (cdr ps)))) "2")))
- (setq files (cons (cdr (assq 'name (car (cdr ps)))) files))
- (setcdr ps (cdr (cdr ps))))
+ (or (cdr (assq 'action (cadr ps))) "2")))
+ (setq files (cons (cdr (assq 'name (cadr ps))) files))
+ (setcdr ps (cddr ps)))
(if (not files)
()
(if (not (string-match "%s" action))
(gnus-summary-goto-subject after-article)
(forward-line 1)
(setq b (point))
- (insert " " (file-name-nondirectory
+ (insert " " (file-name-nondirectory
(cdr (assq 'name (car pslist))))
": " (or (cdr (assq 'execute (car pslist))) "") "\n")
(setq e (point))
(setq gnus-original-article-buffer original)
(gnus-set-global-variables))
(make-local-variable 'gnus-summary-buffer))
+ ;; Init original article buffer.
+ (save-excursion
+ (set-buffer (get-buffer-create gnus-original-article-buffer))
+ (buffer-disable-undo (current-buffer))
+ (setq major-mode 'gnus-original-article-mode)
+ (make-local-variable 'gnus-original-article))
(if (get-buffer name)
(save-excursion
(set-buffer name)
(defun gnus-request-article-this-buffer (article group)
"Get an article and insert it into this buffer."
- (prog1
- (save-excursion
- (erase-buffer)
- (gnus-kill-all-overlays)
- (setq group (or group gnus-newsgroup-name))
-
- ;; Open server if it has closed.
- (gnus-check-server (gnus-find-method-for-group group))
-
- ;; Using `gnus-request-article' directly will insert the article into
- ;; `nntp-server-buffer' - so we'll save some time by not having to
- ;; copy it from the server buffer into the article buffer.
-
- ;; We only request an article by message-id when we do not have the
- ;; headers for it, so we'll have to get those.
- (when (stringp article)
- (let ((gnus-override-method gnus-refer-article-method))
- (gnus-read-header article)))
-
- ;; If the article number is negative, that means that this article
- ;; doesn't belong in this newsgroup (possibly), so we find its
- ;; message-id and request it by id instead of number.
- (when (numberp article)
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (let ((header (gnus-summary-article-header article)))
- (if (< article 0)
- (cond
- ((memq article gnus-newsgroup-sparse)
- ;; This is a sparse gap article.
- (setq article (mail-header-id header)))
- ((vectorp header)
- ;; It's a real article.
- (setq article (mail-header-id header)))
- (t
- ;; It is an extracted pseudo-article.
- (setq article 'pseudo)
- (gnus-request-pseudo-article header))))
+ (let (do-update-line)
+ (prog1
+ (save-excursion
+ (erase-buffer)
+ (gnus-kill-all-overlays)
+ (setq group (or group gnus-newsgroup-name))
+
+ ;; Open server if it has closed.
+ (gnus-check-server (gnus-find-method-for-group group))
+
+ ;; Using `gnus-request-article' directly will insert the article into
+ ;; `nntp-server-buffer' - so we'll save some time by not having to
+ ;; copy it from the server buffer into the article buffer.
+
+ ;; We only request an article by message-id when we do not have the
+ ;; headers for it, so we'll have to get those.
+ (when (stringp article)
+ (let ((gnus-override-method gnus-refer-article-method))
+ (gnus-read-header article)))
+
+ ;; If the article number is negative, that means that this article
+ ;; doesn't belong in this newsgroup (possibly), so we find its
+ ;; message-id and request it by id instead of number.
+ (when (and (numberp article)
+ gnus-summary-buffer
+ (get-buffer gnus-summary-buffer)
+ (buffer-name (get-buffer gnus-summary-buffer)))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (let ((header (gnus-summary-article-header article)))
+ (if (< article 0)
+ (cond
+ ((memq article gnus-newsgroup-sparse)
+ ;; This is a sparse gap article.
+ (setq do-update-line article)
+ (setq article (mail-header-id header))
+ (let ((gnus-override-method gnus-refer-article-method))
+ (gnus-read-header article)))
+ ((vectorp header)
+ ;; It's a real article.
+ (setq article (mail-header-id header)))
+ (t
+ ;; It is an extracted pseudo-article.
+ (setq article 'pseudo)
+ (gnus-request-pseudo-article header))))
- (let ((method (gnus-find-method-for-group
- gnus-newsgroup-name)))
- (if (not (eq (car method) 'nneething))
- ()
- (let ((dir (concat (file-name-as-directory (nth 1 method))
- (mail-header-subject header))))
- (if (file-directory-p dir)
- (progn
- (setq article 'nneething)
- (gnus-group-enter-directory dir)))))))))
-
- (cond
- ;; We first check `gnus-original-article-buffer'.
- ((and (equal (car gnus-original-article) group)
- (eq (cdr gnus-original-article) article)
- (get-buffer gnus-original-article-buffer))
- (insert-buffer-substring gnus-original-article-buffer)
- 'article)
- ;; Check the backlog.
- ((and gnus-keep-backlog
- (gnus-backlog-request-article group article (current-buffer)))
- 'article)
- ;; Check the cache.
- ((and gnus-use-cache
- (numberp article)
- (gnus-cache-request-article article group))
- 'article)
- ;; Get the article and put into the article buffer.
- ((or (stringp article) (numberp article))
- (let ((gnus-override-method
- (and (stringp article) gnus-refer-article-method))
- (buffer-read-only nil))
+ (let ((method (gnus-find-method-for-group
+ gnus-newsgroup-name)))
+ (if (not (eq (car method) 'nneething))
+ ()
+ (let ((dir (concat (file-name-as-directory (nth 1 method))
+ (mail-header-subject header))))
+ (if (file-directory-p dir)
+ (progn
+ (setq article 'nneething)
+ (gnus-group-enter-directory dir)))))))))
+
+ (cond
+ ;; We first check `gnus-original-article-buffer'.
+ ((and (get-buffer gnus-original-article-buffer)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (and (equal (car gnus-original-article) group)
+ (eq (cdr gnus-original-article) article))))
+ (insert-buffer-substring gnus-original-article-buffer)
+ 'article)
+ ;; Check the backlog.
+ ((and gnus-keep-backlog
+ (gnus-backlog-request-article group article (current-buffer)))
+ 'article)
+ ;; Check the cache.
+ ((and gnus-use-cache
+ (numberp article)
+ (gnus-cache-request-article article group))
+ 'article)
+ ;; Get the article and put into the article buffer.
+ ((or (stringp article) (numberp article))
+ (let ((gnus-override-method
+ (and (stringp article) gnus-refer-article-method))
+ (buffer-read-only nil))
+ (erase-buffer)
+ (gnus-kill-all-overlays)
+ (if (gnus-request-article article group (current-buffer))
+ (progn
+ (and gnus-keep-backlog
+ (numberp article)
+ (gnus-backlog-enter-article
+ group article (current-buffer)))
+ 'article))))
+ ;; It was a pseudo.
+ (t article)))
+
+ ;; Take the article from the original article buffer
+ ;; and place it in the buffer it's supposed to be in.
+ (when (and (get-buffer gnus-article-buffer)
+ (equal (buffer-name (current-buffer))
+ (buffer-name (get-buffer gnus-article-buffer))))
+ (save-excursion
+ (if (get-buffer gnus-original-article-buffer)
+ (set-buffer (get-buffer gnus-original-article-buffer))
+ (set-buffer (get-buffer-create gnus-original-article-buffer))
+ (buffer-disable-undo (current-buffer))
+ (setq major-mode 'gnus-original-article-mode)
+ (setq buffer-read-only t)
+ (gnus-add-current-to-buffer-list))
+ (let (buffer-read-only)
(erase-buffer)
- (gnus-kill-all-overlays)
- (if (gnus-request-article article group (current-buffer))
- (progn
- (and gnus-keep-backlog
- (gnus-backlog-enter-article
- group article (current-buffer)))
- 'article))))
- ;; It was a pseudo.
- (t article)))
-
- ;; Take the article from the original article buffer
- ;; and place it in the buffer it's supposed to be in.
- (setq gnus-original-article (cons group article))
- (when (and (get-buffer gnus-article-buffer)
- (equal (buffer-name (current-buffer))
- (buffer-name (get-buffer gnus-article-buffer))))
- (save-excursion
- (if (get-buffer gnus-original-article-buffer)
- (set-buffer (get-buffer gnus-original-article-buffer))
- (set-buffer (get-buffer-create gnus-original-article-buffer))
- (buffer-disable-undo (current-buffer))
- (setq major-mode 'gnus-original-article-mode)
- (setq buffer-read-only t)
- (gnus-add-current-to-buffer-list))
- (let (buffer-read-only)
- (erase-buffer)
- (insert-buffer-substring gnus-article-buffer))))
+ (insert-buffer-substring gnus-article-buffer))
+ (setq gnus-original-article (cons group article))))
- ;; Update sparse articles.
- (when (memq article gnus-newsgroup-sparse)
- (gnus-summary-update-article article))))
+ ;; Update sparse articles.
+ (when do-update-line
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-summary-update-article do-update-line)
+ (gnus-summary-goto-subject do-update-line)
+ (set-window-point (get-buffer-window (current-buffer) t)
+ (point)))))))
-(defun gnus-read-header (id)
+(defun gnus-read-header (id &optional header)
"Read the headers of article ID and enter them into the Gnus system."
(let ((group gnus-newsgroup-name)
- (headers gnus-newsgroup-headers)
- header where)
+ where)
;; First we check to see whether the header in question is already
;; fetched.
(if (stringp id)
;; This is a Message-ID.
- (setq header (gnus-id-to-header id))
+ (setq header (or header (gnus-id-to-header id)))
;; This is an article number.
- (setq header (gnus-summary-article-header id)))
- (if header
+ (setq header (or header (gnus-summary-article-header id))))
+ (if (and header
+ (not (memq (mail-header-number header) gnus-newsgroup-sparse)))
;; We have found the header.
header
;; We have to really fetch the header to this article.
(goto-char (point-max))
(insert ".\n")
(goto-char (point-min))
- (insert "211 "
- (int-to-string
- (cond
- ((numberp id)
- id)
- ((cdr where)
- (cdr where))
- (t
- gnus-reffed-article-number)))
- " Article retrieved.\n"))
+ (insert "211 ")
+ (princ (cond
+ ((numberp id) id)
+ ((cdr where) (cdr where))
+ (header (mail-header-number header))
+ (t gnus-reffed-article-number))
+ (current-buffer))
+ (insert " Article retrieved.\n"))
+ ;(when (and header
+ ; (memq (mail-header-number header) gnus-newsgroup-sparse))
+ ; (setcar (gnus-id-to-thread id) nil))
(if (not (setq header (car (gnus-get-newsgroup-headers))))
- () ; Malformed head.
- (if (and (stringp id)
- (not (string= (gnus-group-real-name group)
- (car where))))
- ;; If we fetched by Message-ID and the article came
- ;; from a different group, we fudge some bogus article
- ;; numbers for this article.
- (mail-header-set-number header gnus-reffed-article-number))
- (decf gnus-reffed-article-number)
- (push header gnus-newsgroup-headers)
- (setq gnus-current-headers header)
- (push (mail-header-number header) gnus-newsgroup-limit)
+ () ; Malformed head.
+ (unless (memq (mail-header-number header) gnus-newsgroup-sparse)
+ (if (and (stringp id)
+ (not (string= (gnus-group-real-name group)
+ (car where))))
+ ;; If we fetched by Message-ID and the article came
+ ;; from a different group, we fudge some bogus article
+ ;; numbers for this article.
+ (mail-header-set-number header gnus-reffed-article-number))
+ (decf gnus-reffed-article-number)
+ (push header gnus-newsgroup-headers)
+ (setq gnus-current-headers header)
+ (push (mail-header-number header) gnus-newsgroup-limit))
header)))))
(defun gnus-article-prepare (article &optional all-headers header)
(gnus-article-setup-buffer)
(set-buffer gnus-article-buffer)
(let ((buffer-read-only nil))
- (remove-text-properties (point-min) (point-max)
- gnus-hidden-properties))))
+ (gnus-unhide-text (point-min) (point-max)))))
(defun gnus-article-hide-headers-if-wanted ()
"Hide unwanted headers if `gnus-have-all-headers' is nil.
(set-buffer gnus-article-buffer)
(save-restriction
(let ((buffer-read-only nil)
+ (props (nconc (list 'gnus-type 'headers)
+ gnus-hidden-properties))
(ignored (when (not (stringp gnus-visible-headers))
(cond ((stringp gnus-ignored-headers)
gnus-ignored-headers)
((and gnus-visible-headers
(listp gnus-visible-headers))
(mapconcat 'identity gnus-visible-headers "\\|"))))
- want-list beg want-l)
+ want-list beg)
;; First we narrow to just the headers.
(widen)
(goto-char (point-min))
(while (looking-at "From ")
(forward-line 1))
(unless (bobp)
- (add-text-properties
- (point-min) (point)
- (nconc (list 'gnus-type 'headers) gnus-hidden-properties)))
+ (gnus-hide-text (point-min) (point) props))
;; Then treat the rest of the header lines.
(narrow-to-region
(point)
(if delete
(delete-region (point-min) (point-max))
;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
- (add-text-properties
- (point) (point-max)
- (nconc (list 'gnus-type 'headers)
- gnus-hidden-properties)))))))))
+ (gnus-hide-text-type (point) (point-max) 'headers))))))))
(defsubst gnus-article-header-rank (header)
"Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
((eq elem 'empty)
(while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t)
(forward-line -1)
- (add-text-properties
+ (gnus-hide-text-type
(progn (beginning-of-line) (point))
(progn
(end-of-line)
(if (re-search-forward "^[^ \t]" nil t)
(match-beginning 0)
(point-max)))
- (nconc (list 'gnus-type 'boring-headers)
- gnus-hidden-properties))))
+ 'boring-headers)))
;; Hide boring Newsgroups header.
((eq elem 'newsgroups)
(when (equal (mail-fetch-field "newsgroups")
(when (and
from reply-to
(equal
- (nth 1 (mail-extract-address-components from))
- (nth 1 (mail-extract-address-components reply-to))))
+ (nth 1 (funcall gnus-extract-address-components from))
+ (nth 1 (funcall gnus-extract-address-components
+ reply-to))))
(gnus-article-hide-header "reply-to"))))
((eq elem 'date)
(let ((date (mail-fetch-field "date")))
(save-excursion
(goto-char (point-min))
(when (re-search-forward (concat "^" header ":") nil t)
- (add-text-properties
+ (gnus-hide-text-type
(progn (beginning-of-line) (point))
(progn
(end-of-line)
(if (re-search-forward "^[^ \t]" nil t)
(match-beginning 0)
(point-max)))
- (nconc (list 'gnus-type 'boring-headers)
- gnus-hidden-properties)))))
+ 'boring-headers))))
;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-article-treat-overstrike ()
(interactive)
(save-excursion
(set-buffer gnus-article-buffer)
- (let ((buffer-read-only nil)
- p)
+ (let ((buffer-read-only nil))
(widen)
(goto-char (point-min))
(search-forward "\n\n" nil t)
(buffer-read-only nil)
(type (gnus-fetch-field "content-transfer-encoding")))
(when (or force
- (and type (string-match "quoted-printable" type)))
+ (and type (string-match "quoted-printable" (downcase type))))
(gnus-headers-decode-quoted-printable)
(goto-char (point-min))
(search-forward "\n\n" nil 'move)
(goto-char (point-min))
;; Hide the "header".
(and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
- (add-text-properties (match-beginning 0) (match-end 0) props))
+ (gnus-hide-text (match-beginning 0) (match-end 0) props))
(setq beg (point))
;; Hide the actual signature.
(and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
- (setq end (match-beginning 0))
- (add-text-properties
- (match-beginning 0)
+ (setq end (1+ (match-beginning 0)))
+ (gnus-hide-text
+ end
(if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
(match-end 0)
;; Perhaps we shouldn't hide to the end of the buffer
(narrow-to-region beg end)
(goto-char (point-min))
(while (re-search-forward "^- " nil t)
- (add-text-properties (match-beginning 0) (match-end 0) props))
+ (gnus-hide-text (match-beginning 0) (match-end 0) props))
(widen))))))
(defun gnus-article-hide-signature (&optional arg)
(save-restriction
(let ((buffer-read-only nil))
(when (gnus-narrow-to-signature)
- (add-text-properties
- (point-min) (point-max)
- (nconc (list 'gnus-type 'signature)
- gnus-hidden-properties))))))))
+ (gnus-hide-text-type (point-min) (point-max) 'signature)))))))
-(defvar gnus-signature-limit nil
- "Provide a limit to what is considered a signature.
-If it is a number, no signature may not be longer (in characters) than
-that number. If it is a function, the function will be called without
-any parameters, and if it returns nil, there is no signature in the
-buffer. If it is a string, it will be used as a regexp. If it
-matches, the text in question is not a signature.")
+(defun gnus-article-strip-leading-blank-lines ()
+ "Remove all blank lines from the beginning of the article."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let (buffer-read-only)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (while (looking-at "[ \t]$")
+ (gnus-delete-line))))))
(defun gnus-narrow-to-signature ()
"Narrow to the signature."
(defun gnus-article-hidden-text-p (type)
"Say whether the current buffer contains hidden text of type TYPE."
- (let ((pos (text-property-any (point-min) (point-max) 'gnus-type type))
- prop)
+ (let ((pos (text-property-any (point-min) (point-max) 'gnus-type type)))
(when pos
(if (get-text-property pos 'invisible)
'hidden
(setq beg (point))
(forward-char)
(if hide
- (add-text-properties beg (point) gnus-hidden-properties)
- (remove-text-properties beg (point) gnus-hidden-properties))
+ (gnus-hide-text beg (point) gnus-hidden-properties)
+ (gnus-unhide-text beg (point)))
(setq beg (point)))
t)))
(date (and (vectorp header) (mail-header-date header)))
(date-regexp "^Date: \\|^X-Sent: ")
(now (current-time))
- (inhibit-point-motion-hooks t))
+ (inhibit-point-motion-hooks t)
+ bface eface)
(when (and date (not (string= date "")))
(save-excursion
(set-buffer gnus-article-buffer)
(nnheader-narrow-to-headers)
(let ((buffer-read-only nil))
;; Delete any old Date headers.
- (if (zerop (nnheader-remove-header date-regexp t))
- (beginning-of-line)
+ (if (re-search-forward date-regexp nil t)
+ (progn
+ (setq bface (get-text-property (gnus-point-at-bol) 'face)
+ eface (get-text-property (gnus-point-at-eol) 'face))
+ (message-remove-header date-regexp t)
+ (beginning-of-line))
(goto-char (point-max)))
(insert
(cond
(t
(error "Unknown conversion type: %s" type)))))
;; Do highlighting.
- (when (and highlight (gnus-visual-p 'article-highlight 'highlight))
- (gnus-article-highlight-headers)))))))
+ (beginning-of-line)
+ (when (and highlight (gnus-visual-p 'article-highlight 'highlight)
+ (looking-at "\\([^:]\\): *\\(.*\\)$"))
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'face bface)
+ (put-text-property (match-beginning 2) (match-end 2)
+ 'face eface)))))))
(defun gnus-article-date-local (&optional highlight)
"Convert the current article date to the local timezone."
"Show the next page of the article."
(interactive)
(when (gnus-article-next-page)
- (gnus-article-read-summary-keys nil ?n)))
+ (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))))
(defun gnus-article-goto-prev-page ()
"Show the next page of the article."
(interactive)
- (if (bobp) (gnus-article-read-summary-keys nil ?n)
+ (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))
(gnus-article-prev-page nil)))
(defun gnus-article-next-page (&optional lines)
(end-of-buffer
;; Long lines may cause an end-of-buffer error.
(goto-char (point-max))))
+ (move-to-window-line 0)
nil))
(defun gnus-article-prev-page (&optional lines)
(gnus-narrow-to-page -1) ;Go to previous page.
(goto-char (point-max))
(recenter -1))
- (condition-case ()
- (scroll-down lines)
- (error nil))))
+ (prog1
+ (condition-case ()
+ (scroll-down lines)
+ (error nil))
+ (move-to-window-line 0))))
(defun gnus-article-refer-article ()
"Read article specified by message-id around point."
;; Apply kills to specified newsgroups in command line arguments.
(setq newsrc (cdr gnus-newsrc-alist))
(while newsrc
- (setq group (car (car newsrc)))
+ (setq group (caar newsrc))
(setq entry (gnus-gethash group gnus-newsrc-hashtb))
(if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed)
(and (car entry)
(or (gnus-server-opened method)
(gnus-open-server method))))
-(defun gnus-check-server (&optional method)
+(defun gnus-check-server (&optional method silent)
"Check whether the connection to METHOD is down.
If METHOD is nil, use `gnus-select-method'.
If it is down, start it up (again)."
;; The stream is already opened.
t
;; Open the server.
- (gnus-message 5 "Opening %s server%s..." (car method)
- (if (equal (nth 1 method) "") ""
- (format " on %s" (nth 1 method))))
+ (unless silent
+ (gnus-message 5 "Opening %s server%s..." (car method)
+ (if (equal (nth 1 method) "") ""
+ (format " on %s" (nth 1 method)))))
(run-hooks 'gnus-open-server-hook)
(prog1
(gnus-open-server method)
- (message "")))))
+ (unless silent
+ (message ""))))))
(defun gnus-get-function (method function)
"Return a function symbol based on METHOD and FUNCTION."
(defun gnus-open-server (method)
"Open a connection to METHOD."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(let ((elem (assoc method gnus-opened-servers)))
;; If this method was previously denied, we just return nil.
(if (eq (nth 1 elem) 'denied)
(defun gnus-close-server (method)
"Close the connection to METHOD."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'close-server) (nth 1 method)))
(defun gnus-request-list (method)
"Request the active file from METHOD."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'request-list) (nth 1 method)))
(defun gnus-request-list-newsgroups (method)
"Request the newsgroups file from METHOD."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
(defun gnus-request-newgroups (date method)
"Request all new groups since DATE from METHOD."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'request-newgroups)
date (nth 1 method)))
(defun gnus-server-opened (method)
"Check whether a connection to METHOD has been opened."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'server-opened) (nth 1 method)))
(defun gnus-status-message (method)
(defun gnus-request-group (group &optional dont-check method)
"Request GROUP. If DONT-CHECK, no information is required."
(let ((method (or method (gnus-find-method-for-group group))))
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'request-group)
(gnus-group-real-name group) (nth 1 method) dont-check)))
(defun gnus-retrieve-groups (groups method)
"Request active information on GROUPS from METHOD."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
(defun gnus-request-type (group &optional article)
(defun gnus-request-post (method)
"Post the current buffer using METHOD."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(funcall (gnus-get-function method 'request-post) (nth 1 method)))
(defun gnus-request-scan (group method)
(defsubst gnus-request-update-info (info method)
"Request that METHOD update INFO."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(when (gnus-check-backend-function 'request-update-info (car method))
(funcall (gnus-get-function method 'request-update-info)
(gnus-group-real-name (gnus-info-group info))
article (gnus-group-real-name group)
(nth 1 method) accept-function last)))
-(defun gnus-request-accept-article (group &optional last method)
+(defun gnus-request-accept-article (group method &optional last)
;; Make sure there's a newline at the end of the article.
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
+ (when (and (not method)
+ (stringp group))
+ (setq method (gnus-find-method-for-group group)))
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
- (let ((func (if (symbolp group) group
- (car (or method (gnus-find-method-for-group group))))))
+ (let ((func (car (or method (gnus-find-method-for-group group)))))
(funcall (intern (format "%s-request-accept-article" func))
(if (stringp group) (gnus-group-real-name group) group)
+ (cadr method)
last)))
(defun gnus-request-replace-article (article group buffer)
article (gnus-group-real-name group) (nth 1 method))))
(defun gnus-request-create-group (group &optional method)
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(let ((method (or method (gnus-find-method-for-group group))))
(funcall (gnus-get-function method 'request-create-group)
(gnus-group-real-name group) (nth 1 method))))
(defun gnus-method-option-p (method option)
"Return non-nil if select METHOD has OPTION as a parameter."
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(memq option (assoc (format "%s" (car method))
gnus-valid-select-methods)))
(let ((info (or info (gnus-get-info group)))
method)
(if (or (not info)
- (not (setq method (gnus-info-method info))))
- (setq method gnus-select-method)
+ (not (setq method (gnus-info-method info)))
+ (equal method "native"))
+ gnus-select-method
(setq method
(cond ((stringp method)
(gnus-server-to-method method))
(gnus-server-extend-method group method))
(t
method)))
- (gnus-server-add-address method)))))
+ (if (equal (cadr method) "")
+ method
+ (gnus-server-add-address method))))))
(defun gnus-check-backend-function (func group)
"Check whether GROUP supports function FUNC."
;;; Active & Newsrc File Handling
;;;
-(defun gnus-setup-news (&optional rawfile level)
+(defun gnus-setup-news (&optional rawfile level dont-connect)
"Setup news information.
If RAWFILE is non-nil, the .newsrc file will also be read.
If LEVEL is non-nil, the news will be set up at level LEVEL."
(let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
- ;; Clear some variables to re-initialize news information.
- (if init (setq gnus-newsrc-alist nil
- gnus-active-hashtb nil))
- ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
- (if init (gnus-read-newsrc-file rawfile))
+ (when init
+ ;; Clear some variables to re-initialize news information.
+ (setq gnus-newsrc-alist nil
+ gnus-active-hashtb nil)
+ ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
+ (gnus-read-newsrc-file rawfile))
(when (and (not (assoc "archive" gnus-server-alist))
gnus-message-archive-method)
(gnus-update-format-specifications)
+ ;; See whether we need to read the description file.
+ (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
+ (not gnus-description-hashtb)
+ (not dont-connect)
+ gnus-read-active-file)
+ (gnus-read-all-descriptions-files))
+
;; Find new newsgroups and treat them.
(if (and init gnus-check-new-newsgroups (not level)
(gnus-check-server gnus-select-method))
(gnus-find-new-newsgroups))
+ ;; We might read in new NoCeM messages here.
+ (when gnus-use-nocem
+ (gnus-nocem-scan-groups))
+
;; Find the number of unread articles in each non-dead group.
(let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
(gnus-get-unread-articles level))
(t
(let ((regs gnus-newsrc-options-n))
(while (and regs
- (not (string-match (car (car regs)) group)))
+ (not (string-match (caar regs) group)))
(setq regs (cdr regs)))
- (and regs (cdr (car regs)))))))
+ (and regs (cdar regs))))))
(defun gnus-ask-server-for-new-groups ()
(let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
(setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
(if (and (not oldlevel)
(consp entry))
- (setq oldlevel (car (cdr (nth 2 entry)))))
+ (setq oldlevel (gnus-info-level (nth 2 entry)))
+ (setq oldlevel (or oldlevel 9)))
(if (stringp previous)
(setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
(setcdr (gnus-gethash (car (nth 3 entry))
gnus-newsrc-hashtb)
(cdr entry)))
- (setcdr (cdr entry) (cdr (cdr (cdr entry))))))))
+ (setcdr (cdr entry) (cdddr entry))))))
;; Finally we enter (if needed) the list where it is supposed to
;; go, and change the subscription level. If it is to be killed,
;; 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 (cdr (car (cdr (cdr entry)))) level)
+ (setcar (cdaddr entry) level)
(if (listp entry)
(setq info (cdr entry)
num (car entry))
(unless previous
(setq previous
(let ((p gnus-newsrc-alist))
- (while (cdr (cdr p))
+ (while (cddr p)
(setq p (cdr p)))
p)))
- (setq entry (cons info (cdr (cdr previous))))
+ (setq entry (cons info (cddr previous)))
(if (cdr previous)
(progn
(setcdr (cdr previous) entry)
(gnus-sethash group (cons num previous)
gnus-newsrc-hashtb))
(when (cdr entry)
- (setcdr (gnus-gethash (car (car (cdr entry))) gnus-newsrc-hashtb)
- entry)))))
+ (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry)))))
(when gnus-group-change-level-function
(funcall gnus-group-change-level-function group level oldlevel)))))
(setcdr killed (delete (car killed) (cdr killed)))
(setq killed (cdr killed)))))
+;; We want to inline a function from gnus-cache, so we cheat here:
+(eval-when-compile
+ (provide 'gnus)
+ (require 'gnus-cache))
+
+(defun gnus-get-unread-articles-in-group (info active &optional update)
+ (when active
+ ;; Allow the backend to update the info in the group.
+ (when (and update
+ (gnus-request-update-info
+ info (gnus-find-method-for-group (gnus-info-group info))))
+ (gnus-activate-group (gnus-info-group info) nil t))
+ (let* ((range (gnus-info-read info))
+ (num 0))
+ ;; If a cache is present, we may have to alter the active info.
+ (when (and gnus-use-cache info)
+ (inline (gnus-cache-possibly-alter-active
+ (gnus-info-group info) active)))
+ ;; Modify the list of read articles according to what articles
+ ;; are available; then tally the unread articles and add the
+ ;; number to the group hash table entry.
+ (cond
+ ((zerop (cdr active))
+ (setq num 0))
+ ((not range)
+ (setq num (- (1+ (cdr active)) (car active))))
+ ((not (listp (cdr range)))
+ ;; Fix a single (num . num) range according to the
+ ;; active hash table.
+ ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
+ (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
+ (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
+ ;; Compute number of unread articles.
+ (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
+ (t
+ ;; The read list is a list of ranges. Fix them according to
+ ;; the active hash table.
+ ;; First peel off any elements that are below the lower
+ ;; active limit.
+ (while (and (cdr range)
+ (>= (car active)
+ (or (and (atom (cadr range)) (cadr range))
+ (caadr range))))
+ (if (numberp (car range))
+ (setcar range
+ (cons (car range)
+ (or (and (numberp (cadr range))
+ (cadr range))
+ (cdadr range))))
+ (setcdr (car range)
+ (or (and (numberp (nth 1 range)) (nth 1 range))
+ (cdadr range))))
+ (setcdr range (cddr range)))
+ ;; Adjust the first element to be the same as the lower limit.
+ (if (and (not (atom (car range)))
+ (< (cdar range) (car active)))
+ (setcdr (car range) (1- (car active))))
+ ;; Then we want to peel off any elements that are higher
+ ;; than the upper active limit.
+ (let ((srange range))
+ ;; Go past all legal elements.
+ (while (and (cdr srange)
+ (<= (or (and (atom (cadr srange))
+ (cadr srange))
+ (caadr srange)) (cdr active)))
+ (setq srange (cdr srange)))
+ (if (cdr srange)
+ ;; Nuke all remaining illegal elements.
+ (setcdr srange nil))
+
+ ;; Adjust the final element.
+ (if (and (not (atom (car srange)))
+ (> (cdar srange) (cdr active)))
+ (setcdr (car srange) (cdr active))))
+ ;; Compute the number of unread articles.
+ (while range
+ (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
+ (cdar range)))
+ (or (and (atom (car range)) (car range))
+ (caar range)))))
+ (setq range (cdr range)))
+ (setq num (max 0 (- (cdr active) num)))))
+ ;; Set the number of unread articles.
+ (when info
+ (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
+ num)))
+
;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
;; and compute how many unread articles there are in each group.
(defun gnus-get-unread-articles (&optional level)
gnus-activate-foreign-newsgroups)
(t 0))
level))
- info group active virtuals method)
+ info group active method)
(gnus-message 5 "Checking new news...")
(while newsrc
- (setq info (car newsrc)
- group (gnus-info-group info)
- active (gnus-active group))
+ (setq active (gnus-active (setq group (gnus-info-group
+ (setq info (pop newsrc))))))
;; Check newsgroups. If the user doesn't want to check them, or
;; they can't be checked (for instance, if the news server can't
(if (and (setq method (gnus-info-method info))
(not (gnus-server-equal
gnus-select-method
- (gnus-server-get-method nil method)))
+ (setq method (gnus-server-get-method nil method))))
(not (gnus-secondary-method-p method)))
;; These groups are foreign. Check the level.
(when (<= (gnus-info-level info) foreign-level)
(setq active (gnus-activate-group group 'scan))
- (gnus-close-group group))
+ (unless (inline (gnus-virtual-group-p group))
+ (inline (gnus-close-group group))))
;; These groups are native or secondary.
(when (and (<= (gnus-info-level info) level)
(not gnus-read-active-file))
(setq active (gnus-activate-group group 'scan))
- (gnus-close-group group)))
+ (inline (gnus-close-group group))))
(if active
- (gnus-get-unread-articles-in-group info active t)
+ (inline (gnus-get-unread-articles-in-group
+ info active
+ (and method
+ (fboundp (intern (concat (symbol-name (car method))
+ "-request-update-info"))))))
;; The group couldn't be reached, so we nix out the number of
;; unread articles and stuff.
(gnus-set-active group nil)
- (setcar (gnus-gethash group gnus-newsrc-hashtb) t))
-
- (setq newsrc (cdr newsrc)))
+ (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
(gnus-message 5 "Checking new news...done")))
(setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
(setq alist
(setq prev (setq gnus-newsrc-alist
- (if (equal (car (car gnus-newsrc-alist))
+ (if (equal (caar gnus-newsrc-alist)
"dummy.group")
gnus-newsrc-alist
(cons (list "dummy.group" 0 nil) alist)))))
(while alist
(gnus-sethash
- (car (car alist))
- (cons (and ohashtb (car (gnus-gethash (car (car alist)) ohashtb)))
+ (caar alist)
+ (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
prev)
gnus-newsrc-hashtb)
(setq prev alist
(setq gnus-killed-hashtb
(gnus-make-hashtable
(+ (length gnus-killed-list) (length gnus-zombie-list))))
- (while lists
- (setq list (symbol-value (car lists)))
- (setq lists (cdr lists))
+ (while (setq list (pop lists))
+ (setq list (symbol-value list))
(while list
- (gnus-sethash (car list) (car list) gnus-killed-hashtb)
- (setq list (cdr list))))))
+ (gnus-sethash (car list) (pop list) gnus-killed-hashtb)))))
-(defun gnus-get-unread-articles-in-group (info active &optional update)
- (when active
- ;; Allow the backend to update the info in the group.
- (when update
- (gnus-request-update-info
- info (gnus-find-method-for-group (gnus-info-group info))))
- (let* ((range (gnus-info-read info))
- (num 0)
- (marked (gnus-info-marks info)))
- ;; If a cache is present, we may have to alter the active info.
- (and gnus-use-cache
- (gnus-cache-possibly-alter-active (gnus-info-group info) active))
- ;; Modify the list of read articles according to what articles
- ;; are available; then tally the unread articles and add the
- ;; number to the group hash table entry.
- (cond
- ((zerop (cdr active))
- (setq num 0))
- ((not range)
- (setq num (- (1+ (cdr active)) (car active))))
- ((not (listp (cdr range)))
- ;; Fix a single (num . num) range according to the
- ;; active hash table.
- ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
- (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
- (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
- ;; Compute number of unread articles.
- (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
- (t
- ;; The read list is a list of ranges. Fix them according to
- ;; the active hash table.
- ;; First peel off any elements that are below the lower
- ;; active limit.
- (while (and (cdr range)
- (>= (car active)
- (or (and (atom (car (cdr range))) (car (cdr range)))
- (car (car (cdr range))))))
- (if (numberp (car range))
- (setcar range
- (cons (car range)
- (or (and (numberp (car (cdr range)))
- (car (cdr range)))
- (cdr (car (cdr range))))))
- (setcdr (car range)
- (or (and (numberp (nth 1 range)) (nth 1 range))
- (cdr (car (cdr range))))))
- (setcdr range (cdr (cdr range))))
- ;; Adjust the first element to be the same as the lower limit.
- (if (and (not (atom (car range)))
- (< (cdr (car range)) (car active)))
- (setcdr (car range) (1- (car active))))
- ;; Then we want to peel off any elements that are higher
- ;; than the upper active limit.
- (let ((srange range))
- ;; Go past all legal elements.
- (while (and (cdr srange)
- (<= (or (and (atom (car (cdr srange)))
- (car (cdr srange)))
- (car (car (cdr srange)))) (cdr active)))
- (setq srange (cdr srange)))
- (if (cdr srange)
- ;; Nuke all remaining illegal elements.
- (setcdr srange nil))
-
- ;; Adjust the final element.
- (if (and (not (atom (car srange)))
- (> (cdr (car srange)) (cdr active)))
- (setcdr (car srange) (cdr active))))
- ;; Compute the number of unread articles.
- (while range
- (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
- (cdr (car range))))
- (or (and (atom (car range)) (car range))
- (car (car range))))))
- (setq range (cdr range)))
- (setq num (max 0 (- (cdr active) num)))))
- ;; Set the number of unread articles.
- (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)
- num)))
-
-(defun gnus-activate-group (group &optional scan)
+(defun gnus-activate-group (group &optional scan dont-check)
;; Check whether a group has been activated or not.
;; If SCAN, request a scan of that group as well.
(let ((method (gnus-find-method-for-group group))
(gnus-request-scan group method))
t)
(condition-case ()
- (gnus-request-group group)
+ (gnus-request-group group dont-check)
; (error nil)
(quit nil))
(save-excursion
(let* ((active (or gnus-newsgroup-active (gnus-active group)))
(entry (gnus-gethash group gnus-newsrc-hashtb))
(info (nth 2 entry))
- (marked (gnus-info-marks info))
(prev 1)
(unread (sort (copy-sequence unread) '<))
read)
(concat " from " where) "")
(car method))))
(gnus-message 5 mesg)
- (if (not (gnus-check-server method))
- ()
+ (when (gnus-check-server method)
;; Request that the backend scan its incoming messages.
(and (gnus-check-backend-function 'request-scan (car method))
(gnus-request-scan nil method))
(gnus-check-backend-function 'retrieve-groups (car method)))
(let ((newsrc (cdr gnus-newsrc-alist))
(gmethod (gnus-server-get-method nil method))
- groups)
- (while newsrc
- (and (gnus-server-equal
- (gnus-find-method-for-group
- (car (car newsrc)) (car newsrc))
- gmethod)
- (setq groups (cons (gnus-group-real-name
- (car (car newsrc))) groups)))
- (setq newsrc (cdr newsrc)))
- (gnus-check-server method)
- (setq list-type (gnus-retrieve-groups groups method))
- (cond
- ((not list-type)
- (gnus-message
- 1 "Cannot read partial active file from %s server."
- (car method))
- (ding)
- (sit-for 2))
- ((eq list-type 'active)
- (gnus-active-to-gnus-format method gnus-active-hashtb))
- (t
- (gnus-groups-to-gnus-format method gnus-active-hashtb)))))
+ groups info)
+ (while (setq info (pop newsrc))
+ (when (gnus-server-equal
+ (gnus-find-method-for-group
+ (gnus-info-group info) info)
+ gmethod)
+ (push (gnus-group-real-name (gnus-info-group info))
+ groups)))
+ (when groups
+ (gnus-check-server method)
+ (setq list-type (gnus-retrieve-groups groups method))
+ (cond
+ ((not list-type)
+ (gnus-message
+ 1 "Cannot read partial active file from %s server."
+ (car method))
+ (ding)
+ (sit-for 2))
+ ((eq list-type 'active)
+ (gnus-active-to-gnus-format method gnus-active-hashtb))
+ (t
+ (gnus-groups-to-gnus-format method gnus-active-hashtb))))))
(t
(if (not (gnus-request-list method))
(progn
(if (equal method gnus-select-method)
(gnus-make-hashtable
(count-lines (point-min) (point-max)))
- (gnus-make-hashtable 4096))))))
- (flag-hashtb (gnus-make-hashtable 60)))
+ (gnus-make-hashtable 4096)))))))
;; Delete unnecessary lines.
(goto-char (point-min))
(while (search-forward "\nto." nil t)
;; file (ticked articles, killed groups, foreign methods, etc.)
(gnus-read-newsrc-el-file quick-file)
- (if (or force
- (and (file-newer-than-file-p newsrc-file quick-file)
- (file-newer-than-file-p newsrc-file
- (concat quick-file "d")))
- (not gnus-newsrc-alist))
+ (if (and (file-exists-p gnus-current-startup-file)
+ (or force
+ (and (file-newer-than-file-p newsrc-file quick-file)
+ (file-newer-than-file-p newsrc-file
+ (concat quick-file "d")))
+ (not gnus-newsrc-alist)))
;; We read the .newsrc file. Note that if there if a
;; .newsrc.eld file exists, it has already been read, and
;; the `gnus-newsrc-hashtb' has been created. While reading
;; Parse the old-style quick startup file
(defun gnus-read-old-newsrc-el-file (file)
- (let (newsrc killed marked group m)
+ (let (newsrc killed marked group m info)
(prog1
(let ((gnus-killed-assoc nil)
gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
killed gnus-killed-assoc
marked gnus-marked-assoc)))
(setq gnus-newsrc-alist nil)
- (while newsrc
- (setq group (car newsrc))
- (let ((info (gnus-get-info (car group))))
- (if info
- (progn
- (gnus-info-set-read info (cdr (cdr group)))
- (gnus-info-set-level
- info (if (nth 1 group) gnus-level-default-subscribed
- gnus-level-default-unsubscribed))
- (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
- (setq gnus-newsrc-alist
- (cons
- (setq info
- (list (car group)
- (if (nth 1 group) gnus-level-default-subscribed
- gnus-level-default-unsubscribed)
- (cdr (cdr group))))
- gnus-newsrc-alist)))
- (if (setq m (assoc (car group) marked))
- (gnus-info-set-marks
- info (cons (list (cons 'tick (gnus-compress-sequence
- (sort (cdr m) '<) t)))
- nil))))
- (setq newsrc (cdr newsrc)))
+ (while (setq info (gnus-get-info (setq group (pop newsrc))))
+ (if info
+ (progn
+ (gnus-info-set-read info (cddr group))
+ (gnus-info-set-level
+ info (if (nth 1 group) gnus-level-default-subscribed
+ gnus-level-default-unsubscribed))
+ (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
+ (push (setq info
+ (list (car group)
+ (if (nth 1 group) gnus-level-default-subscribed
+ gnus-level-default-unsubscribed)
+ (cddr group)))
+ gnus-newsrc-alist))
+ ;; Copy marks into info.
+ (when (setq m (assoc (car group) marked))
+ (unless (nthcdr 3 info)
+ (nconc info (list nil)))
+ (gnus-info-set-marks
+ info (list (cons 'tick (gnus-compress-sequence
+ (sort (cdr m) '<) t))))))
(setq newsrc killed)
(while newsrc
- (setcar newsrc (car (car newsrc)))
+ (setcar newsrc (caar newsrc))
(setq newsrc (cdr newsrc)))
(setq gnus-killed-list killed))
;; The .el file version of this variable does not begin with
entry mentry)
(while rc
(or (null (nth 4 (car rc))) ; It's a native group.
- (assoc (car (car rc)) newsrc) ; It's already in the alist.
- (if (setq entry (assoc (car (car prev)) newsrc))
+ (assoc (caar rc) newsrc) ; It's already in the alist.
+ (if (setq entry (assoc (caar prev) newsrc))
(setcdr (setq mentry (memq entry newsrc))
(cons (car rc) (cdr mentry)))
(setq newsrc (cons (car rc) newsrc))))
(while variables
(when (and (boundp (setq variable (pop variables)))
(symbol-value variable))
- (insert "(setq " (symbol-name variable) " '"
- (prin1-to-string (symbol-value variable)) ")\n")))))
+ (insert "(setq " (symbol-name variable) " '")
+ (prin1 (symbol-value variable) (current-buffer))
+ (insert ")\n")))))
(defun gnus-gnus-to-newsrc-format ()
;; Generate and save the .newsrc file.
- (let ((newsrc (cdr gnus-newsrc-alist))
- info ranges range)
- (save-excursion
- (set-buffer (create-file-buffer gnus-current-startup-file))
+ (save-excursion
+ (set-buffer (create-file-buffer gnus-current-startup-file))
+ (let ((newsrc (cdr gnus-newsrc-alist))
+ (standard-output (current-buffer))
+ info ranges range method)
(setq buffer-file-name gnus-current-startup-file)
(buffer-disable-undo (current-buffer))
(erase-buffer)
;; Write options.
(if gnus-newsrc-options (insert gnus-newsrc-options))
;; Write subscribed and unsubscribed.
- (while newsrc
- (setq info (car newsrc))
- (if (not (gnus-info-method info))
- ;; Don't write foreign groups to .newsrc.
- (progn
- (insert (gnus-info-group info)
- (if (> (gnus-info-level info) gnus-level-subscribed)
- "!" ":"))
- (if (setq ranges (gnus-info-read info))
- (progn
- (insert " ")
- (if (not (listp (cdr ranges)))
- (if (= (car ranges) (cdr ranges))
- (insert (int-to-string (car ranges)))
- (insert (int-to-string (car ranges)) "-"
- (int-to-string (cdr ranges))))
- (while ranges
- (setq range (car ranges)
- ranges (cdr ranges))
- (if (or (atom range) (= (car range) (cdr range)))
- (insert (int-to-string
- (or (and (atom range) range)
- (car range))))
- (insert (int-to-string (car range)) "-"
- (int-to-string (cdr range))))
- (if ranges (insert ","))))))
- (insert "\n")))
- (setq newsrc (cdr newsrc)))
+ (while (setq info (pop newsrc))
+ ;; Don't write foreign groups to .newsrc.
+ (when (or (null (setq method (gnus-info-method info)))
+ (equal method "native")
+ (gnus-server-equal method gnus-select-method))
+ (insert (gnus-info-group info)
+ (if (> (gnus-info-level info) gnus-level-subscribed)
+ "!" ":"))
+ (when (setq ranges (gnus-info-read info))
+ (insert " ")
+ (if (not (listp (cdr ranges)))
+ (if (= (car ranges) (cdr ranges))
+ (princ (car ranges))
+ (princ (car ranges))
+ (insert "-")
+ (princ (cdr ranges)))
+ (while (setq range (pop ranges))
+ (if (or (atom range) (= (car range) (cdr range)))
+ (princ (or (and (atom range) range) (car range)))
+ (princ (car range))
+ (insert "-")
+ (princ (cdr range)))
+ (if ranges (insert ",")))))
+ (insert "\n")))
(make-local-variable 'version-control)
(setq version-control 'never)
;; It has been reported that sometime the modtime on the .newsrc
(list (nth 5 (file-attributes file)) file))
slave-files)
(lambda (f1 f2)
- (or (< (car (car f1)) (car (car f2)))
+ (or (< (caar f1) (caar f2))
(< (nth 1 (car f1)) (nth 1 (car f2)))))))
(while slave-files
(erase-buffer)
(unless gnus-backlog-hashtb
(setq gnus-backlog-hashtb (make-vector 1023 0))))
+(gnus-add-shutdown 'gnus-backlog-shutdown 'gnus)
+
(defun gnus-backlog-shutdown ()
"Clear all backlog variables and buffers."
(when (get-buffer gnus-backlog-buffer)
(1+ (point)) 'gnus-backlog nil (point-max)))))))
(defun gnus-backlog-request-article (group number buffer)
- (gnus-backlog-setup)
- (let ((ident (intern (concat group ":" (int-to-string number))
- gnus-backlog-hashtb))
- beg end)
- (when (memq ident gnus-backlog-articles)
- ;; It was in the backlog.
- (save-excursion
- (set-buffer (gnus-backlog-buffer))
- (if (not (setq beg (text-property-any
- (point-min) (point-max) 'gnus-backlog
- ident)))
- ;; It wasn't in the backlog after all.
- (ignore
- (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
- ;; 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)))))
- (let ((buffer-read-only nil))
- (erase-buffer)
- (insert-buffer-substring gnus-backlog-buffer beg end)
- t))))
+ (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)
+ ;; It was in the backlog.
+ (save-excursion
+ (set-buffer (gnus-backlog-buffer))
+ (if (not (setq beg (text-property-any
+ (point-min) (point-max) 'gnus-backlog
+ ident)))
+ ;; It wasn't in the backlog after all.
+ (ignore
+ (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
+ ;; 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)))))
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (insert-buffer-substring gnus-backlog-buffer beg end)
+ t)))))
;; Allow redefinition of Gnus functions.
projects / gnus / blobdiff