(browse-carpal . gnus-carpal-browse-buffer)
(edit-score . gnus-score-edit-buffer)
(message . gnus-message-buffer)
+ (mail . gnus-message-buffer)
+ (post-news . gnus-message-buffer)
(faq . gnus-faq-buffer)
(picons . "*Picons*")
(tree . gnus-tree-buffer)
(defvar gnus-parse-headers-hook nil
"*A hook called before parsing the headers.")
+(add-hook 'gnus-parse-headers-hook 'gnus-decode-rfc1522)
(defvar gnus-exit-group-hook nil
"*A hook called when exiting (not quitting) summary mode.")
(remove-hook 'gnus-summary-prepare-hook
'hilit-rehighlight-buffer-quietly)
(remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
- (setq gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read))
+ (setq gnus-mark-article-hook
+ '(gnus-summary-mark-read-and-unread-as-read))
(remove-hook 'gnus-article-prepare-hook
'hilit-rehighlight-buffer-quietly)))
\f
;; Internal variables
+(defvar gnus-tree-buffer "*Tree*"
+ "Buffer where Gnus thread trees are displayed.")
+
+;; Dummy variable.
+(defvar gnus-use-generic-from nil)
+
+(defvar gnus-thread-indent-array nil)
+(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
+
+(defvar gnus-newsrc-file-version nil)
+
+(defvar gnus-method-history nil)
+;; Variable holding the user answers to all method prompts.
+
+(defvar gnus-group-history nil)
+;; Variable holding the user answers to all group prompts.
+
(defvar gnus-server-alist nil
"List of available servers.")
(defvar gnus-opened-servers nil)
(defvar gnus-current-move-group nil)
+(defvar gnus-current-copy-group nil)
+(defvar gnus-current-crosspost-group nil)
(defvar gnus-newsgroup-dependencies nil)
(defvar gnus-newsgroup-async nil)
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.73"
+(defconst gnus-version "September Gnus v0.86"
"Version number for this version of Gnus.")
(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-group-mode "(gnus)The Group Buffer")
+ (gnus-summary-mode "(gnus)The Summary Buffer")
+ (gnus-article-mode "(gnus)The Article Buffer"))
"Assoc list of major modes and related Info nodes.")
(defvar gnus-group-buffer "*Group*")
("gnus-srvr" gnus-browse-foreign-server)
("gnus-cite" :interactive t
gnus-article-highlight-citation gnus-article-hide-citation-maybe
- gnus-article-hide-citation gnus-article-fill-cited-article)
+ gnus-article-hide-citation gnus-article-fill-cited-article
+ gnus-article-hide-citation-in-followups)
("gnus-kill" gnus-kill gnus-apply-kill-file-internal
gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
gnus-execute gnus-expunge)
(defun gnus-update-summary-mark-positions ()
"Compute where the summary marks are to go."
(save-excursion
+ (when (and gnus-summary-buffer
+ (get-buffer gnus-summary-buffer)
+ (buffer-name (get-buffer gnus-summary-buffer)))
+ (set-buffer gnus-summary-buffer))
(let ((gnus-replied-mark 129)
(gnus-score-below-mark 130)
(gnus-score-over-mark 130)
(thread nil)
(gnus-visual nil)
+ (spec gnus-summary-line-format-spec)
pos)
- (gnus-set-work-buffer)
- (gnus-summary-insert-line
- [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1)
- (goto-char (point-min))
- (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
- (- (point) 2)))))
- (goto-char (point-min))
- (push (cons 'replied (and (search-forward "\201" nil t) (- (point) 2)))
- pos)
- (goto-char (point-min))
- (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2)))
- pos)
+ (save-excursion
+ (gnus-set-work-buffer)
+ (let ((gnus-summary-line-format-spec spec))
+ (gnus-summary-insert-line
+ [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1)
+ (goto-char (point-min))
+ (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
+ (- (point) 2)))))
+ (goto-char (point-min))
+ (push (cons 'replied (and (search-forward "\201" nil t)
+ (- (point) 2)))
+ pos)
+ (goto-char (point-min))
+ (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2)))
+ pos)))
(setq gnus-summary-mark-positions pos))))
(defun gnus-update-group-mark-positions ()
(save-excursion
(let ((gnus-process-mark 128)
- (gnus-group-marked '("dummy.group")))
+ (gnus-group-marked '("dummy.group"))
+ (gnus-active-hashtb (make-vector 10 0)))
(gnus-set-active "dummy.group" '(0 . 0))
(gnus-set-work-buffer)
(gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
(not (or (string< s1 s2)
(string= s1 s2))))
+(defun gnus-read-active-file-p ()
+ "Say whether the active file has been read from `gnus-select-method'."
+ (memq gnus-select-method gnus-have-read-active-file))
+
;;; General various misc type functions.
(defun gnus-clear-system ()
(push group groups)))
(nreverse groups)))
+(defun gnus-completing-read (default prompt &rest args)
+ ;; Like `completing-read', except that DEFAULT is the default argument.
+ (let* ((prompt (if default
+ (concat prompt " (default " default ") ")
+ (concat prompt " ")))
+ (answer (apply 'completing-read prompt args)))
+ (if (or (null answer) (zerop (length answer)))
+ default
+ answer)))
+
;; Two silly functions to ensure that all `y-or-n-p' questions clear
;; the echo area.
(defun gnus-y-or-n-p (prompt)
;; from `message'.
(apply 'format args)))
+(defun gnus-error (level &rest args)
+ "Beep an error if `gnus-verbose' is on LEVEL or less."
+ (when (<= (floor level) gnus-verbose)
+ (apply 'message args)
+ (ding)
+ (let (duration)
+ (when (and (floatp level)
+ (not (zerop (setq duration (* 10 (- level (floor level)))))))
+ (sit-for duration))))
+ nil)
+
;; Generate a unique new group name.
(defun gnus-generate-new-group-name (leaf)
(let ((name leaf)
(defun gnus-parent-id (references)
"Return the last Message-ID in REFERENCES."
(when (and references
- (string-match "\\(<[^<>]+>\\)[ \t\n]*\\'" references))
+ (string-match "\\(<[^\n<>]+>\\)[ \t\n]*\\'" references))
(substring references (match-beginning 1) (match-end 1))))
(defun gnus-split-references (references)
(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 level gnus-group-default-list-level gnus-level-subscribed))
+ (or (setq gnus-group-use-permanent-levels
+ (or level (if (numberp gnus-group-use-permanent-levels)
+ gnus-group-use-permanent-levels
+ (or gnus-group-default-list-level
+ gnus-level-subscribed))))
+ 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))
+ (setq gnus-group-use-permanent-levels
+ (or arg (1- gnus-level-default-subscribed)))
+ (gnus gnus-group-use-permanent-levels t slave))
;;;###autoload
(defun gnus-slave (&optional arg)
(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))
- (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)))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (if method
+ ;; It's a foreign group...
+ (gnus-group-make-group
+ (gnus-group-real-name (gnus-info-group 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")
(setq entry
(gnus-gethash (gnus-group-prefixed-name
"Insert GROUP on the current line."
(let ((entry (gnus-gethash group gnus-newsrc-hashtb))
active info)
+ (setq gnus-group-indentation (gnus-group-group-indentation))
(if entry
(progn
;; (Un)subscribed group.
(interactive "p")
(let ((buffer-read-only nil)
group)
- (while
- (and (> n 0)
- (setq group (gnus-group-group-name))
- (progn
- (beginning-of-line)
- (forward-char
- (or (cdr (assq 'process gnus-group-mark-positions)) 2))
- (delete-char 1)
- (if unmark
- (progn
- (insert " ")
- (setq gnus-group-marked (delete group gnus-group-marked)))
- (insert "#")
- (setq gnus-group-marked
- (cons group (delete group gnus-group-marked))))
- t)
- (or no-advance (zerop (gnus-group-next-group 1))))
- (setq n (1- n)))
+ (while (and (> n 0)
+ (not (eobp)))
+ (when (setq group (gnus-group-group-name))
+ ;; Update the mark.
+ (beginning-of-line)
+ (forward-char
+ (or (cdr (assq 'process gnus-group-mark-positions)) 2))
+ (delete-char 1)
+ (if unmark
+ (progn
+ (insert " ")
+ (setq gnus-group-marked (delete group gnus-group-marked)))
+ (insert "#")
+ (setq gnus-group-marked
+ (cons group (delete group gnus-group-marked))))
+ (or no-advance (zerop (gnus-group-next-group 1))))
+ (decf n))
(gnus-summary-position-point)
n))
(substitute-command-keys
"\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
'undefined)
- (progn
- (message "Undefined key")
- (ding))
+ (gnus-error 1 "Undefined key")
(while groups
(gnus-group-remove-mark (setq group (pop groups)))
(command-execute func))))
(nreverse groups)))
((and (boundp 'transient-mark-mode)
transient-mark-mode
+ (boundp 'mark-active)
mark-active)
;; Work on the region between point and mark.
(let ((max (max (point) (mark)))
(interactive
(list (completing-read
"Group: " gnus-active-hashtb nil
- (memq gnus-select-method gnus-have-read-active-file))))
+ (gnus-read-active-file-p)
+ nil
+ 'gnus-group-history)))
- (if (equal group "")
- (error "Empty group name"))
+ (when (equal group "")
+ (error "Empty group name"))
+
+ (when (string-match "[\000-\032]" group)
+ (error "Control characters in group: %s" group))
(let ((b (text-property-any
(point-min) (point-max)
(let ((method
(completing-read
"Method: " (append gnus-valid-select-methods gnus-server-alist)
- nil t)))
+ nil t nil 'gnus-method-history)))
(cond ((assoc method gnus-valid-select-methods)
(list method
(if (memq 'prompt-address
(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))
- backend info)
- (and (gnus-gethash nname gnus-newsrc-hashtb)
- (error "Group %s already exists" nname))
- (gnus-group-change-level
- (setq info (list t nname gnus-level-default-subscribed nil nil meth))
- gnus-level-default-subscribed gnus-level-killed
- (and (gnus-group-group-name)
- (gnus-gethash (gnus-group-group-name)
- gnus-newsrc-hashtb))
- t)
- (gnus-set-active nname (cons 1 0))
- (or (gnus-ephemeral-group-p name)
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
- (gnus-group-insert-group-line-info nname)
-
- (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))
- t)))
+ (let* ((meth (and method (if address (list (intern method) address)
+ method)))
+ (nname (if method (gnus-group-prefixed-name name meth) name))
+ backend info)
+ (when (gnus-gethash nname gnus-newsrc-hashtb)
+ (error "Group %s already exists" nname))
+ ;; Subscribe to the new group.
+ (gnus-group-change-level
+ (setq info (list t nname gnus-level-default-subscribed nil nil meth))
+ gnus-level-default-subscribed gnus-level-killed
+ (and (gnus-group-group-name)
+ (gnus-gethash (gnus-group-group-name)
+ gnus-newsrc-hashtb))
+ t)
+ ;; Make it active.
+ (gnus-set-active nname (cons 1 0))
+ (or (gnus-ephemeral-group-p name)
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
+ ;; Insert the line.
+ (gnus-group-insert-group-line-info nname)
+ (forward-line -1)
+ (gnus-group-position-point)
+
+ ;; Load the backend and try to make the backend create
+ ;; the group as well.
+ (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))
+ t))
(defun gnus-group-delete-group (group &optional force)
"Delete the current group.
() ; Whew!
(gnus-message 6 "Deleting group %s..." group)
(if (not (gnus-request-delete-group group force))
- (progn
- (gnus-message 3 "Couldn't delete group %s" group)
- (ding))
+ (gnus-error 3 "Couldn't delete group %s" group)
(gnus-message 6 "Deleting group %s...done" group)
(gnus-group-goto-group group)
(gnus-group-kill-group 1 t)
(gnus-message 6 "Renaming group %s to %s..." group new-name)
(prog1
(if (not (gnus-request-rename-group group new-name))
- (progn
- (gnus-message 3 "Couldn't rename group %s to %s" group new-name)
- (ding))
+ (gnus-error 3 "Couldn't rename group %s to %s" group new-name)
;; We rename the group internally by killing it...
(gnus-group-goto-group group)
(gnus-group-kill-group)
"etc/gnus-tut.txt"))))
(setq path nil)))
(if (not file)
- (message "Couldn't find doc group")
+ (gnus-message 1 "Couldn't find doc group")
(gnus-group-make-group
(gnus-group-real-name name)
(list 'nndoc "gnus-help"
(gnus-group-real-name name)
(list 'nndoc (file-name-nondirectory file)
(list 'nndoc-address file)
- (list 'nndoc-article-type (or type 'guess))))
- (forward-line -1)
- (gnus-group-position-point)))
+ (list 'nndoc-article-type (or type 'guess))))))
(defun gnus-group-make-archive-group (&optional all)
"Create the (ding) Gnus archive group of the most recent articles.
(list 'nndir (if all "hpc" "edu")
(list 'nndir-directory
(if all gnus-group-archive-directory
- gnus-group-recent-archive-directory)))))
- (forward-line -1)
- (gnus-group-position-point))
+ gnus-group-recent-archive-directory))))))
(defun gnus-group-make-directory-group (dir)
"Create an nndir group.
(setq ext (format "<%d>" (setq i (1+ i)))))
(gnus-group-make-group
(gnus-group-real-name group)
- (list 'nndir group (list 'nndir-directory dir))))
- (forward-line -1)
- (gnus-group-position-point))
+ (list 'nndir group (list 'nndir-directory dir)))))
(defun gnus-group-make-kiboze-group (group address scores)
"Create an nnkiboze group.
(setq scores (cons (cons header regexps) scores)))
scores)))
(gnus-group-make-group group "nnkiboze" address)
- (save-excursion
- (gnus-set-work-buffer)
+ (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group))
(let (emacs-lisp-mode-hook)
- (pp scores (current-buffer)))
- (write-region (point-min) (point-max)
- (gnus-score-file-name (concat "nnkiboze:" group))))
- (forward-line -1)
- (gnus-group-position-point))
+ (pp scores (current-buffer)))))
(defun gnus-group-add-to-virtual (n vgroup)
"Add the current group to a virtual group."
(level2 (gnus-info-level info2)))
(or (< level1 level2)
(and (= level1 level2)
- (< (gnus-info-score info1) (gnus-info-score info2))))))
+ (> (gnus-info-score info1) (gnus-info-score info2))))))
;; Group catching up.
(nnvirtual-catchup-group
(gnus-group-real-name (car groups)) (nth 1 method) all)))
(gnus-group-remove-mark (car groups))
- (if (prog1
- (gnus-group-goto-group (car groups))
- (gnus-group-catchup (car groups) all))
- (gnus-group-update-group-line)
- (setq ret (1+ ret)))
+ (if (>= (gnus-group-group-level) gnus-level-zombie)
+ (gnus-message 2 "Dead groups can't be caught up")
+ (if (prog1
+ (gnus-group-goto-group (car groups))
+ (gnus-group-catchup (car groups) all))
+ (gnus-group-update-group-line)
+ (setq ret (1+ ret))))
(setq groups (cdr groups)))
(gnus-group-next-unread-group 1)
ret)))
(interactive
(list (completing-read
"Group: " gnus-active-hashtb nil
- (memq gnus-select-method gnus-have-read-active-file))))
+ (gnus-read-active-file-p)
+ nil
+ 'gnus-group-history)))
(let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
(cond
((string-match "^[ \t]$" group)
(unless silent
(gnus-group-update-group group)))
((and (stringp group)
- (or (not (memq gnus-select-method gnus-have-read-active-file))
+ (or (not (gnus-read-active-file-p))
(gnus-active group)))
;; Add new newsgroup.
(gnus-group-change-level
(interactive "P")
;; Find all possible killed newsgroups if arg.
(when arg
- ;; First make sure active file has been read.
- (unless gnus-have-read-active-file
- (let ((gnus-read-active-file t))
- (gnus-read-active-file)))
- (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
- ;; Go through all newsgroups that are known to Gnus - enlarge kill list
- (mapatoms
- (lambda (sym)
- (let ((groups 0)
- (group (symbol-name sym)))
- (if (or (null group)
- (gnus-gethash group gnus-killed-hashtb)
- (gnus-gethash group gnus-newsrc-hashtb))
- ()
- (let ((do-sub (gnus-matches-options-n group)))
- (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
- ()
- (setq groups (1+ groups))
- (setq gnus-killed-list
- (cons group gnus-killed-list))
- (gnus-sethash group group gnus-killed-hashtb))))))
- gnus-active-hashtb))
+ (gnus-get-killed-groups))
(if (not gnus-killed-list)
(gnus-message 6 "No killed groups")
(let (gnus-group-list-mode)
"List all groups that are available from the server(s)."
(interactive)
;; First we make sure that we have really read the active file.
- (unless gnus-have-read-active-file
+ (unless (gnus-read-active-file-p)
(let ((gnus-read-active-file t))
(gnus-read-active-file)))
;; Find all groups and sort them.
(unless (gnus-virtual-group-p group)
(gnus-close-group group))
(gnus-group-update-group group))
- (ding)
- (gnus-message 3 "%s error: %s" group (gnus-status-message group))))
+ (gnus-error 3 "%s error: %s" group (gnus-status-message group))))
(when beg (goto-char beg))
(when gnus-goto-next-group-when-activating
(gnus-group-next-unread-group 1 t))
gnus-description-hashtb))
(setq desc (gnus-group-get-description group))
(gnus-read-descriptions-file method))
- (message
+ (gnus-message 1
(or desc (gnus-gethash group gnus-description-hashtb)
"No description available")))))
If the prefix LEVEL is non-nil, it should be a number that says which
level to cut off listing groups.
If ALL, also list groups with no unread articles.
-If LOWEST, don't list groups with level lower than LOWEST."
+If LOWEST, don't list groups with level lower than LOWEST.
+
+This command may read the active file."
(interactive "P\nsList newsgroups matching: ")
+ ;; First make sure active file has been read.
+ (when (and level
+ (>= (prefix-numeric-value level) gnus-level-killed))
+ (gnus-get-killed-groups))
(gnus-group-prepare-flat (or level gnus-level-subscribed)
all (or lowest 1) regexp)
(goto-char (point-min))
(list (let ((how (completing-read
"Which backend: "
(append gnus-valid-select-methods gnus-server-alist)
- nil t (cons "nntp" 0))))
+ nil t (cons "nntp" 0) 'gnus-method-history)))
;; We either got a backend name or a virtual server name.
;; If the first, we also need an address.
(if (assoc how gnus-valid-select-methods)
(setq selective-display-ellipses t) ;Display `...'
(setq buffer-display-table gnus-summary-display-table)
(setq gnus-newsgroup-name group)
+ (make-local-variable 'gnus-summary-line-format)
+ (make-local-variable 'gnus-summary-line-format-spec)
+ (make-local-variable 'gnus-summary-mark-positions)
(run-hooks 'gnus-summary-mode-hook))
(defun gnus-summary-make-display-table ()
(point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
(list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
-(defvar gnus-thread-indent-array nil)
-(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
(defun gnus-make-thread-indent-array ()
(let ((n 200))
(unless (and gnus-thread-indent-array
(when gnus-build-sparse-threads
(gnus-build-sparse-threads))
;; Find the initial limit.
- (if show-all
- (let ((gnus-newsgroup-dormant nil))
+ (if gnus-show-threads
+ (if show-all
+ (let ((gnus-newsgroup-dormant nil))
+ (gnus-summary-initial-limit show-all))
(gnus-summary-initial-limit show-all))
- (gnus-summary-initial-limit show-all))
+ (setq gnus-newsgroup-limit
+ (mapcar
+ (lambda (header) (mail-header-number header))
+ gnus-newsgroup-headers)))
;; Generate the summary buffer.
(unless no-display
(gnus-summary-prepare))
(let (threads)
;; We then insert this thread into the summary buffer.
(let (gnus-newsgroup-data gnus-newsgroup-threads)
- (gnus-summary-prepare-threads (list thread))
+ (gnus-summary-prepare-threads (gnus-cut-threads (list thread)))
(setq data (nreverse gnus-newsgroup-data))
(setq threads gnus-newsgroup-threads))
;; We splice the new data into the data structure.
(defun gnus-id-to-article (id)
"Return the article number of ID."
(let ((thread (gnus-id-to-thread id)))
- (when thread
+ (when (and thread
+ (car thread))
(mail-header-number (car thread)))))
(defun gnus-id-to-header (id)
(defun gnus-article-displayed-root-p (article)
"Say whether ARTICLE is a root(ish) article."
(let ((level (gnus-summary-thread-level article))
+ (refs (mail-header-references (gnus-summary-article-header article)))
particle)
(cond
((null level) nil)
((zerop level) t)
+ ((null refs) t)
+ ((null(gnus-parent-id refs)) t)
((and (= 1 level)
(null (setq particle (gnus-id-to-article
- (gnus-parent-id
- (mail-header-references
- (gnus-summary-article-header article))))))
+ (gnus-parent-id refs))))
(null (gnus-summary-thread-level particle)))))))
(defun gnus-root-id (id)
(let (header number mark)
(while headers
- (setq header (car headers)
- headers (cdr headers)
- number (mail-header-number header))
-
;; We may have to root out some bad articles...
- (when (memq number gnus-newsgroup-limit)
+ (when (memq (setq number (mail-header-number
+ (setq header (pop headers))))
+ gnus-newsgroup-limit)
+ ;; Mark article as read when it has a low score.
(when (and gnus-summary-mark-below
(< (or (cdr (assq number gnus-newsgroup-scored))
gnus-summary-default-score 0)
gnus-tmp-header);; passed as argument to any user-format-funcs
(setq mode-string (eval mformat))
(setq max-len (max 4 (if gnus-mode-non-string-length
- (- (frame-width)
+ (- (window-width)
gnus-mode-non-string-length)
(length mode-string))))
;; We might have to chop a bit of the string off...
headers id id-dep ref-dep end ref)
(save-excursion
(set-buffer nntp-server-buffer)
+ (run-hooks 'gnus-parse-headers-hook)
(let ((case-fold-search t)
in-reply-to header p lines)
(goto-char (point-min))
(set-buffer nntp-server-buffer)
;; Allow the user to mangle the headers before parsing them.
(run-hooks 'gnus-parse-headers-hook)
- ;; Allow the user to mangle the headers before parsing them.
- (run-hooks 'gnus-parse-headers-hook)
(goto-char (point-min))
(while (and sequence (not (eobp)))
(setq number (read cur))
(gnus-nov-field)) ; misc
))
(error (progn
- (ding)
- (gnus-message 4 "Strange nov line")
+ (gnus-error 4 "Strange nov line")
(setq header nil)
(goto-char eol))))
(goto-char pos)
(gnus-delete-line)
(gnus-data-remove (mail-header-number old-header))))
+ (when old-header
+ (mail-header-set-number header (mail-header-number old-header)))
+ (setq gnus-newsgroup-sparse
+ (delq (mail-header-number header) gnus-newsgroup-sparse))
(gnus-rebuild-thread (mail-header-id header))
- (gnus-summary-goto-subject (setq number (mail-header-number header))))
+ (gnus-summary-goto-subject (setq number (mail-header-number header))
+ nil t))
(when (and (numberp number)
(> number 0))
;; We have to update the boundaries even if we can't fetch the
(defun gnus-summary-find-next (&optional unread article backward)
(if backward (gnus-summary-find-prev)
- (let* ((article (or article (gnus-summary-article-number)))
+ (let* ((dummy (gnus-summary-article-intangible-p))
+ (article (or article (gnus-summary-article-number)))
(arts (gnus-data-find-list article))
result)
- (when (or (not gnus-summary-check-current)
- (not unread)
- (not (gnus-data-unread-p (car arts))))
+ (when (and (not dummy)
+ (or (not gnus-summary-check-current)
+ (not unread)
+ (not (gnus-data-unread-p (car arts)))))
(setq arts (cdr arts)))
(when (setq result
(if unread
"\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
))))
'undefined)
- (progn
- (message "Undefined key")
- (ding))
+ (gnus-error 1 "Undefined key")
(save-excursion
(while articles
(gnus-summary-goto-subject (setq article (pop articles)))
(quit-config (gnus-group-quit-config gnus-newsgroup-name))
(mode major-mode)
(buf (current-buffer)))
- (unless temporary
- (run-hooks 'gnus-summary-prepare-exit-hook))
+ (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)
(setq gnus-article-current nil))
(when gnus-use-cache
(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.
(defun gnus-kill-or-deaden-summary (buffer)
"Kill or deaden the summary BUFFER."
+ (when (and (buffer-name buffer)
+ (not gnus-single-article-buffer))
+ (save-excursion
+ (set-buffer buffer)
+ (gnus-kill-buffer gnus-article-buffer)
+ (gnus-kill-buffer gnus-original-article-buffer)))
(cond (gnus-kill-summary-on-exit
(when (and gnus-use-trees
(and (get-buffer buffer)
(funcall gnus-summary-display-article-function article all-header)
(gnus-article-prepare article all-header))
(run-hooks 'gnus-select-article-hook)
+ (unless (zerop gnus-current-article)
+ (gnus-summary-goto-subject gnus-current-article))
(gnus-summary-recenter)
- (gnus-summary-goto-subject article)
(when gnus-use-trees
(gnus-possibly-generate-tree article)
(gnus-highlight-selected-tree article))
;; Successfully display article.
(gnus-article-set-window-start
- (cdr (assq article gnus-newsgroup-bookmarks)))
- t)))
+ (cdr (assq article gnus-newsgroup-bookmarks))))))
(defun gnus-summary-select-article (&optional all-headers force pseudo article)
"Select the current article.
non-nil, the article will be re-fetched even if it already present in
the article buffer. If PSEUDO is non-nil, pseudo-articles will also
be displayed."
+ ;; Make sure we are in the summary buffer to work around bbdb bug.
+ (unless (eq major-mode 'gnus-summary-mode)
+ (set-buffer gnus-summary-buffer))
(let ((article (or article (gnus-summary-article-number)))
(all-headers (not (not all-headers))) ;Must be T or NIL.
gnus-summary-display-article-function
(let ((article (gnus-summary-article-number))
(endp nil))
(gnus-configure-windows 'article)
- (if (or (null gnus-current-article)
- (null gnus-article-current)
- (/= article (cdr gnus-article-current))
- (not (equal (car gnus-article-current) gnus-newsgroup-name)))
- ;; Selected subject is different from current article's.
- (gnus-summary-display-article article)
- (gnus-eval-in-buffer-window
- gnus-article-buffer
- (setq endp (gnus-article-next-page lines)))
- (if endp
- (cond (circular
- (gnus-summary-beginning-of-article))
- (lines
- (gnus-message 3 "End of message"))
- ((null lines)
- (if (and (eq gnus-summary-goto-unread 'never)
- (not (gnus-summary-last-article-p article)))
- (gnus-summary-next-article)
- (gnus-summary-next-unread-article))))))
+ (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark)
+ (if (and (eq gnus-summary-goto-unread 'never)
+ (not (gnus-summary-last-article-p article)))
+ (gnus-summary-next-article)
+ (gnus-summary-next-unread-article))
+ (if (or (null gnus-current-article)
+ (null gnus-article-current)
+ (/= article (cdr gnus-article-current))
+ (not (equal (car gnus-article-current) gnus-newsgroup-name)))
+ ;; Selected subject is different from current article's.
+ (gnus-summary-display-article article)
+ (gnus-eval-in-buffer-window
+ gnus-article-buffer
+ (setq endp (gnus-article-next-page lines)))
+ (if endp
+ (cond (circular
+ (gnus-summary-beginning-of-article))
+ (lines
+ (gnus-message 3 "End of message"))
+ ((null lines)
+ (if (and (eq gnus-summary-goto-unread 'never)
+ (not (gnus-summary-last-article-p article)))
+ (gnus-summary-next-article)
+ (gnus-summary-next-unread-article)))))))
(gnus-summary-recenter)
(gnus-summary-position-point)))
gnus-refer-article-method))
number)
;; Start the special refer-article method, if necessary.
- (when gnus-refer-article-method
+ (when (and gnus-refer-article-method
+ (gnus-news-group-p gnus-newsgroup-name))
(gnus-check-server gnus-refer-article-method))
;; Fetch the header, and display the article.
(if (setq number (gnus-summary-insert-subject message-id))
(let ((gnus-have-all-headers t)
gnus-article-display-hook
gnus-article-prepare-hook
+ gnus-break-pages
gnus-visual)
(gnus-summary-select-article nil 'force)))
+ (gnus-summary-goto-subject gnus-current-article)
; (gnus-configure-windows 'article)
(gnus-summary-position-point))
(error "The current group does not support article editing")))
(let ((articles (gnus-summary-work-articles n))
(prefix (gnus-group-real-prefix gnus-newsgroup-name))
- (names '((move "move" "Moving")
- (copy "copy" "Copying")
- (crosspost "crosspost" "Crossposting")))
+ (names '((move "Move" "Moving")
+ (copy "Copy" "Copying")
+ (crosspost "Crosspost" "Crossposting")))
(copy-buf (save-excursion
(nnheader-set-temp-buffer " *copy article*")))
art-group to-method new-xref article to-groups)
(setq to-newsgroup
(gnus-read-move-group-name
(cadr (assq action names))
- gnus-current-move-group articles prefix))
+ (symbol-value (intern (format "gnus-current-%s-group" action)))
+ 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)))
(interactive "P")
(gnus-summary-move-article n nil nil 'crosspost))
+(defvar gnus-summary-respool-default-method nil
+ "Default method for respooling an article.
+If nil, use to the current newsgroup method.")
+
(defun gnus-summary-respool-article (&optional n method)
"Respool the current article.
The article will be squeezed through the mail spooling process again,
(list current-prefix-arg
(let* ((methods (gnus-methods-using 'respool))
(methname
- (symbol-name (car (gnus-find-method-for-group
- gnus-newsgroup-name))))
+ (symbol-name (or gnus-summary-respool-default-method
+ (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)))
+ (gnus-completing-read
+ methname "What backend do you want to use when? "
+ methods nil t nil 'gnus-method-history))
ms)
(cond
((zerop (length (setq ms (gnus-servers-using-backend method))))
(gnus-request-accept-article group nil t)
(kill-buffer (current-buffer)))))
-(defun gnus-summary-expire-articles ()
+(defun gnus-summary-expire-articles (&optional now)
"Expire all articles that are marked as expirable in the current group."
(interactive)
(gnus-set-global-variables)
(gnus-list-of-read-articles gnus-newsgroup-name)
(setq gnus-newsgroup-expirable
(sort gnus-newsgroup-expirable '<))))
- (expiry-wait (gnus-group-get-parameter
- gnus-newsgroup-name 'expiry-wait))
+ (expiry-wait (if now 'immediate
+ (gnus-group-get-parameter
+ gnus-newsgroup-name 'expiry-wait)))
es)
(when expirable
;; There are expirable articles in this group, so we run them
(gnus-set-global-variables)
(or gnus-expert-user
(gnus-y-or-n-p
- "Are you really, really, really sure you want to expunge? ")
+ "Are you really, really, really sure you want to delete all these messages? ")
(error "Phew!"))
- (let ((nnmail-expiry-wait 'immediate)
- (nnmail-expiry-wait-function nil))
- (gnus-summary-expire-articles)))
+ (gnus-summary-expire-articles t))
;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
(defun gnus-summary-delete-article (&optional n)
(if (gnus-group-read-only-p)
(progn
(gnus-summary-edit-article-postpone)
- (gnus-message
- 1 "The current newsgroup does not support article editing.")
- (ding))
+ (gnus-error
+ 1 "The current newsgroup does not support article editing."))
(let ((buf (format "%s" (buffer-string))))
(erase-buffer)
(insert buf)
(when gnus-use-cache
(gnus-cache-update-article
(cdr gnus-article-current) (car gnus-article-current))))
+ (save-excursion
+ (when (get-buffer gnus-original-article-buffer)
+ (set-buffer gnus-original-article-buffer)
+ (setq gnus-original-article nil)))
+ (setq gnus-article-current nil
+ gnus-current-article nil)
(run-hooks 'gnus-article-display-hook)
(and (gnus-visual-p 'summary-highlight 'highlight)
(run-hooks 'gnus-visual-mark-article-hook)))))
"Return the score of the current article."
(interactive)
(gnus-set-global-variables)
- (message "%s" (gnus-summary-article-score)))
+ (gnus-message 1 "%s" (gnus-summary-article-score)))
;; Summary marking commands.
(beginning-of-line)
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
(buffer-read-only nil))
- (when forward
+ (when (and forward
+ (<= (+ forward (point)) (point-max)))
;; Go to the right position on the line.
- (forward-char forward)
+ (goto-char (+ forward (point)))
;; Replace the old mark with the new mark.
(subst-char-in-region (point) (1+ (point)) (following-char) mark)
;; Optionally update the marks by some user rule.
(gnus-simplify-subject-fuzzy
(mail-header-subject (gnus-data-header (car data)))))
(t nil)))
+ (end-point (save-excursion
+ (if (gnus-summary-go-to-next-thread)
+ (point) (point-max))))
articles)
- (if (not data)
- () ; This article doesn't exist.
- (while data
- (and (or (not top-subject)
- (string= top-subject
- (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
- (gnus-simplify-subject-fuzzy
- (mail-header-subject
- (gnus-data-header (car data))))
- (gnus-simplify-subject-re
- (mail-header-subject
- (gnus-data-header (car data)))))))
- (setq articles (cons (gnus-data-number (car data)) articles)))
- (if (and (setq data (cdr data))
- (> (gnus-data-level (car data)) top-level))
- ()
- (setq data nil)))
- ;; Return the list of articles.
- (nreverse articles))))
+ (while (and data
+ (< (gnus-data-pos (car data)) end-point))
+ (when (or (not top-subject)
+ (string= top-subject
+ (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
+ (gnus-simplify-subject-fuzzy
+ (mail-header-subject
+ (gnus-data-header (car data))))
+ (gnus-simplify-subject-re
+ (mail-header-subject
+ (gnus-data-header (car data)))))))
+ (push (gnus-data-number (car data)) articles))
+ (unless (and (setq data (cdr data))
+ (> (gnus-data-level (car data)) top-level))
+ (setq data nil)))
+ ;; Return the list of articles.
+ (nreverse articles)))
(defun gnus-summary-rethread-current ()
"Rethread the thread the current article is part of."
(set-buffer gnus-summary-buffer)
(gnus-summary-unmark-all-processable)
(gnus-summary-rethread-current)
- (message "Article %d is now the child of article %d."
- current-article parent-article)))))
+ (gnus-message 3 "Article %d is now the child of article %d."
+ current-article parent-article)))))
(defun gnus-summary-toggle-threads (&optional arg)
"Toggle showing conversation threads.
(defun gnus-read-move-group-name (prompt default articles prefix)
"Read a group name."
(let* ((split-name (gnus-get-split-value gnus-move-split-methods))
+ group-map
+ (dum (mapatoms
+ (lambda (g)
+ (and (boundp g)
+ (symbol-name g)
+ (memq 'respool
+ (assoc (symbol-name
+ (car (gnus-find-method-for-group
+ (symbol-name g))))
+ gnus-valid-select-methods))
+ (push (list (symbol-name g)) group-map)))
+ gnus-active-hashtb))
(prom
- (format "Where do you want to %s %s? "
+ (format "%s %s to:"
prompt
(if (> (length articles) 1)
(format "these %d articles" (length articles))
(to-newsgroup
(cond
((null split-name)
- (completing-read
- (concat prom
- (if default
- (format "(default %s) " default)
- ""))
- gnus-active-hashtb nil nil prefix))
+ (gnus-completing-read default prom
+ group-map nil nil prefix
+ 'gnus-group-history))
((= 1 (length split-name))
- (completing-read prom gnus-active-hashtb
- nil nil (cons (car split-name) 0)))
+ (gnus-completing-read (car split-name) prom group-map
+ nil nil nil
+ 'gnus-group-history))
(t
- (completing-read
- prom (mapcar (lambda (el) (list el)) (nreverse split-name)))))))
-
+ (gnus-completing-read nil prom
+ (mapcar (lambda (el) (list el))
+ (nreverse split-name))
+ nil nil nil
+ 'gnus-group-history)))))
(when to-newsgroup
(if (or (string= to-newsgroup "")
(string= to-newsgroup prefix))
(concat gnus-article-save-directory (car split-name))))
;; A list of splits was found.
(t
- (setq split-name (mapcar (lambda (el) (list el))
- (nreverse split-name)))
- (let ((result (completing-read
- (concat prompt " ") split-name nil nil)))
- (concat gnus-article-save-directory
- (if (string= result "")
- (caar split-name)
- result)))))))
+ (setq split-name (nreverse split-name))
+ (let (result)
+ (let ((file-name-history (nconc split-name file-name-history)))
+ (setq result
+ (read-file-name
+ (concat prompt " (`M-p' for defaults) ")
+ gnus-article-save-directory
+ (car split-name))))
+ (car (push result file-name-history)))))))
;; If we have read a directory, we append the default file name.
(when (file-directory-p file)
(setq file (concat (file-name-as-directory file)
(save-excursion
(gnus-article-setup-buffer)
(set-buffer gnus-article-buffer)
+ (setq buffer-read-only nil)
(let ((command (if automatic command (read-string "Command: " command)))
- (buffer-read-only nil))
+ ;; Just binding this here doesn't help, because there might
+ ;; be output from the process after exiting the scope of
+ ;; this `let'.
+ ;; (buffer-read-only nil)
+ )
(erase-buffer)
(insert "$ " command "\n\n")
(if gnus-view-pseudo-asynchronously
(setq do-update-line article)
(setq article (mail-header-id header))
(let ((gnus-override-method gnus-refer-article-method))
- (gnus-read-header article)))
+ (gnus-read-header article))
+ (setq gnus-newsgroup-sparse
+ (delq article gnus-newsgroup-sparse)))
((vectorp header)
;; It's a real article.
(setq article (mail-header-id header)))
(gnus-group-enter-directory dir)))))))))
(cond
+ ;; Refuse to select canceled articles.
+ ((and (numberp article)
+ gnus-summary-buffer
+ (get-buffer gnus-summary-buffer)
+ (buffer-name (get-buffer gnus-summary-buffer))
+ (eq (cdr (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (assq article gnus-newsgroup-reads)))
+ gnus-canceled-mark))
+ nil)
;; We first check `gnus-original-article-buffer'.
((and (get-buffer gnus-original-article-buffer)
+ (numberp article)
(save-excursion
(set-buffer gnus-original-article-buffer)
(and (equal (car gnus-original-article) group)
;; 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)
+ (numberp article)
(equal (buffer-name (current-buffer))
(buffer-name (get-buffer gnus-article-buffer))))
(save-excursion
(setq gnus-original-article (cons group article))))
;; Update sparse articles.
- (when do-update-line
- (save-excursion
+ (when (and do-update-line
+ (or (numberp article)
+ (stringp article)))
+ (let ((buf (current-buffer)))
(set-buffer gnus-summary-buffer)
(gnus-summary-update-article do-update-line)
- (gnus-summary-goto-subject do-update-line)
+ (gnus-summary-goto-subject do-update-line nil t)
(set-window-point (get-buffer-window (current-buffer) t)
- (point)))))))
+ (point))
+ (set-buffer buf))))))
(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)
+ (gnus-override-method
+ (and (gnus-news-group-p gnus-newsgroup-name)
+ gnus-refer-article-method))
where)
;; First we check to see whether the header in question is already
;; fetched.
(setq gnus-current-article article)
(gnus-summary-mark-article article gnus-canceled-mark))
(unless (memq article gnus-newsgroup-sparse)
- (gnus-message
- 1 "No such article (may have expired or been canceled)")
- (ding)
- nil))
+ (gnus-error
+ 1 "No such article (may have expired or been canceled)")))
(if (or (eq result 'pseudo) (eq result 'nneething))
(progn
(save-excursion
(memq article gnus-newsgroup-marked)
(memq article gnus-newsgroup-dormant)
(memq article gnus-newsgroup-unreads)))))
- ;; Hooks for getting information from the article.
- ;; This hook must be called before being narrowed.
- (let (buffer-read-only)
- (run-hooks 'internal-hook)
- (run-hooks 'gnus-article-prepare-hook)
- ;; Decode MIME message.
- (if gnus-show-mime
- (if (or (not gnus-strict-mime)
- (gnus-fetch-field "Mime-Version"))
- (funcall gnus-show-mime-method)
- (funcall gnus-decode-encoded-word-method)))
- ;; Perform the article display hooks.
- (run-hooks 'gnus-article-display-hook))
- ;; Do page break.
- (goto-char (point-min))
- (and gnus-break-pages (gnus-narrow-to-page))
+ (when (or (numberp article)
+ (stringp article))
+ ;; Hooks for getting information from the article.
+ ;; This hook must be called before being narrowed.
+ (let (buffer-read-only)
+ (run-hooks 'internal-hook)
+ (run-hooks 'gnus-article-prepare-hook)
+ ;; Decode MIME message.
+ (if gnus-show-mime
+ (if (or (not gnus-strict-mime)
+ (gnus-fetch-field "Mime-Version"))
+ (funcall gnus-show-mime-method)
+ (funcall gnus-decode-encoded-word-method)))
+ ;; Perform the article display hooks.
+ (run-hooks 'gnus-article-display-hook))
+ ;; Do page break.
+ (goto-char (point-min))
+ (and gnus-break-pages (gnus-narrow-to-page)))
(gnus-set-mode-line 'article)
(gnus-configure-windows 'article)
(goto-char (point-min))
gnus-inhibit-hiding
(gnus-article-hide-headers)))
+(defsubst gnus-article-header-rank ()
+ "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
+ (let ((list gnus-sorted-header-list)
+ (i 0))
+ (while list
+ (when (looking-at (car list))
+ (setq list nil))
+ (setq list (cdr list))
+ (incf i))
+ i))
+
(defun gnus-article-hide-headers (&optional arg delete)
"Toggle whether to hide unwanted headers and possibly sort them as well.
If given a negative prefix, always show; if given a positive prefix,
(let ((buffer-read-only nil)
(props (nconc (list 'gnus-type 'headers)
gnus-hidden-properties))
+ (max (1+ (length gnus-sorted-header-list)))
(ignored (when (not (stringp gnus-visible-headers))
(cond ((stringp gnus-ignored-headers)
gnus-ignored-headers)
(beginning-of-line)
;; We add the headers we want to keep to a list and delete
;; them from the buffer.
- (if (or (and visible (looking-at visible))
- (and ignored (not (looking-at ignored))))
- (progn
- (push (buffer-substring
- (setq beg (point))
- (progn
- (forward-line 1)
- ;; Be sure to get multi-line headers...
- (re-search-forward "^[^ \t]*:" nil t)
- (beginning-of-line)
- (point)))
- want-list)
- (delete-region beg (point)))
- (forward-line 1)))
- ;; Sort the headers that we want to display.
- (setq want-list (sort want-list 'gnus-article-header-less))
- (goto-char (point-min))
- (while want-list
- (insert (pop want-list)))
- ;; We make the unwanted headers invisible.
- (if delete
- (delete-region (point-min) (point-max))
- ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
- (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'."
- (let ((list gnus-sorted-header-list)
- (i 0))
- (while list
- (when (string-match (car list) header)
- (setq list nil))
- (setq list (cdr list))
- (incf i))
- i))
-
-(defun gnus-article-header-less (h1 h2)
- "Say whether string H1 is \"less\" than string H2."
- (< (gnus-article-header-rank h1)
- (gnus-article-header-rank h2)))
+ (put-text-property
+ (point) (1+ (point)) 'message-rank
+ (if (or (and visible (looking-at visible))
+ (and ignored
+ (not (looking-at ignored))))
+ (gnus-article-header-rank)
+ (+ 2 max)))
+ (forward-line 1))
+ (message-sort-headers-1)
+ (when (setq beg (text-property-any
+ (point-min) (point-max) 'message-rank (+ 2 max)))
+ ;; We make the unwanted headers invisible.
+ (if delete
+ (delete-region beg (point-max))
+ ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
+ (gnus-hide-text-type beg (point-max) 'headers)))))))))
(defun gnus-article-hide-boring-headers (&optional arg)
"Toggle hiding of headers that aren't very interesting.
(process-send-region "gnus-x-face" beg end)
(process-send-eof "gnus-x-face")))))))))
-(defun gnus-headers-decode-quoted-printable ()
+(defalias 'gnus-header-decode-quoted-printable 'gnus-decode-rfc1522)
+(defun gnus-decode-rfc1522 ()
"Hack to remove QP encoding from headers."
(let ((case-fold-search t)
(inhibit-point-motion-hooks t)
+ (buffer-read-only nil)
string)
- (goto-char (point-min))
- (while (re-search-forward "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
- (setq string (match-string 1))
- (narrow-to-region (match-beginning 0) (match-end 0))
- (delete-region (point-min) (point-max))
- (insert string)
- (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
- (subst-char-in-region (point-min) (point-max) ?_ ? )
- (widen)
- (goto-char (point-min)))))
+ (save-restriction
+ (narrow-to-region
+ (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point-max)))
+
+ (while (re-search-forward
+ "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
+ (setq string (match-string 1))
+ (narrow-to-region (match-beginning 0) (match-end 0))
+ (delete-region (point-min) (point-max))
+ (insert string)
+ (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
+ (subst-char-in-region (point-min) (point-max) ?_ ? )
+ (widen)
+ (goto-char (point-min))))))
(defun gnus-article-de-quoted-unreadable (&optional force)
"Do a naive translation of a quoted-printable-encoded article.
(let ((case-fold-search t)
(buffer-read-only nil)
(type (gnus-fetch-field "content-transfer-encoding")))
+ (gnus-decode-rfc1522)
(when (or force
(and type (string-match "quoted-printable" (downcase type))))
- (gnus-headers-decode-quoted-printable)
(goto-char (point-min))
(search-forward "\n\n" nil 'move)
(gnus-mime-decode-quoted-printable (point) (point-max))))))
(defun gnus-mime-decode-quoted-printable (from to)
"Decode Quoted-Printable in the region between FROM and TO."
+ (interactive "r")
(goto-char from)
(while (search-forward "=" to t)
(cond ((eq (following-char) ?\n)
(delete-char -1)
(delete-char 1))
((looking-at "[0-9A-F][0-9A-F]")
- (delete-char -1)
- (insert (hexl-hex-string-to-integer
- (buffer-substring (point) (+ 2 (point)))))
+ (subst-char-in-region
+ (1- (point)) (point) ?=
+ (hexl-hex-string-to-integer
+ (buffer-substring (point) (+ 2 (point)))))
(delete-char 2))
((looking-at "=")
(delete-char 1))
(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))
+ eface (get-text-property (1- (gnus-point-at-eol))
+ 'face))
(message-remove-header date-regexp t)
(beginning-of-line))
(goto-char (point-max)))
" ago\n"
" in the future\n")))))
(t
- (error "Unknown conversion type: %s" type)))))
- ;; Do highlighting.
- (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)))))))
+ (error "Unknown conversion type: %s" type))))
+ ;; Do highlighting.
+ (forward-line -1)
+ (when (and (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."
"%s (%s) open error: '%s'. Continue? "
(car gnus-select-method) (cadr gnus-select-method)
(gnus-status-message gnus-select-method)))
- (progn
- (gnus-message 1 "Couldn't open server on %s"
- (nth 1 gnus-select-method))
- (ding)
- nil)))))
+ (gnus-error 1 "Couldn't open server on %s"
+ (nth 1 gnus-select-method))))))
(defun gnus-check-group (group)
"Try to make sure that the server where GROUP exists is alive."
(gnus-server-extend-method group method))
(t
method)))
- (if (equal (cadr method) "")
- method
- (gnus-server-add-address method))))))
+ (cond ((equal (cadr method) "")
+ method)
+ ((null (cadr method))
+ (list (car method) ""))
+ (t
+ (gnus-server-add-address method)))))))
(defun gnus-check-backend-function (func group)
"Check whether GROUP supports function FUNC."
(gnus-find-new-newsgroups))
;; We might read in new NoCeM messages here.
- (when gnus-use-nocem
+ (when (and gnus-use-nocem
+ (not level)
+ (not dont-connect))
(gnus-nocem-scan-groups))
;; Find the number of unread articles in each non-dead group.
(setq hashtb (gnus-make-hashtable 100))
(set-buffer nntp-server-buffer)
;; Enter all the new groups into a hashtable.
- (gnus-active-to-gnus-format method hashtb 'ignore)))
- ;; Now all new groups from `method' are in `hashtb'.
- (mapatoms
- (lambda (group-sym)
- (if (or (null (setq group (symbol-name group-sym)))
- (null (symbol-value group-sym))
- (gnus-gethash group gnus-newsrc-hashtb)
- (member group gnus-zombie-list)
- (member group gnus-killed-list))
- ;; The group is already known.
- ()
- ;; Make this group active.
- (when (symbol-value group-sym)
- (gnus-set-active group (symbol-value group-sym)))
- ;; Check whether we want it or not.
- (let ((do-sub (gnus-matches-options-n group)))
- (cond
- ((eq do-sub 'subscribe)
- (incf groups)
- (gnus-sethash group group gnus-killed-hashtb)
- (funcall gnus-subscribe-options-newsgroup-method group))
- ((eq do-sub 'ignore)
- nil)
- (t
- (incf groups)
- (gnus-sethash group group gnus-killed-hashtb)
- (if gnus-subscribe-hierarchical-interactive
- (push group new-newsgroups)
- (funcall gnus-subscribe-newsgroup-method group)))))))
- hashtb)
+ (gnus-active-to-gnus-format method hashtb 'ignore))
+ ;; Now all new groups from `method' are in `hashtb'.
+ (mapatoms
+ (lambda (group-sym)
+ (if (or (null (setq group (symbol-name group-sym)))
+ (not (boundp group-sym))
+ (null (symbol-value group-sym))
+ (gnus-gethash group gnus-newsrc-hashtb)
+ (member group gnus-zombie-list)
+ (member group gnus-killed-list))
+ ;; The group is already known.
+ ()
+ ;; Make this group active.
+ (when (symbol-value group-sym)
+ (gnus-set-active group (symbol-value group-sym)))
+ ;; Check whether we want it or not.
+ (let ((do-sub (gnus-matches-options-n group)))
+ (cond
+ ((eq do-sub 'subscribe)
+ (incf groups)
+ (gnus-sethash group group gnus-killed-hashtb)
+ (funcall gnus-subscribe-options-newsgroup-method group))
+ ((eq do-sub 'ignore)
+ nil)
+ (t
+ (incf groups)
+ (gnus-sethash group group gnus-killed-hashtb)
+ (if gnus-subscribe-hierarchical-interactive
+ (push group new-newsgroups)
+ (funcall gnus-subscribe-newsgroup-method group)))))))
+ hashtb))
(when new-newsgroups
(gnus-subscribe-hierarchical-interactive new-newsgroups)))
;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
(file-exists-p (concat gnus-startup-file ".eld")))
nil
(gnus-message 6 "First time user; subscribing you to default groups")
- (unless gnus-have-read-active-file
+ (unless (gnus-read-active-file-p)
(gnus-read-active-file))
(setq gnus-newsrc-last-checked-date (current-time-string))
(let ((groups gnus-default-subscribed-newsgroups)
(let ((newsrc (cdr gnus-newsrc-alist))
bogus group entry info)
(gnus-message 5 "Checking bogus newsgroups...")
- (unless gnus-have-read-active-file
+ (unless (gnus-read-active-file-p)
(gnus-read-active-file))
- (when (member gnus-select-method gnus-have-read-active-file)
+ (when (gnus-read-active-file-p)
;; Find all bogus newsgroup that are subscribed.
(while newsrc
(setq info (pop newsrc)
(setq killed (cdr killed)))
(setq lists (cdr lists)))))
+(defun gnus-get-killed-groups ()
+ "Go through the active hashtb and all all unknown groups as killed."
+ ;; First make sure active file has been read.
+ (unless (gnus-read-active-file-p)
+ (let ((gnus-read-active-file t))
+ (gnus-read-active-file)))
+ (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
+ ;; Go through all newsgroups that are known to Gnus - enlarge kill list.
+ (mapatoms
+ (lambda (sym)
+ (let ((groups 0)
+ (group (symbol-name sym)))
+ (if (or (null group)
+ (gnus-gethash group gnus-killed-hashtb)
+ (gnus-gethash group gnus-newsrc-hashtb))
+ ()
+ (let ((do-sub (gnus-matches-options-n group)))
+ (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
+ ()
+ (setq groups (1+ groups))
+ (setq gnus-killed-list
+ (cons group gnus-killed-list))
+ (gnus-sethash group group gnus-killed-hashtb))))))
+ gnus-active-hashtb))
+
;; Get the active file(s) from the backend(s).
(defun gnus-read-active-file ()
(gnus-group-set-mode-line)
(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))
+ (gnus-error
+ 1.2 "Cannot read partial active file from %s server."
+ (car method)))
((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
- (unless (equal method gnus-message-archive-method)
- (gnus-message 1 "Cannot read active file from %s server."
- (car method))
- (ding)))
- (gnus-active-to-gnus-format method)
+ (unless (equal method gnus-message-archive-method)
+ (gnus-error 1 "Cannot read active file from %s server."
+ (car method)))
+ (gnus-active-to-gnus-format method gnus-active-hashtb)
;; We mark this active file as read.
(push method gnus-have-read-active-file)
(gnus-message 5 "%sdone" mesg))))))
(gnus-message 5 "Reading %s...done" newsrc-file)))
;; Read any slave files.
- (or gnus-slave
- (gnus-master-read-slave-newsrc)))))
+ (unless gnus-slave
+ (gnus-master-read-slave-newsrc))
+
+ ;; Convert old to new.
+ (gnus-convert-old-newsrc))))
+
+(defun gnus-continuum-version (version)
+ "Return VERSION as a floating point number."
+ (when (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
+ (let* ((alpha (and (match-beginning 1) (match-string 1 version)))
+ (number (match-string 2 version))
+ major minor least)
+ (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
+ (setq major (string-to-number (match-string 1 number)))
+ (setq minor (string-to-number (match-string 2 number)))
+ (setq least (if (match-beginning 3)
+ (string-to-number (match-string 3 number))
+ 0))
+ (string-to-number
+ (if (zerop major)
+ (format "%s00%02d%02d"
+ (cond
+ ((string= alpha "(ding)") "4.99")
+ ((string= alpha "September") "5.01")
+ ((string= alpha "Red") "5.03"))
+ minor least)
+ (format "%d.%02d%20d" major minor least))))))
+
+(defun gnus-convert-old-newsrc ()
+ "Convert old newsrc into the new format, if needed."
+ (let ((fcv (and gnus-newsrc-file-version
+ (gnus-continuum-version gnus-newsrc-file-version))))
+ (cond
+ ;; No .newsrc.eld file was loaded.
+ ((null fcv) nil)
+ ;; Gnus 5 .newsrc.eld was loaded.
+ ((< fcv (gnus-continuum-version "September Gnus v0.1"))
+ (gnus-convert-old-ticks)))))
+
+(defun gnus-convert-old-ticks ()
+ (let ((newsrc (cdr gnus-newsrc-alist))
+ marks info dormant ticked)
+ (while (setq info (pop newsrc))
+ (when (setq marks (gnus-info-marks info))
+ (setq dormant (cdr (assq 'dormant marks))
+ ticked (cdr (assq 'tick marks)))
+ (when (or dormant ticked)
+ (gnus-info-set-read
+ info
+ (gnus-add-to-range
+ (gnus-info-read info)
+ (nconc (gnus-uncompress-range dormant)
+ (gnus-uncompress-range ticked)))))))))
(defun gnus-read-newsrc-el-file (file)
(let ((ding-file (concat file "d")))
(condition-case nil
(load ding-file t t t)
(error
- (gnus-message 1 "Error in %s" ding-file)
- (ding)))
+ (gnus-error 1 "Error in %s" ding-file)))
(when gnus-newsrc-assoc
(setq gnus-newsrc-alist gnus-newsrc-assoc)))
(gnus-make-hashtable-from-newsrc-alist)
(progn
;; The line was buggy.
(setq group nil)
- (gnus-message 3 "Mangled line: %s"
- (buffer-substring (gnus-point-at-bol)
- (gnus-point-at-eol)))
- (ding)
- (sit-for 1)))
+ (gnus-error 3.1 "Mangled line: %s"
+ (buffer-substring (gnus-point-at-bol)
+ (gnus-point-at-eol)))))
nil))
;; Skip past ", ". Spaces are illegal in these ranges, but
;; we allow them, because it's a common mistake to put a
(eval-buffer (current-buffer))
t)
(error
- (gnus-message 3 "Possible error in %s" file)
- (ding)
- (sit-for 2)
+ (gnus-error 3.2 "Possible error in %s" file)
nil))
(or gnus-slave ; Slaves shouldn't delete these files.
(condition-case ()
projects / gnus / blobdiff