(require 'timezone)
(require 'nnheader)
(require 'message)
+(require 'nnmail)
+(require 'backquote)
(eval-when-compile (require 'cl))
+;;;###autoload
(defvar gnus-directory (or (getenv "SAVEDIR") "~/News/")
"*Directory variable from which all other Gnus file variables are derived.")
see the manual for details.")
(defvar gnus-message-archive-method
- '(nnfolder
+ `(nnfolder
"archive"
- (nnfolder-directory (nnheader-concat message-directory "archive"))
- (nnfolder-active-file (nnheader-concat message-directory "archive/active"))
+ (nnfolder-directory ,(nnheader-concat message-directory "archive"))
+ (nnfolder-active-file
+ ,(nnheader-concat message-directory "archive/active"))
(nnfolder-get-new-mail nil)
(nnfolder-inhibit-expiry t))
"*Method used for archiving messages you've sent.
(defvar gnus-use-adaptive-scoring nil
"*If non-nil, use some adaptive scoring scheme.")
-(defvar gnus-use-cache nil
+(defvar gnus-use-cache 'passive
"*If nil, Gnus will ignore the article cache.
If `passive', it will allow entering (and reading) articles
explicitly entered into the cache. If anything else, use the
; "*Face used for mouse highlighting in Gnus.
;No mouse highlights will be done if `gnus-visual' is nil.")
-(defvar gnus-summary-mark-below nil
+(defvar gnus-summary-mark-below 0
"*Mark all articles with a score below this variable as read.
This variable is local to each summary buffer and usually set by the
score file.")
(defvar gnus-group-catchup-group-hook nil
"*A hook run when catching up a group from the group buffer.")
+(defvar gnus-group-update-group-hook nil
+ "*A hook called when updating group lines.")
+
(defvar gnus-open-server-hook nil
"*A hook called just before opening connection to the news server.")
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.90"
+(defconst gnus-version-number "5.2.11"
"Version number for this version of Gnus.")
+(defconst gnus-version (format "Gnus v%s" gnus-version-number)
+ "Version string 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"))
- "Assoc list of major modes and related Info nodes.")
+ "Alist of major modes and related Info nodes.")
(defvar gnus-group-buffer "*Group*")
(defvar gnus-summary-buffer "*Summary*")
gnus-newsgroup-scored gnus-newsgroup-kill-headers
gnus-newsgroup-async gnus-thread-expunge-below
gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
- gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
+ (gnus-summary-mark-below . global)
+ gnus-newsgroup-active gnus-scores-exclude-files
gnus-newsgroup-history gnus-newsgroup-ancient
gnus-newsgroup-sparse
(gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
("nnvirtual" nnvirtual-catchup-group)
("timezone" timezone-make-date-arpa-standard timezone-fix-time
timezone-make-sortable-date timezone-make-time-string)
- ("sendmail" mail-position-on-field mail-setup)
("rmailout" rmail-output)
- ("rnewspost" news-mail-other-window news-reply-yank-original
- news-caesar-buffer-body)
("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
rmail-show-message)
("gnus-soup" :interactive t
gnus-score-raise-same-subject gnus-score-default
gnus-score-raise-thread gnus-score-lower-same-subject-and-select
gnus-score-lower-same-subject gnus-score-lower-thread
- gnus-possibly-score-headers)
+ gnus-possibly-score-headers gnus-summary-raise-score
+ gnus-summary-set-score gnus-summary-current-score)
("gnus-score"
(gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
gnus-current-score-file-nondirectory gnus-score-adaptive
("gnus-msg" :interactive t
gnus-group-post-news gnus-group-mail gnus-summary-post-news
gnus-summary-followup gnus-summary-followup-with-original
- gnus-summary-followup-and-reply
- gnus-summary-followup-and-reply-with-original
gnus-summary-cancel-article gnus-summary-supersede-article
gnus-post-news gnus-inews-news gnus-cancel-news
gnus-summary-reply gnus-summary-reply-with-original
gnus-grouplens-mode)
("gnus-vm" gnus-vm-mail-setup)
("gnus-vm" :interactive t gnus-summary-save-in-vm
- gnus-summary-save-article-vm gnus-yank-article))))
+ gnus-summary-save-article-vm))))
\f
(and gnus-group-buffer
(get-buffer gnus-group-buffer)))
+(defun gnus-delete-first (elt list)
+ "Delete by side effect the first occurrence of ELT as a member of LIST."
+ (if (equal (car list) elt)
+ (cdr list)
+ (let ((total list))
+ (while (and (cdr list)
+ (not (equal (cadr list) elt)))
+ (setq list (cdr list)))
+ (when (cdr list)
+ (setcdr list (cddr list)))
+ total)))
+
;; Delete the current line (and the next N lines.);
(defmacro gnus-delete-line (&optional n)
`(delete-region (progn (beginning-of-line) (point))
flist)
(cons 'progn (cddr fval)))))
+;; 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.
+ (if (not type) ; We don't care about type.
+ gnus-visual
+ (if (listp gnus-visual) ; It's a list, so we check it.
+ (or (memq type gnus-visual)
+ (memq class gnus-visual))
+ t))))
+
;;; Load the compatability functions.
(require 'gnus-cus)
(setq prefixes (cons prefix prefixes))
(message "Descend hierarchy %s? ([y]nsq): "
(substring prefix 1 (1- (length prefix))))
- (setq ans (read-char))
+ (while (not (memq (setq ans (read-char)) '(?y ?\n ?n ?s ?q)))
+ (ding)
+ (message "Descend hierarchy %s? ([y]nsq): "
+ (substring prefix 1 (1- (length prefix)))))
(cond ((= ans ?n)
(while (and groups
(string-match prefix
(setq groups (cdr groups))))
(t nil)))
(message "Subscribe %s? ([n]yq)" (car groups))
- (setq ans (read-char))
+ (while (not (memq (setq ans (read-char)) '(?y ?\n ?q ?n)))
+ (ding)
+ (message "Subscribe %s? ([n]yq)" (car groups)))
(setq group (car groups))
(cond ((= ans ?y)
(gnus-subscribe-alphabetically (car groups))
(delete-windows-on (car bufs)))
(setq bufs (cdr bufs))))))
-(defun gnus-version ()
- "Version numbers of this version of Gnus."
- (interactive)
+(defun gnus-version (&optional arg)
+ "Version number of this version of Gnus.
+If ARG, insert string at point."
+ (interactive "P")
(let ((methods gnus-valid-select-methods)
(mess gnus-version)
meth)
(stringp (symbol-value meth))
(setq mess (concat mess "; " (symbol-value meth))))
(setq methods (cdr methods)))
- (gnus-message 2 mess)))
+ (if arg
+ (insert (message mess))
+ (message mess))))
(defun gnus-info-find-node ()
"Find Info documentation of Gnus."
"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.
- (if (not type) ; We don't care about type.
- gnus-visual
- (if (listp gnus-visual) ; It's a list, so we check it.
- (or (memq type gnus-visual)
- (memq class gnus-visual))
- t))))
-
(defun gnus-parent-headers (headers &optional generation)
"Return the headers of the GENERATIONeth parent of HEADERS."
(unless generation
(buffer-disable-undo (current-buffer))
(setq truncate-lines t)
(setq buffer-read-only t)
+ (gnus-make-local-hook 'post-command-hook)
+ (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
(run-hooks 'gnus-group-mode-hook))
+(defun gnus-clear-inboxes-moved ()
+ (setq nnmail-moved-inboxes nil))
+
(defun gnus-mouse-pick-group (e)
"Enter the group under the mouse pointer."
(interactive "e")
(gnus-make-newsrc-file gnus-startup-file))
;; Read the dribble file.
- (and (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file))
+ (when (or gnus-slave gnus-use-dribble-file)
+ (gnus-dribble-read-file))
;; Allow using GroupLens predictions.
(when gnus-use-grouplens
(goto-char loc)
(let ((gnus-group-indentation (gnus-group-group-indentation)))
(gnus-delete-line)
- (gnus-group-insert-group-line-info group))
+ (gnus-group-insert-group-line-info group)
+ (save-excursion
+ (forward-line -1)
+ (run-hooks 'gnus-group-update-group-hook)))
(setq loc (1+ loc)))
(unless (or found visible-only)
;; No such line in the buffer, find out where it's supposed to
(or entry (goto-char (point-max)))))
;; Finally insert the line.
(let ((gnus-group-indentation (gnus-group-group-indentation)))
- (gnus-group-insert-group-line-info group)))
+ (gnus-group-insert-group-line-info group)
+ (save-excursion
+ (forward-line -1)
+ (run-hooks 'gnus-group-update-group-hook))))
(gnus-group-set-mode-line)))))
(defun gnus-group-set-mode-line ()
The difference between N and actual number of newsgroups that were
caught up is returned."
(interactive "P")
+ (unless (gnus-group-group-name)
+ (error "No group on the current line"))
(if (not (or (not gnus-interactive-catchup) ;Without confirmation?
gnus-expert-user
(gnus-y-or-n-p
(interactive "P\nsList newsgroups matching: ")
;; First make sure active file has been read.
(when (and level
- (>= (prefix-numeric-value level) gnus-level-killed))
+ (> (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)
(interactive)
(when
(or noninteractive ;For gnus-batch-kill
- (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
(not gnus-interactive-exit) ;Without confirmation
gnus-expert-user
(gnus-y-or-n-p "Are you sure you want to quit reading news? "))
(gnus-visual-p 'summary-menu 'menu))
(gnus-summary-make-menu-bar))
(kill-all-local-variables)
- (let ((locals gnus-summary-local-variables))
- (while locals
- (if (consp (car locals))
- (progn
- (make-local-variable (caar locals))
- (set (caar locals) (eval (cdar locals))))
- (make-local-variable (car locals))
- (set (car locals) nil))
- (setq locals (cdr locals))))
+ (gnus-summary-make-local-variables)
(gnus-make-thread-indent-array)
(gnus-simplify-mode-line)
(setq major-mode 'gnus-summary-mode)
(make-local-variable 'gnus-summary-mark-positions)
(run-hooks 'gnus-summary-mode-hook))
+(defun gnus-summary-make-local-variables ()
+ "Make all the local summary buffer variables."
+ (let ((locals gnus-summary-local-variables)
+ global local)
+ (while (setq local (pop locals))
+ (if (consp local)
+ (progn
+ (if (eq (cdr local) 'global)
+ ;; Copy the global value of the variable.
+ (setq global (symbol-value (car local)))
+ ;; Use the value from the list.
+ (setq global (eval (cdr local))))
+ (make-local-variable (car local))
+ (set (car local) global))
+ ;; Simple nil-valued local variable.
+ (make-local-variable local)
+ (set local nil)))))
+
(defun gnus-summary-make-display-table ()
;; Change the display table. Odd characters have a tendency to mess
;; up nicely formatted displays - we make all possible glyphs
(= mark gnus-dormant-mark)
(= mark gnus-expirable-mark))))
+;; Saving hidden threads.
+
+(put 'gnus-save-hidden-threads 'lisp-indent-function 0)
+(put 'gnus-save-hidden-threads 'lisp-indent-hook 0)
+(put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
+
+(defmacro gnus-save-hidden-threads (&rest forms)
+ "Save hidden threads, eval FORMS, and restore the hidden threads."
+ (let ((config (make-symbol "config")))
+ `(let ((,config (gnus-hidden-threads-configuration)))
+ (unwind-protect
+ (progn
+ ,@forms)
+ (gnus-restore-hidden-threads-configuration ,config)))))
+
+(defun gnus-hidden-threads-configuration ()
+ "Return the current hidden threads configuration."
+ (save-excursion
+ (let (config)
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (push (1- (point)) config))
+ config)))
+
+(defun gnus-restore-hidden-threads-configuration (config)
+ "Restore hidden threads configuration from CONFIG."
+ (let (point buffer-read-only)
+ (while (setq point (pop config))
+ (when (and (< point (point-max))
+ (goto-char point)
+ (= (following-char) ?\n))
+ (subst-char-in-region point (1+ point) ?\n ?\r)))))
+
;; Various summary mode internalish functions.
(defun gnus-mouse-pick-article (e)
1)
((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
1)
- (t 1))))
+ (t 0))))
(when (and level (zerop level) gnus-tmp-new-adopts)
(incf number
(apply '+ (mapcar
(delq number gnus-newsgroup-unselected)))
(push number gnus-newsgroup-ancient)))))))
-(defun gnus-summary-update-article (article &optional header)
+(defun gnus-summary-update-article (article &optional iheader)
"Update ARTICLE in the summary buffer."
(set-buffer gnus-summary-buffer)
- (let* ((header (or header (gnus-summary-article-header article)))
+ (let* ((header (or iheader (gnus-summary-article-header article)))
(id (mail-header-id header))
(data (gnus-data-find article))
(thread (gnus-id-to-thread id))
+ (references (mail-header-references header))
(parent
- (gnus-id-to-thread (or (gnus-parent-id
- (mail-header-references header))
- "tull")))
+ (gnus-id-to-thread
+ (or (gnus-parent-id
+ (if (and references
+ (not (equal "" references)))
+ references))
+ "none")))
(buffer-read-only nil)
(old (car thread))
(number (mail-header-number header))
pos)
(when thread
- (setcar thread nil)
+ ;; !!! Should this be in or not?
+ (unless iheader
+ (setcar thread nil))
(when parent
(delq thread parent))
- (if (gnus-summary-insert-subject id header)
+ (if (gnus-summary-insert-subject id header iheader)
;; Set the (possibly) new article number in the data structure.
(gnus-data-set-number data (gnus-id-to-article id))
(setcar thread old)
(gnus-data-compute-positions)
(setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
+(defun gnus-number-to-header (number)
+ "Return the header for article NUMBER."
+ (let ((headers gnus-newsgroup-headers))
+ (while (and headers
+ (not (= number (mail-header-number (car headers)))))
+ (pop headers))
+ (when headers
+ (car headers))))
+
(defun gnus-id-to-thread (id)
"Return the (sub-)thread where ID appears."
(gnus-gethash id gnus-newsgroup-dependencies))
(defsubst gnus-article-sort-by-date (h1 h2)
"Sort articles by root article date."
(string-lessp
- (gnus-sortable-date (mail-header-date h1))
- (gnus-sortable-date (mail-header-date h2))))
+ (inline (gnus-sortable-date (mail-header-date h1)))
+ (inline (gnus-sortable-date (mail-header-date h2)))))
(defun gnus-thread-sort-by-date (h1 h2)
"Sort threads by root article date."
(defun gnus-thread-total-score (thread)
;; This function find the total score of THREAD.
- (if (consp thread)
- (if (stringp (car thread))
- (apply gnus-thread-score-function 0
- (mapcar 'gnus-thread-total-score-1 (cdr thread)))
- (gnus-thread-total-score-1 thread))
- (gnus-thread-total-score-1 (list thread))))
+ (cond ((null thread)
+ 0)
+ ((consp thread)
+ (if (stringp (car thread))
+ (apply gnus-thread-score-function 0
+ (mapcar 'gnus-thread-total-score-1 (cdr thread)))
+ (gnus-thread-total-score-1 thread)))
+ (t
+ (gnus-thread-total-score-1 (list thread)))))
(defun gnus-thread-total-score-1 (root)
;; This function find the total score of the thread below ROOT.
default-score)
gnus-summary-mark-below)
;; Don't touch sparse articles.
- (not (memq number gnus-newsgroup-sparse)))
+ (not (memq number gnus-newsgroup-sparse))
+ (not (memq number gnus-newsgroup-ancient)))
(setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads))
(if gnus-newsgroup-auto-expire
(when (and gnus-summary-mark-below
(< (or (cdr (assq number gnus-newsgroup-scored))
gnus-summary-default-score 0)
- gnus-summary-mark-below))
+ gnus-summary-mark-below)
+ (not (memq number gnus-newsgroup-ancient)))
(setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads))
(if gnus-newsgroup-auto-expire
(unless gnus-single-article-buffer
(gnus-article-setup-buffer))
;; First and last article in this newsgroup.
- (and gnus-newsgroup-headers
- (setq gnus-newsgroup-begin
- (mail-header-number (car gnus-newsgroup-headers)))
- (setq gnus-newsgroup-end
- (mail-header-number
- (gnus-last-element gnus-newsgroup-headers))))
+ (when gnus-newsgroup-headers
+ (setq gnus-newsgroup-begin
+ (mail-header-number (car gnus-newsgroup-headers))
+ gnus-newsgroup-end
+ (mail-header-number
+ (gnus-last-element gnus-newsgroup-headers))))
(setq gnus-reffed-article-number -1)
;; GROUP is successfully selected.
(or gnus-newsgroup-headers t)))))
(equal (nth 1 m1) (nth 1 m2)))))))
(defsubst gnus-header-value ()
- (buffer-substring (match-end 0) (gnus-point-at-eol)))
+ (buffer-substring
+ (match-end 0)
+ (if (re-search-forward "^[^ \t]" nil t)
+ (progn
+ (backward-char 2)
+ (point))
+ (gnus-point-at-eol))))
(defvar gnus-newsgroup-none-id 0)
(progn
(goto-char p)
(if (search-forward "\nreferences: " nil t)
- (prog1
- (gnus-header-value)
- (setq end (match-end 0))
- (save-excursion
+ (progn
+ (setq end (point))
+ (prog1
+ (gnus-header-value)
(setq ref
(buffer-substring
(progn
(setq header nil))
(setcar (symbol-value id-dep) header))
(set id-dep (list header))))
- (if header
- (progn
- (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
- (setcdr (symbol-value ref-dep)
- (nconc (cdr (symbol-value ref-dep))
- (list (symbol-value id-dep))))
- (set ref-dep (list nil (symbol-value id-dep))))))
+ (when header
+ (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
+ (setcdr (symbol-value ref-dep)
+ (nconc (cdr (symbol-value ref-dep))
+ (list (symbol-value id-dep))))
+ (set ref-dep (list nil (symbol-value id-dep)))))
header))
(defun gnus-article-get-xrefs ()
(progn (end-of-line) (point))))
(mail-header-set-xref headers xref))))))))
-(defun gnus-summary-insert-subject (id &optional old-header)
+(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
"Find article ID and insert the summary line for that article."
- (let ((header (gnus-read-header id))
+ (let ((header (if (and old-header use-old-header)
+ old-header (gnus-read-header 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 (and (not gnus-show-threads)
+ old-header)
(when (setq pos (text-property-any
(point-min) (point-max) 'gnus-number
(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))
+ (delq (setq number (mail-header-number header))
+ gnus-newsgroup-sparse))
+ (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
(gnus-rebuild-thread (mail-header-id header))
- (gnus-summary-goto-subject (setq number (mail-header-number header))
- nil t))
+ (gnus-summary-goto-subject number nil t))
(when (and (numberp number)
(> number 0))
;; We have to update the boundaries even if we can't fetch the
(gnus-data-number result)))))
(defun gnus-summary-find-prev (&optional unread article)
- (let* ((article (or article (gnus-summary-article-number)))
+ (let* ((eobp (eobp))
+ (article (or article (gnus-summary-article-number)))
(arts (gnus-data-find-list article (gnus-data-list 'rev)))
result)
- (when (or (not gnus-summary-check-current)
- (not unread)
- (not (gnus-data-unread-p (car arts))))
+ (when (and (not eobp)
+ (or (not gnus-summary-check-current)
+ (not unread)
+ (not (gnus-data-unread-p (car arts)))))
(setq arts (cdr arts)))
(if (setq result
(if unread
;; 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))
+ (gnus-group-jump-to-group group))
(run-hooks 'gnus-summary-exit-hook)
+ (unless quit-config
+ (gnus-group-next-unread-group 1))
(if temporary
nil ;Nothing to do.
;; If we have several article buffers, we kill them at exit.
;; We read in the article if we have to.
(and (not data)
force
- (gnus-summary-insert-subject article)
+ (gnus-summary-insert-subject article (and (vectorp force) force) t)
(setq data (gnus-data-find article)))
(goto-char b)
(if (not data)
;; buffer as a result of the new limit.
(- total (length gnus-newsgroup-data))))
+(defsubst gnus-invisible-cut-children (threads)
+ (let ((num 0))
+ (while threads
+ (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit)
+ (incf num))
+ (pop threads))
+ (< num 2)))
+
(defsubst gnus-cut-thread (thread)
"Go forwards in the thread until we find an article that we want to display."
- (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)
+ (when (or (eq gnus-fetch-old-headers 'some)
+ (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))
+ ;; Deal with old-fetched headers and sparse threads.
+ (while (and
+ thread
+ (or
+ (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
+ (memq (mail-header-number (car thread)) gnus-newsgroup-ancient))
+ (or (<= (length (cdr thread)) 1)
+ (gnus-invisible-cut-children (cdr thread))))
(setq thread (cadr thread))))
thread)
;; children, then this article isn't visible.
(and (memq number gnus-newsgroup-dormant)
(= children 0))
- ;; If this is a "fetch-old-headered" and there is only one
+ ;; If this is "fetch-old-headered" and there is only one
;; visible child (or less), then we don't want this article.
(and (eq gnus-fetch-old-headers 'some)
(memq number gnus-newsgroup-ancient)
(setq message-id (concat "<" message-id)))
(unless (string-match ">$" message-id)
(setq message-id (concat message-id ">")))
- (let ((header (car (gnus-gethash message-id
- gnus-newsgroup-dependencies))))
+ (let* ((header (gnus-id-to-header message-id))
+ (sparse (memq (mail-header-number header) gnus-newsgroup-sparse)))
(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)
+ (prog1
+ ;; The article is present in the buffer, to we just go to it.
+ (gnus-summary-goto-article
+ (mail-header-number header) nil header)
+ (when sparse
+ (gnus-summary-update-article (mail-header-number header))))
;; We fetch the article
(let ((gnus-override-method
(and (gnus-news-group-p gnus-newsgroup-name)
(if (string-equal regexp "")
(setq regexp (or gnus-last-search-regexp ""))
(setq gnus-last-search-regexp regexp))
- (if (gnus-summary-search-article regexp backward)
- (gnus-article-set-window-start
- (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks)))
+ (unless (gnus-summary-search-article regexp backward)
(error "Search failed: \"%s\"" regexp)))
(defun gnus-summary-search-article-backward (regexp)
're-search-backward 're-search-forward))
(sum (current-buffer))
(found nil))
- ;; Hidden thread subtrees must be searched, too.
- (gnus-summary-show-all-threads)
- (gnus-summary-select-article)
- (set-buffer gnus-article-buffer)
- (while (not found)
- (gnus-message 7 "Searching article: %d..." gnus-current-article)
- (if (if backward
- (re-search-backward regexp nil t)
- (re-search-forward regexp nil t))
- ;; We found the regexp.
- (progn
- (setq found 'found)
- (beginning-of-line)
- (set-window-start
- (get-buffer-window (current-buffer))
- (point)))
- ;; We didn't find it, so we go to the next article.
- (set-buffer sum)
- (if (not (if backward (gnus-summary-find-prev)
- (gnus-summary-find-next)))
- ;; No more articles.
- (setq found t)
- ;; Select the next article and adjust point.
- (gnus-summary-select-article)
- (set-buffer gnus-article-buffer)
- (widen)
- (goto-char (if backward (point-max) (point-min))))))
- (set-buffer sum)
+ (gnus-save-hidden-threads
+ (gnus-summary-select-article)
+ (set-buffer gnus-article-buffer)
+ (while (not found)
+ (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current))
+ (if (if backward
+ (re-search-backward regexp nil t)
+ (re-search-forward regexp nil t))
+ ;; We found the regexp.
+ (progn
+ (setq found 'found)
+ (beginning-of-line)
+ (set-window-start
+ (get-buffer-window (current-buffer))
+ (point))
+ (forward-line 1)
+ (set-buffer sum))
+ ;; We didn't find it, so we go to the next article.
+ (set-buffer sum)
+ (if (not (if backward (gnus-summary-find-prev)
+ (gnus-summary-find-next)))
+ ;; No more articles.
+ (setq found t)
+ ;; Select the next article and adjust point.
+ (gnus-summary-select-article)
+ (set-buffer gnus-article-buffer)
+ (widen)
+ (goto-char (if backward (point-max) (point-min))))))
+ (gnus-message 7 ""))
;; Return whether we found the regexp.
- (eq found 'found)))
+ (when (eq found 'found)
+ (gnus-summary-show-thread)
+ (gnus-summary-goto-subject gnus-current-article)
+ (gnus-summary-position-point)
+ t)))
(defun gnus-summary-find-matching (header regexp &optional backward unread
not-case-fold)
gnus-article-buffer
(save-restriction
(widen)
- (let ((start (window-start)))
- (news-caesar-buffer-body arg)
+ (let ((start (window-start))
+ buffer-read-only)
+ (message-caesar-buffer-body arg)
(set-window-start (get-buffer-window (current-buffer)) start))))))
(defun gnus-summary-stop-page-breaking ()
(pp-eval-expression
(list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
-;; Summary score commands.
-
-;; Suggested by boubaker@cenatls.cena.dgac.fr.
-
-(defun gnus-summary-raise-score (n)
- "Raise the score of the current article by N."
- (interactive "p")
- (gnus-set-global-variables)
- (gnus-summary-set-score (+ (gnus-summary-article-score) n)))
-
-(defun gnus-summary-set-score (n)
- "Set the score of the current article to N."
- (interactive "p")
- (gnus-set-global-variables)
- (save-excursion
- (gnus-summary-show-thread)
- (let ((buffer-read-only nil))
- ;; Set score.
- (gnus-summary-update-mark
- (if (= n (or gnus-summary-default-score 0)) ?
- (if (< n (or gnus-summary-default-score 0))
- gnus-score-below-mark gnus-score-over-mark)) 'score))
- (let* ((article (gnus-summary-article-number))
- (score (assq article gnus-newsgroup-scored)))
- (if score (setcdr score n)
- (setq gnus-newsgroup-scored
- (cons (cons article n) gnus-newsgroup-scored))))
- (gnus-summary-update-line)))
-
-(defun gnus-summary-current-score ()
- "Return the score of the current article."
- (interactive)
- (gnus-set-global-variables)
- (gnus-message 1 "%s" (gnus-summary-article-score)))
-
;; Summary marking commands.
(defun gnus-summary-kill-same-subject-and-select (&optional unmark)
(interactive "P")
(gnus-set-global-variables)
(save-excursion
- (let ((beg (point)))
- ;; We check that there are unread articles.
- (when (or all (gnus-summary-find-prev))
- (gnus-summary-catchup all t beg))))
+ (gnus-save-hidden-threads
+ (let ((beg (point)))
+ ;; We check that there are unread articles.
+ (when (or all (gnus-summary-find-prev))
+ (gnus-summary-catchup all t beg)))))
(gnus-summary-position-point))
(defun gnus-summary-catchup-all (&optional quietly)
(defun gnus-sortable-date (date)
"Make sortable string by string-lessp from DATE.
Timezone package is used."
- (setq date (timezone-fix-time date nil nil))
- (timezone-make-sortable-date
- (aref date 0) (aref date 2) (aref date 2)
- (timezone-make-time-string
- (aref date 3) (aref date 4) (aref date 5))))
-
+ (condition-case ()
+ (progn
+ (setq date (inline (timezone-fix-time
+ date nil
+ (aref (inline (timezone-parse-date date)) 4))))
+ (inline
+ (timezone-make-sortable-date
+ (aref date 0) (aref date 1) (aref date 2)
+ (inline
+ (timezone-make-time-string
+ (aref date 3) (aref date 4) (aref date 5))))))
+ (error "")))
+
;; Summary saving commands.
(defun gnus-summary-save-article (&optional n not-saved)
(interactive "P")
(gnus-set-global-variables)
(let ((articles (gnus-summary-work-articles n))
+ (save-buffer (save-excursion
+ (nnheader-set-temp-buffer " *Gnus Save*")))
file header article)
(while articles
(setq header (gnus-summary-article-header
;; This is a real article.
(save-window-excursion
(gnus-summary-select-article t nil nil article))
+ (save-excursion
+ (set-buffer save-buffer)
+ (insert-buffer-substring gnus-original-article-buffer))
(unless gnus-save-all-headers
;; Remove headers accoring to `gnus-saved-headers'.
(let ((gnus-visible-headers
- (or gnus-saved-headers gnus-visible-headers)))
- (gnus-article-hide-headers nil t)))
- ;; Remove any X-Gnus lines.
- (save-excursion
- (set-buffer gnus-article-buffer)
- (save-restriction
- (let ((buffer-read-only nil))
- (nnheader-narrow-to-headers)
- (while (re-search-forward "^X-Gnus" nil t)
- (gnus-delete-line)))))
+ (or gnus-saved-headers gnus-visible-headers))
+ (gnus-article-buffer save-buffer))
+ (gnus-article-hide-headers 1 t)))
(save-window-excursion
(if (not gnus-default-article-saver)
(error "No default saver is defined.")
- (setq file (funcall
- gnus-default-article-saver
- (cond
- ((not gnus-prompt-before-saving)
- 'default)
- ((eq gnus-prompt-before-saving 'always)
- nil)
- (t file))))))
+ ;; !!! Magic! The saving functions all save
+ ;; `gnus-original-article-buffer' (or so they think),
+ ;; but we bind that variable to out save-buffer.
+ (set-buffer gnus-article-buffer)
+ (let ((gnus-original-article-buffer save-buffer))
+ (setq file (funcall
+ gnus-default-article-saver
+ (cond
+ ((not gnus-prompt-before-saving)
+ 'default)
+ ((eq gnus-prompt-before-saving 'always)
+ nil)
+ (t file)))))))
(gnus-summary-remove-process-mark article)
(unless not-saved
(gnus-summary-set-saved-mark article))))
+ (gnus-kill-buffer save-buffer)
(gnus-summary-position-point)
n))
(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))
+ (minibuffer-confirm-incomplete nil) ; XEmacs
group-map
(dum (mapatoms
(lambda (g)
(setq e (point))
(forward-line -1) ; back to `b'
(gnus-add-text-properties
- b e (list 'gnus-number gnus-reffed-article-number
- gnus-mouse-face-prop gnus-mouse-face))
+ b (1- e) (list 'gnus-number gnus-reffed-article-number
+ gnus-mouse-face-prop gnus-mouse-face))
(gnus-data-enter
after-article gnus-reffed-article-number
gnus-unread-mark b (car pslist) 0 (- e b))
;; 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)
+ ;;(numberp article)
(equal (buffer-name (current-buffer))
(buffer-name (get-buffer gnus-article-buffer))))
(save-excursion
;; numbers for this article.
(mail-header-set-number header gnus-reffed-article-number))
(decf gnus-reffed-article-number)
+ (gnus-remove-header (mail-header-number header))
(push header gnus-newsgroup-headers)
(setq gnus-current-headers header)
(push (mail-header-number header) gnus-newsgroup-limit))
header)))))
+(defun gnus-remove-header (number)
+ "Remove header NUMBER from `gnus-newsgroup-headers'."
+ (if (and gnus-newsgroup-headers
+ (= number (mail-header-number (car gnus-newsgroup-headers))))
+ (pop gnus-newsgroup-headers)
+ (let ((headers gnus-newsgroup-headers))
+ (while (and (cdr headers)
+ (not (= number (mail-header-number (cadr headers)))))
+ (pop headers))
+ (when (cdr headers)
+ (setcdr headers (cddr headers))))))
+
(defun gnus-article-prepare (article &optional all-headers header)
"Prepare ARTICLE in article mode buffer.
ARTICLE should either be an article number or a Message-ID.
If given a negative prefix, always show; if given a positive prefix,
always hide."
(interactive "P")
- (unless (gnus-article-check-hidden-text 'headers arg)
+ (if (gnus-article-check-hidden-text 'headers arg)
+ ;; Show boring headers as well.
+ (gnus-article-show-hidden-text 'boring-headers)
;; This function might be inhibited.
(unless gnus-inhibit-hiding
(save-excursion
(while (looking-at "From ")
(forward-line 1))
(unless (bobp)
- (gnus-hide-text (point-min) (point) props))
+ (if delete
+ (delete-region (point-min) (point))
+ (gnus-hide-text (point-min) (point) props)))
;; Then treat the rest of the header lines.
(narrow-to-region
(point)
(while (search-forward "\b" nil t)
(let ((next (following-char))
(previous (char-after (- (point) 2))))
- (cond ((eq next previous)
- (gnus-put-text-property (- (point) 2) (point) 'invisible t)
- (gnus-put-text-property (point) (1+ (point)) 'face 'bold))
- ((eq next ?_)
- (gnus-put-text-property (1- (point)) (1+ (point)) 'invisible t)
- (gnus-put-text-property
- (- (point) 2) (1- (point)) 'face 'underline))
- ((eq previous ?_)
- (gnus-put-text-property (- (point) 2) (point) 'invisible t)
- (gnus-put-text-property
- (point) (1+ (point)) 'face 'underline))))))))
+ (cond
+ ((eq next previous)
+ (gnus-put-text-property (- (point) 2) (point) 'invisible t)
+ (gnus-put-text-property (point) (1+ (point)) 'face 'bold))
+ ((eq next ?_)
+ (gnus-put-text-property (1- (point)) (1+ (point)) 'invisible t)
+ (gnus-put-text-property
+ (- (point) 2) (1- (point)) 'face 'underline))
+ ((eq previous ?_)
+ (gnus-put-text-property (- (point) 2) (point) 'invisible t)
+ (gnus-put-text-property
+ (point) (1+ (point)) 'face 'underline))))))))
(defun gnus-article-word-wrap ()
"Format too long lines."
(process-send-region "gnus-x-face" beg end)
(process-send-eof "gnus-x-face")))))))))
-(defalias 'gnus-header-decode-quoted-printable 'gnus-decode-rfc1522)
+(defalias 'gnus-headers-decode-quoted-printable 'gnus-decode-rfc1522)
(defun gnus-decode-rfc1522 ()
"Hack to remove QP encoding from headers."
(let ((case-fold-search t)
(while (looking-at "[ \t]$")
(gnus-delete-line))))))
+(defvar mime::preview/content-list)
+(defvar mime::preview-content-info/point-min)
(defun gnus-narrow-to-signature ()
"Narrow to the signature."
(widen)
+ (if (and (boundp 'mime::preview/content-list)
+ mime::preview/content-list)
+ (let ((pcinfo (car (last mime::preview/content-list))))
+ (narrow-to-region
+ (funcall (intern "mime::preview-content-info/point-min") pcinfo)
+ (point-max))
+ t))
(goto-char (point-max))
(when (re-search-backward gnus-signature-separator nil t)
(forward-line 1)
(set-buffer gnus-article-buffer)
(let ((hide (gnus-article-hidden-text-p type)))
(cond ((or (and (null arg) (eq hide 'hidden))
- (and arg (< 0 (prefix-numeric-value arg))))
+ (and arg (< (prefix-numeric-value arg) 1)))
(gnus-article-show-hidden-text type))
+ ((and (numberp arg) (> (prefix-numeric-value arg) 0))
+ nil)
((eq hide 'shown)
(gnus-article-show-hidden-text type t))
(t nil)))))
(prog1
(concat (if prev ", " "") (int-to-string
(floor num))
- " " (symbol-name (car unit))
+ " " (symbol-name (car unit))
(if (> num 1) "s" ""))
(setq prev t))))
gnus-article-time-units "")
(if (gnus-visual-p 'article-highlight 'highlight)
(gnus-article-highlight-some)))
-;; Article savers.
+;;; Article savers.
(defun gnus-output-to-rmail (file-name)
"Append the current article to an Rmail file named FILE-NAME."
(setq gnus-dribble-eval-file t)))))))
(defun gnus-dribble-eval-file ()
- (if (not gnus-dribble-eval-file)
- ()
+ (when gnus-dribble-eval-file
(setq gnus-dribble-eval-file nil)
(save-excursion
(let ((gnus-dribble-ignore t))
(eval-buffer (current-buffer))))))
(defun gnus-dribble-delete-file ()
- (if (file-exists-p (gnus-dribble-file-name))
- (delete-file (gnus-dribble-file-name)))
- (if gnus-dribble-buffer
- (save-excursion
- (set-buffer gnus-dribble-buffer)
- (let ((auto (make-auto-save-file-name)))
- (if (file-exists-p auto)
- (delete-file auto))
- (erase-buffer)
- (set-buffer-modified-p nil)))))
+ (when (file-exists-p (gnus-dribble-file-name))
+ (delete-file (gnus-dribble-file-name)))
+ (when gnus-dribble-buffer
+ (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (let ((auto (make-auto-save-file-name)))
+ (if (file-exists-p auto)
+ (delete-file auto))
+ (erase-buffer)
+ (set-buffer-modified-p nil)))))
(defun gnus-dribble-save ()
- (if (and gnus-dribble-buffer
- (buffer-name gnus-dribble-buffer))
- (save-excursion
- (set-buffer gnus-dribble-buffer)
- (save-buffer))))
+ (when (and gnus-dribble-buffer
+ (buffer-name gnus-dribble-buffer))
+ (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (save-buffer))))
(defun gnus-dribble-clear ()
- (save-excursion
- (if (gnus-buffer-exists-p gnus-dribble-buffer)
- (progn
- (set-buffer gnus-dribble-buffer)
- (erase-buffer)
- (set-buffer-modified-p nil)
- (setq buffer-saved-size (buffer-size))))))
+ (when (gnus-buffer-exists-p gnus-dribble-buffer)
+ (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (erase-buffer)
+ (set-buffer-modified-p nil)
+ (setq buffer-saved-size (buffer-size)))))
\f
;;;
;; Possibly eval the dribble file.
(and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file))
+ ;; Slave Gnusii should then clear the dribble buffer.
+ (when (and init gnus-slave)
+ (gnus-dribble-clear))
+
(gnus-update-format-specifications)
;; See whether we need to read the description file.
(unless (equal method gnus-message-archive-method)
(gnus-error 1 "Cannot read active file from %s server."
(car method)))
+ (gnus-message 5 mesg)
(gnus-active-to-gnus-format method gnus-active-hashtb)
;; We mark this active file as read.
(push method gnus-have-read-active-file)
(defun gnus-continuum-version (version)
"Return VERSION as a floating point number."
- (when (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
+ (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
+ (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
(let* ((alpha (and (match-beginning 1) (match-string 1 version)))
(number (match-string 2 version))
major minor least)
(if (zerop major)
(format "%s00%02d%02d"
(cond
- ((string= alpha "(ding)") "4.99")
- ((string= alpha "September") "5.01")
- ((string= alpha "Red") "5.03"))
+ ((member alpha '("(ding)" "d")) "4.99")
+ ((member alpha '("September" "s")) "5.01")
+ ((member alpha '("Red" "r")) "5.03"))
minor least)
- (format "%d.%02d%20d" major minor least))))))
+ (format "%d.%02d%02d" major minor least))))))
(defun gnus-convert-old-newsrc ()
"Convert old newsrc into the new format, if needed."
killed gnus-killed-assoc
marked gnus-marked-assoc)))
(setq gnus-newsrc-alist nil)
- (while (setq info (gnus-get-info (setq group (pop newsrc))))
- (if info
+ (while (setq group (pop newsrc))
+ (if (setq info (gnus-get-info (car group)))
(progn
(gnus-info-set-read info (cddr group))
(gnus-info-set-level
(setq version-control 'never)
(setq buffer-file-name
(concat gnus-current-startup-file ".eld"))
+ (setq default-directory (file-name-directory buffer-file-name))
(gnus-add-current-to-buffer-list)
(buffer-disable-undo (current-buffer))
(erase-buffer)
(standard-output (current-buffer))
info ranges range method)
(setq buffer-file-name gnus-current-startup-file)
+ (setq default-directory (file-name-directory buffer-file-name))
(buffer-disable-undo (current-buffer))
(erase-buffer)
;; Write options.
projects / gnus / blobdiff