(eval-when-compile (require 'cl))
-;;;###autoload
(defvar gnus-directory (or (getenv "SAVEDIR") "~/News/")
"*Directory variable from which all other Gnus file variables are derived.")
(defvar gnus-group-faq-directory
'("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
"/ftp@sunsite.auc.dk:/pub/usenet/"
+ "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
"/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
"/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
"/ftp@rtfm.mit.edu:/pub/usenet/"
("nneething" none address prompt-address)
("nndoc" none address prompt-address)
("nnbabyl" mail address respool)
- ("nnkiboze" post address virtual)
+ ("nnkiboze" post virtual)
("nnsoup" post-mail address)
("nndraft" post-mail)
("nnfolder" mail respool address))
(?A gnus-tmp-article-number ?d)
(?Z gnus-tmp-unread-and-unselected ?s)
(?V gnus-version ?s)
- (?U gnus-tmp-unread ?d)
+ (?U gnus-tmp-unread-and-unticked ?d)
(?S gnus-tmp-subject ?s)
(?e gnus-tmp-unselected ?d)
(?u gnus-tmp-user-defined ?s)
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version-number "5.2.19"
+(defconst gnus-version-number "5.2.25"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Gnus v%s" gnus-version-number)
(defvar gnus-info-nodes
'((gnus-group-mode "(gnus)The Group Buffer")
(gnus-summary-mode "(gnus)The Summary Buffer")
- (gnus-article-mode "(gnus)The Article Buffer"))
+ (gnus-article-mode "(gnus)The Article Buffer")
+ (gnus-server-mode "(gnus)The Server Buffer")
+ (gnus-browse-mode "(gnus)Browse Foreign Server")
+ (gnus-tree-mode "(gnus)Tree Display")
+ )
"Alist of major modes and related Info nodes.")
(defvar gnus-group-buffer "*Group*")
(while gnus-buffer-list
(gnus-kill-buffer (pop gnus-buffer-list)))
;; Remove Gnus frames.
+ (gnus-kill-gnus-frames))
+
+(defun gnus-kill-gnus-frames ()
+ "Kill all frames Gnus has created."
(while gnus-created-frames
(when (frame-live-p (car gnus-created-frames))
;; We slap a condition-case around this `delete-frame' to ensure
- ;; agains errors if we try do delete the single frame that's left.
+ ;; against errors if we try do delete the single frame that's left.
(condition-case ()
(delete-frame (car gnus-created-frames))
(error nil)))
(or (not (numberp (nth i elem)))
(zerop (nth i elem))
(progn
- (setq perc (/ (float (nth 0 elem)) total))
+ (setq perc (if (= i 2)
+ 1.0
+ (/ (float (nth 0 elem)) total)))
(setq out (cons (if (eq pbuf (nth i types))
- (vector (nth i types) perc 'point)
- (vector (nth i types) perc))
+ (list (nth i types) perc 'point)
+ (list (nth i types) perc))
out))))
(setq i (1+ i)))
- (list (nreverse out)))))
+ `(vertical 1.0 ,@(nreverse out)))))
;;;###autoload
(defun gnus-add-configuration (conf)
(remove-text-properties b e gnus-hidden-properties)
(when (memq 'intangible gnus-hidden-properties)
(gnus-put-text-property (max (1- b) (point-min))
- b 'intangible nil)))
+ b 'intangible nil)))
(defun gnus-hide-text-type (b e type)
"Hide text of TYPE between B and E."
(group (gnus-group-group-name))
(entry (and group (gnus-gethash group gnus-newsrc-hashtb)))
gnus-group-indentation)
- (and entry
- (not (gnus-ephemeral-group-p group))
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (prin1-to-string (nth 2 entry)) ")")))
- (setq gnus-group-indentation (gnus-group-group-indentation))
- (gnus-delete-line)
- (gnus-group-insert-group-line-info group)
- (forward-line -1)
- (gnus-group-position-point)))
+ (when group
+ (and entry
+ (not (gnus-ephemeral-group-p group))
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (prin1-to-string (nth 2 entry)) ")")))
+ (setq gnus-group-indentation (gnus-group-group-indentation))
+ (gnus-delete-line)
+ (gnus-group-insert-group-line-info group)
+ (forward-line -1)
+ (gnus-group-position-point))))
(defun gnus-group-insert-group-line-info (group)
"Insert GROUP on the current line."
(max-len 60)
gnus-tmp-header ;Dummy binding for user-defined formats
;; Get the resulting string.
+ (modified
+ (and gnus-dribble-buffer
+ (buffer-name gnus-dribble-buffer)
+ (buffer-modified-p gnus-dribble-buffer)
+ (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (not (zerop (buffer-size))))))
(mode-string (eval gformat)))
;; Say whether the dribble buffer has been modified.
(setq mode-line-modified
- (if (and gnus-dribble-buffer
- (buffer-name gnus-dribble-buffer)
- (buffer-modified-p gnus-dribble-buffer)
- (save-excursion
- (set-buffer gnus-dribble-buffer)
- (not (zerop (buffer-size)))))
- "---*- " "----- "))
+ (if modified "---*- " "----- "))
;; If the line is too long, we chop it off.
(when (> (length mode-string) max-len)
(setq mode-string (substring mode-string 0 (- max-len 4))))
(prog1
(setq mode-line-buffer-identification
- (list mode-string))
- (set-buffer-modified-p t))))))
+ (gnus-mode-line-buffer-identification
+ (list mode-string)))
+ (set-buffer-modified-p modified))))))
(defun gnus-group-group-name ()
"Get the name of the newsgroup on the current line."
t))
(defun gnus-group-delete-group (group &optional force)
- "Delete the current group.
+ "Delete the current group. Only meaningful with mail groups.
If FORCE (the prefix) is non-nil, all the articles in the group will
be deleted. This is \"deleted\" as in \"removed forever from the face
-of the Earth\". There is no undo."
+of the Earth\". There is no undo. The user will be prompted before
+doing the deletion."
(interactive
(list (gnus-group-group-name)
current-prefix-arg))
(gnus-uncompress-sequence (cdr expirable)) group))
;; Just expire using the normal expiry values.
(gnus-request-expire-articles
- (gnus-uncompress-sequence (cdr expirable)) group)))))
+ (gnus-uncompress-sequence (cdr expirable)) group))))
+ (gnus-close-group group))
(gnus-message 6 "Expiring articles in %s...done" group)))
(gnus-group-position-point))))
(interactive)
(run-hooks 'gnus-suspend-gnus-hook)
;; Kill Gnus buffers except for group mode buffer.
- (let ((group-buf (get-buffer gnus-group-buffer)))
- ;; Do this on a separate list in case the user does a ^G before we finish
- (let ((gnus-buffer-list
- (delq group-buf (delq gnus-dribble-buffer
- (append gnus-buffer-list nil)))))
- (while gnus-buffer-list
- (gnus-kill-buffer (car gnus-buffer-list))
- (setq gnus-buffer-list (cdr gnus-buffer-list))))
- (if group-buf
- (progn
- (setq gnus-buffer-list (list group-buf))
- (bury-buffer group-buf)
- (delete-windows-on group-buf t)))))
+ (let* ((group-buf (get-buffer gnus-group-buffer))
+ ;; Do this on a separate list in case the user does a ^G before we finish
+ (gnus-buffer-list
+ (delete group-buf (delete gnus-dribble-buffer
+ (append gnus-buffer-list nil)))))
+ (while gnus-buffer-list
+ (gnus-kill-buffer (pop gnus-buffer-list)))
+ (gnus-kill-gnus-frames)
+ (when group-buf
+ (setq gnus-buffer-list (list group-buf))
+ (bury-buffer group-buf)
+ (delete-windows-on group-buf t))))
(defun gnus-group-clear-dribble ()
"Clear all information from the dribble buffer."
gnus-cached-mark)
((memq number gnus-newsgroup-replied)
gnus-replied-mark)
+ ((memq number gnus-newsgroup-saved)
+ gnus-saved-mark)
(t gnus-unread-mark))
gnus-tmp-from (mail-header-from gnus-tmp-header)
gnus-tmp-name
;; Adjust assocs.
((memq mark '(score bookmark))
(while articles
- (when (or (< (car (setq article (pop articles))) min)
+ (when (or (not (consp (setq article (pop articles))))
+ (< (car article) min)
(> (car article) max))
(set var (delq article (symbol-value var))))))))))
(car type))))))
(push (cons (cdr type)
(if (memq (cdr type) uncompressed) list
- (gnus-compress-sequence (set symbol (sort list '<)) t)))
+ (gnus-compress-sequence
+ (set symbol (sort list '<)) t)))
newmarked)))
;; Enter these new marks into the info of the group.
;; Pad the mode string a bit.
(setq mode-string (format (format "%%-%ds" max-len) mode-string))))
;; Update the mode line.
- (setq mode-line-buffer-identification (list mode-string))
+ (setq mode-line-buffer-identification
+ (gnus-mode-line-buffer-identification
+ (list mode-string)))
(set-buffer-modified-p t))))
(defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
(equal (nth 1 m1) (nth 1 m2)))))))
(defsubst gnus-header-value ()
- (buffer-substring
- (match-end 0)
- (if (re-search-forward "^[^ \t]" nil t)
- (progn
- (backward-char 2)
- (point))
- (gnus-point-at-eol))))
+ (buffer-substring (match-end 0) (gnus-point-at-eol)))
(defvar gnus-newsgroup-none-id 0)
the list of process marked articles, and the current article will be
taken into consideration."
(cond
- ((and n (numberp n))
+ (n
;; A numerical prefix has been given.
(let ((backward (< n 0))
- (n (abs n))
+ (n (abs (prefix-numeric-value n)))
articles article)
(save-excursion
(while
The prefix argument ALL means to select all articles."
(interactive "P")
(gnus-set-global-variables)
+ (when (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (error "Ephemeral groups can't be reselected"))
(let ((current-subject (gnus-summary-article-number))
(group gnus-newsgroup-name))
(setq gnus-newsgroup-begin nil)
(save-excursion
(gnus-group-get-new-news-this-group 1)))
(gnus-group-read-group all t)
- (gnus-summary-goto-subject current-subject)))
+ (gnus-summary-goto-subject current-subject nil t)))
(defun gnus-summary-rescan-group (&optional all)
"Exit the newsgroup, ask for new articles, and select the newsgroup."
articles prefix))
(set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
(setq to-method (or select-method
- (gnus-find-method-for-group to-newsgroup)))
+ (gnus-group-name-to-method 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)))
gnus-newsgroup-name)))))
(method
(gnus-completing-read
- methname "What backend do you want to use when? "
+ methname "What backend do you want to use when respooling?"
methods nil t nil 'gnus-method-history))
ms)
(cond
(defun gnus-summary-mark-forward (n &optional mark no-expire)
"Mark N articles as read forwards.
-If N is negative, mark backwards instead.
-Mark with MARK. If MARK is ? , ?! or ??, articles will be
-marked as unread.
+If N is negative, mark backwards instead. Mark with MARK, ?r by default.
The difference between N and the actual number of articles marked is
returned."
(interactive "p")
(defun gnus-summary-mark-article-as-unread (mark)
"Mark the current article quickly as unread with MARK."
(let ((article (gnus-summary-article-number)))
- (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
- (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
- (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
- (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
- (cond ((= mark gnus-ticked-mark)
- (push article gnus-newsgroup-marked))
- ((= mark gnus-dormant-mark)
- (push article gnus-newsgroup-dormant))
- (t
- (push article gnus-newsgroup-unreads)))
- (setq gnus-newsgroup-reads
- (delq (assq article gnus-newsgroup-reads)
- gnus-newsgroup-reads))
-
- ;; See whether the article is to be put in the cache.
- (and gnus-use-cache
- (vectorp (gnus-summary-article-header article))
- (save-excursion
- (gnus-cache-possibly-enter-article
- gnus-newsgroup-name article
- (gnus-summary-article-header article)
- (= mark gnus-ticked-mark)
- (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
-
- ;; Fix the mark.
- (gnus-summary-update-mark mark 'unread)
+ (if (< article 0)
+ (gnus-error 1 "Unmarkable article")
+ (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
+ (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
+ (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
+ (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
+ (cond ((= mark gnus-ticked-mark)
+ (push article gnus-newsgroup-marked))
+ ((= mark gnus-dormant-mark)
+ (push article gnus-newsgroup-dormant))
+ (t
+ (push article gnus-newsgroup-unreads)))
+ (setq gnus-newsgroup-reads
+ (delq (assq article gnus-newsgroup-reads)
+ gnus-newsgroup-reads))
+
+ ;; See whether the article is to be put in the cache.
+ (and gnus-use-cache
+ (vectorp (gnus-summary-article-header article))
+ (save-excursion
+ (gnus-cache-possibly-enter-article
+ gnus-newsgroup-name article
+ (gnus-summary-article-header article)
+ (= mark gnus-ticked-mark)
+ (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
+
+ ;; Fix the mark.
+ (gnus-summary-update-mark mark 'unread))
t))
(defun gnus-summary-mark-article (&optional article mark no-expire)
If the prefix argument is negative, tick articles instead."
(interactive "P")
(gnus-set-global-variables)
- (if unmark
- (setq unmark (prefix-numeric-value unmark)))
+ (when unmark
+ (setq unmark (prefix-numeric-value unmark)))
(let ((articles (gnus-summary-articles-in-thread)))
(save-excursion
;; Expand the thread.
(gnus-activate-group to-newsgroup)
(if (gnus-y-or-n-p (format "No such group: %s. Create it? "
to-newsgroup))
- (or (gnus-request-create-group to-newsgroup)
+ (or (and (gnus-request-create-group
+ to-newsgroup (gnus-group-name-to-method to-newsgroup))
+ (gnus-activate-group to-newsgroup nil nil
+ (gnus-group-name-to-method
+ to-newsgroup)))
(error "Couldn't create group %s" to-newsgroup)))
(error "No such group: %s" to-newsgroup)))
to-newsgroup))
default-name))
;; A single split name was found
((= 1 (length split-name))
- (read-file-name
- (concat prompt " (default " (car split-name) ") ")
- gnus-article-save-directory
- (concat gnus-article-save-directory (car split-name))))
+ (let* ((name (car split-name))
+ (dir (cond ((file-directory-p name)
+ (file-name-as-directory name))
+ ((file-exists-p name) name)
+ (t gnus-article-save-directory))))
+ (read-file-name
+ (concat prompt " (default " name ") ")
+ dir name)))
;; A list of splits was found.
(t
(setq split-name (nreverse split-name))
(t (gnus-read-save-file-name
"Save body in file:" default-name))))
(gnus-make-directory (file-name-directory filename))
- (gnus-eval-in-buffer-window gnus-article-buffer
+ (gnus-eval-in-buffer-window gnus-original-article-buffer
(save-excursion
(save-restriction
(widen)
(erase-buffer)
(insert "$ " command "\n\n")
(if gnus-view-pseudo-asynchronously
- (start-process "gnus-execute" nil "sh" "-c" command)
- (call-process "sh" nil t nil "-c" command)))))
+ (start-process "gnus-execute" nil shell-file-name
+ shell-command-switch command)
+ (call-process shell-file-name nil t nil
+ shell-command-switch command)))))
(defun gnus-copy-file (file &optional to)
"Copy FILE to TO."
"\r" gnus-article-press-button
"\t" gnus-article-next-button
"\M-\t" gnus-article-prev-button
+ "<" beginning-of-buffer
+ ">" end-of-buffer
"\C-c\C-b" gnus-bug)
(substitute-key-definition
;; We have found the header.
header
;; We have to really fetch the header to this article.
- (when (setq where
- (if (gnus-check-backend-function 'request-head group)
- (gnus-request-head id group)
- (gnus-request-article id group)))
+ (when (setq where (gnus-request-head id group))
(save-excursion
(set-buffer nntp-server-buffer)
- (and (search-forward "\n\n" nil t)
- (delete-region (1- (point)) (point-max)))
(goto-char (point-max))
(insert ".\n")
(goto-char (point-min))
(let ((process-connection-type nil))
(process-kill-without-query
(start-process
- "gnus-x-face" nil "sh" "-c" gnus-article-x-face-command))
+ "gnus-x-face" nil shell-file-name shell-command-switch
+ gnus-article-x-face-command))
(process-send-region "gnus-x-face" beg end)
(process-send-eof "gnus-x-face")))))))))
(unless silent
(message ""))))))
-(defun gnus-get-function (method function)
+(defun gnus-get-function (method function &optional noerror)
"Return a function symbol based on METHOD and FUNCTION."
;; Translate server names into methods.
(unless method
;; question.
(unless (fboundp func)
(require (car method))
- (unless (fboundp func)
+ (when (and (not (fboundp func))
+ (not noerror))
;; This backend doesn't implement this function.
(error "No such function: %s" func)))
func))
(defun gnus-request-head (article group)
"Request the head of ARTICLE in GROUP."
- (let ((method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function method 'request-head)
- article (gnus-group-real-name group) (nth 1 method))))
+ (let* ((method (gnus-find-method-for-group group))
+ (head (gnus-get-function method 'request-head t)))
+ (if (fboundp head)
+ (funcall head article (gnus-group-real-name group) (nth 1 method))
+ (let ((res (gnus-request-article article group)))
+ (when res
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (delete-region (1- (point)) (point-max)))
+ (nnheader-fold-continuation-lines)))
+ res))))
(defun gnus-request-body (article group)
"Request the body of ARTICLE in GROUP."
(setq method (gnus-server-to-method method)))
(when (and (not method)
(stringp group))
- (setq method (gnus-find-method-for-group group)))
+ (setq method (gnus-group-name-to-method group)))
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
(setcar (cdr entry) (concat (nth 1 entry) "+" group))
(nconc entry (cdr method))))
+(defun gnus-group-name-to-method (group)
+ "Return a select method suitable for GROUP."
+ (if (string-match ":" group)
+ (let ((server (substring group 0 (match-beginning 0))))
+ (if (string-match "\\+" server)
+ (list (intern (substring server 0 (match-beginning 0)))
+ (substring server (match-end 0)))
+ (list (intern server) "")))
+ gnus-select-method))
+
(defun gnus-find-method-for-group (group &optional info)
"Find the select method that GROUP uses."
(or gnus-override-method
(while list
(gnus-sethash (car list) (pop list) gnus-killed-hashtb)))))
-(defun gnus-activate-group (group &optional scan dont-check)
+(defun gnus-activate-group (group &optional scan dont-check method)
;; 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))
+ (let ((method (or method (gnus-find-method-for-group group)))
active)
(and (gnus-check-server method)
;; We escape all bugs and quit here to make it possible to
(gnus-request-scan group method))
t)
(condition-case ()
- (gnus-request-group group dont-check)
+ (gnus-request-group group dont-check method)
; (error nil)
(quit nil))
(save-excursion
projects / gnus / blobdiff