+Sun May 12 01:29:12 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no (Lars Magne Ingebrigtsen)>
+
+ * gnus-xmas.el (gnus-xmas-summary-recenter): Protect against evil.
+
+Sat May 11 23:23:15 1996 Michael Sperber <sperber@informatik.uni-tuebingen.de>
+
+ * gnus-xmas.el (gnus-xmas-summary-recenter): Would act oddly.
+
+Fri May 10 22:49:46 1996 Lars Magne Ingebrigtsen <larsi@hler.ifi.uio.no>
+
+ * nnheader.el (nnheader-parse-head): Deal with naked heads.
+
+ * nnml.el (nnml-parse-head): `naked' heads.
+
+Fri May 10 00:27:59 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-group-mark-group): Didn't work well in topic
+ buffers.
+ (gnus-read-active-file-p): New function.
+ (gnus-group-list-killed): Read active file.
+ (gnus-group-list-active): Ditto.
+ (gnus-group-list-matching): Possibly read active file.
+ (gnus-get-killed-groups): Separated into own function.
+ (gnus-update-group-mark-positions): Don't define "dummy.group".
+
+ * gnus-topic.el (gnus-topic-rename): Use topic under point.
+ (gnus-topic-create-topic): Don't prompt for parent topic.
+ (gnus-topic-create-topic): Go to the new topic.
+
+ * gnus.el (gnus-mime-decode-quoted-printable): Preserve text
+ props.
+ (gnus-article-date-ut): Would bug out on read-only.
+
+Thu May 9 11:12:30 1996 Steven L Baur <steve@miranova.com>
+
+ * message.el (message-followup): Correct typos in regular expression
+ matching ``Re:''.
+
+Thu May 9 20:38:10 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-uu.el (gnus-uu-delete-work-dir): Don't message so much.
+
+Wed May 8 03:20:23 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * nnmail.el (nnmail-process-unix-mail-format): Didn't nix out
+ bogus Message-ID headers properly.
+
+ * nnml.el (nnml-parse-head): Use nnheader functions for parsing
+ and generating nov headers.
+
+Wed May 8 22:55:56 1996 Lars Magne Ingebrigtsen <larsi@aegir.ifi.uio.no>
+
+ * gnus.el (gnus-execute-command): Make sure the buffer isn't
+ read-onl|y.
+ (gnus-article-prepare): Would perform hooks on pseudo articles.
+
+ * gnus-uu.el (gnus-uu-mark-sparse): Would bug out on pseudos.
+ (gnus-uu-mark-all): Ditto.
+
+ * gnus.el (gnus-request-article-this-buffer): Ignore canceled
+ articles.
+ (gnus-summary-next-page): Pass by canceled articles.
+
+ * message.el (message-check-element): Reverse logic.
+
+Wed May 8 22:36:18 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus.el (gnus-tree-buffer): Moved from gnus-salt.el.
+
+Wed May 8 23:45:46 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
+
+ * gnus.el (gnus-no-server): New definition.
+ (gnus-group-default-level): Use permanent levels.
+
+Wed May 8 21:35:35 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus.el (gnus-summary-select-article):
+
Tue May 7 21:49:30 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+ * gnus.el: 0.83 is released.
+
+ * gnus.el: September Gnus v0.83 is released.
+
* gnus.el (gnus-summary-insert-subject): Would change article
number.
(gnus-summary-display-article): Go to the right article when
(defvar gnus-tree-mode-hook nil
"*Hook run in tree mode buffers.")
-(defvar gnus-tree-buffer "*Tree*"
- "Buffer where Gnus thread trees are displayed.")
-
;;; Internal variables.
(defvar gnus-tree-line-format-alist
parent (- old-unread (gnus-group-topic-unread))))
unread))
-(defun gnus-topic-grok-active (&optional force read-active)
+(defun gnus-topic-grok-active (&optional force)
"Parse all active groups and create topic structures for them."
;; First we make sure that we have really read the active file.
(when (or force
(not gnus-topic-active-alist))
- (when (and read-active
- (or force
- (not (member gnus-select-method
- gnus-have-read-active-file))))
- (let ((gnus-read-active-file t))
- (gnus-read-active-file)))
(let (groups)
;; Get a list of all groups available.
(mapatoms (lambda (g) (when (symbol-value g)
(interactive
(list
(read-string "Create topic: ")
- (completing-read "Parent topic: " gnus-topic-alist nil t
- (cons (gnus-group-parent-topic) 0))))
+ (gnus-group-parent-topic)))
;; Check whether this topic already exists.
(when (gnus-topic-find-topology topic)
(error "Topic aleady exists"))
(unless (assoc topic gnus-topic-alist)
(push (list topic) gnus-topic-alist)))
(gnus-topic-enter-dribble)
- (gnus-group-list-groups))
+ (gnus-group-list-groups)
+ (gnus-topic-goto-topic topic))
(defun gnus-topic-move-group (n topic &optional copyp)
"Move the current group to a topic."
(defun gnus-topic-rename (old-name new-name)
"Rename a topic."
(interactive
- (let (topic)
- (list
- (setq topic (completing-read "Rename topic: " gnus-topic-alist nil t
- (cons (gnus-group-parent-topic) 0)))
- (read-string (format "Rename %s to: " topic)))))
+ (let ((topic (gnus-group-parent-topic)))
+ (list topic
+ (read-string (format "Rename %s to: " topic)))))
(let ((top (gnus-topic-find-topology old-name))
(entry (assoc old-name gnus-topic-alist)))
(when top
"List all groups that Gnus knows about in a topicsified fashion.
If FORCE, always re-read the active file."
(interactive "P")
- (gnus-topic-grok-active force force)
+ (when force
+ (gnus-get-killed-groups))
+ (gnus-topic-grok-active force)
(let ((gnus-topic-topology gnus-topic-active-topology)
(gnus-topic-alist gnus-topic-active-alist)
gnus-killed-list gnus-zombie-list)
(setq gnus-newsgroup-processable nil)
(save-excursion
(while marked
- (and (setq headers (gnus-summary-article-header (car marked)))
+ (and (vectorp (setq headers
+ (gnus-summary-article-header (car marked))))
(setq subject (mail-header-subject headers)
articles (gnus-uu-find-articles-matching
(gnus-uu-reginize-string subject))
(let ((data gnus-newsgroup-data)
number)
(while data
- (unless (memq (setq number (gnus-data-number (car data)))
- gnus-newsgroup-processable)
+ (when (and (not (memq (setq number (gnus-data-number (car data)))
+ gnus-newsgroup-processable))
+ (vectorp (gnus-data-header (car data))))
(gnus-summary-goto-subject number)
(gnus-uu-mark-series))
(setq data (cdr data)))))
(defun gnus-uu-delete-work-dir (&optional dir)
"Delete recursively all files and directories under `gnus-uu-work-dir'."
- (unless dir
+ (if dir
+ (gnus-message 7 "Deleting directory %s..." dir)
(setq dir gnus-uu-work-dir))
- (gnus-message 7 "Deleting directory %s..." dir)
(when (and dir
(file-exists-p dir))
(let ((files (directory-files dir t nil t))
gnus-summary-selected-face))))
(defun gnus-xmas-summary-recenter ()
- "Center point in the summary window.
+ "\"Center\" point in the summary window.
If `gnus-auto-center-summary' is nil, or the article buffer isn't
displayed, no centering will be performed."
;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
- (let* ((top (cond ((< (window-height) 4) 0)
- ((< (window-height) 7) 1)
- (t 2)))
- (height (- (window-height) 3))
- (bottom (save-excursion (goto-char (point-max))
- (forward-line (- height))
- (point)))
- (window (get-buffer-window (current-buffer))))
- ;; The user has to want it.
- (when gnus-auto-center-summary
+ (when gnus-auto-center-summary
+ (let* ((height (if (fboundp 'window-displayed-height)
+ (window-displayed-height)
+ (- (window-height) 2)))
+ (top (cond ((< height 4) 0)
+ ((< height 7) 1)
+ (t 2)))
+ (bottom (save-excursion (goto-char (point-max))
+ (forward-line (- height))
+ (point)))
+ (window (get-buffer-window (current-buffer))))
(when (get-buffer-window gnus-article-buffer)
- ;; Only do recentering when the article buffer is displayed,
- ;; Set the window start to either `bottom', which is the biggest
- ;; possible valid number, or the second line from the top,
- ;; whichever is the least.
- (set-window-start
- window (min bottom (save-excursion
- (forward-line (- top)) (point)))))
+ ;; Only do recentering when the article buffer is displayed,
+ ;; Set the window start to either `bottom', which is the biggest
+ ;; possible valid number, or the second line from the top,
+ ;; whichever is the least.
+ (set-window-start
+ window (min bottom (save-excursion
+ (forward-line (- top)) (point)))))
;; Do horizontal recentering while we're at it.
(when (and (get-buffer-window (current-buffer) t)
(not (eq gnus-auto-center-summary 'vertical)))
\f
;; Internal variables
+(defvar gnus-tree-buffer "*Tree*"
+ "Buffer where Gnus thread trees are displayed.")
+
;; Dummy variable.
(defvar gnus-use-generic-from nil)
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.83"
+(defconst gnus-version "September Gnus v0.84"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
(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 ()
(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)
(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))
(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)))
(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)))
(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.
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))
(funcall gnus-summary-display-article-function article all-header)
(gnus-article-prepare article all-header))
(run-hooks 'gnus-select-article-hook)
- (gnus-summary-recenter) gnus-current-article
- (gnus-summary-goto-subject gnus-current-article)
+ (unless (zerop gnus-current-article)
+ (gnus-summary-goto-subject gnus-current-article))
+ (gnus-summary-recenter)
(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-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))
(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
(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
+ (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)
(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))
"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)
(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))
" ago\n"
" in the future\n")))))
(t
- (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)))))))
+ (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."
(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)
`right-toolbar', and `left-toolbar'.")
(defvar message-toolbar
- '([message-copy message-copy t "Copy message"]
- [message-delete message-delete t "Delete message"]
- [message-forward message-forward t "Forward message"]
+ '(
+ [message-reply message-reply t "Reply"]
[message-get message-get t "Message get"]
- [message-help message-help t "Message help"]
[message-originate message-originate t "Originate"]
- [message-reply message-reply t "Reply"]
[message-save message-save t "Save"]
- [message-spell message-spell t "Spell"])
+ [message-copy message-copy t "Copy message"]
+ [message-delete message-delete t "Delete message"]
+ [message-forward message-forward t "Forward message"]
+ [message-spell message-spell t "Spell"]
+ [message-help message-help t "Message help"]
+ )
"The message buffer toolbar.")
(defun message-xmas-find-glyph-directory (&optional package)
(defun message-check-element (type)
"Returns non-nil if this type is not to be checked."
(if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me)
- nil
+ t
(let ((able (assq type message-syntax-checks)))
(and (consp able)
(eq (cdr able) 'disabled)))))
message-id (mail-fetch-field "message-id"))
;; Remove any (buggy) Re:'s that are present and make a
;; proper one.
- (when (string-match "^[ \t]*[Re][Ee]:[ \t]*" subject)
+ (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject)
(setq subject (substring subject (match-end 0))))
(setq subject (concat "Re: " subject))
(setq distribution nil))
;; Remove any (buggy) Re:'s that are present and make a
;; proper one.
- (when (string-match "^[ \t]*[Re][Ee]:[ \t]*" subject)
+ (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject)
(setq subject (substring subject (match-end 0))))
(setq subject (concat "Re: " subject))
(widen))
(defvar nnheader-newsgroup-none-id 1)
-(defun nnheader-parse-head ()
+(defun nnheader-parse-head (&optional naked)
(let ((case-fold-search t)
(cur (current-buffer))
end ref in-reply-to lines p)
(goto-char (point-min))
;; Search to the beginning of the next header. Error messages
;; do not begin with 2 or 3.
- (when (re-search-forward "^[23][0-9]+ " nil t)
+ (when (or naked (re-search-forward "^[23][0-9]+ " nil t))
;; This implementation of this function, with nine
;; search-forwards instead of the one re-search-forward and
;; a case (which basically was the old function) is actually
;; doesn't always go hand in hand.
(vector
;; Number.
- (prog1
- (read cur)
- (end-of-line)
- (setq p (point))
- (narrow-to-region (point)
- (or (and (search-forward "\n.\n" nil t)
- (- (point) 2))
- (point))))
+ (if naked
+ (progn
+ (setq p (point-min))
+ 0)
+ (prog1
+ (read cur)
+ (end-of-line)
+ (setq p (point))
+ (narrow-to-region (point)
+ (or (and (search-forward "\n.\n" nil t)
+ (- (point) 2))
+ (point)))))
;; Subject.
(progn
(goto-char p)
(princ (mail-header-number header) (current-buffer))
(insert
"\t"
- (or (mail-header-subject header) "") "\t"
- (or (mail-header-from header) "") "\t"
+ (or (mail-header-subject header) "(none)") "\t"
+ (or (mail-header-from header) "(nobody)") "\t"
(or (mail-header-date header) "") "\t"
(or (mail-header-id header) "") "\t"
(or (mail-header-references header) "") "\t")
(if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
(setq message-id (match-string 1))
(save-excursion
- (when (re-search-backward "^Message-ID:" nil t)
+ (when (re-search-forward "^Message-ID:" nil t)
(beginning-of-line)
(insert "Original-")))
;; There is no Message-ID here, so we create one.
()
(let ((chars (nnmail-insert-lines))
(art (concat (int-to-string article) "\t"))
- nov-line)
- (setq nov-line (nnml-make-nov-line chars))
+ headers)
+ (setq headers (nnml-parse-head chars article))
;; Replace the NOV line in the NOV file.
(save-excursion
(set-buffer (nnml-open-nov group))
article)
(zerop (forward-line 1)))))
(beginning-of-line)
- (insert (int-to-string article) nov-line)
+ (nnheader-insert-nov headers)
(nnml-save-nov)
t)))))
(defun nnml-save-mail ()
"Called narrowed to an article."
(let ((group-art (nreverse (nnmail-article-group 'nnml-active-number)))
- chars nov-line)
+ chars headers)
(setq chars (nnmail-insert-lines))
(nnmail-insert-xref group-art)
(run-hooks 'nnmail-prepare-save-mail-hook)
;; Generate a nov line for this article. We generate the nov
;; line after saving, because nov generation destroys the
;; header.
- (setq nov-line (nnml-make-nov-line chars))
+ (setq headers (nnml-parse-head chars))
;; Output the nov line to all nov databases that should have it.
(let ((ga group-art))
(while ga
- (nnml-add-nov (caar ga) (cdar ga) nov-line)
+ (nnml-add-nov (caar ga) (cdar ga) headers)
(setq ga (cdr ga))))
group-art))
(setcdr active (1+ (cdr active))))
(cdr active)))
-(defun nnml-add-nov (group article line)
+(defun nnml-add-nov (group article headers)
"Add a nov line for the GROUP base."
(save-excursion
(set-buffer (nnml-open-nov group))
(goto-char (point-max))
- (insert (int-to-string article) line)))
+ (mail-header-set-number headers article)
+ (nnheader-insert-nov headers)))
(defsubst nnml-header-value ()
(buffer-substring (match-end 0) (progn (end-of-line) (point))))
-(defun nnml-make-nov-line (chars)
- "Create a nov from the current headers."
- (let ((case-fold-search t)
- subject from date id references lines xref in-reply-to char)
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (narrow-to-region
- (point)
- (1- (or (search-forward "\n\n" nil t) (point-max))))
- ;; Fold continuation lines.
- (goto-char (point-min))
- (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " " t t))
- (subst-char-in-region (point-min) (point-max) ?\t ? )
- ;; [number subject from date id references chars lines xref]
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^\\(from\\|subject\\|message-id\\|date\\|lines\\|xref\\|references\\|in-reply-to\\): "
- nil t)
- (beginning-of-line)
- (setq char (downcase (following-char)))
- (cond
- ((eq char ?s)
- (setq subject (nnml-header-value)))
- ((eq char ?f)
- (setq from (nnml-header-value)))
- ((eq char ?x)
- (setq xref (buffer-substring (match-beginning 0)
- (progn (end-of-line) (point)))))
- ((eq char ?l)
- (setq lines (nnml-header-value)))
- ((eq char ?d)
- (setq date (nnml-header-value)))
- ((eq char ?m)
- (setq id (setq id (nnml-header-value))))
- ((eq char ?r)
- (setq references (nnml-header-value)))
- ((eq char ?i)
- (setq in-reply-to (nnml-header-value))))
- (forward-line 1))
-
- (and (not references)
- in-reply-to
- (string-match "<[^>]+>" in-reply-to)
- (setq references
- (substring in-reply-to (match-beginning 0)
- (match-end 0)))))
- ;; [number subject from date id references chars lines xref]
- (format "\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t%s\t\n"
- (or subject "(none)") (or from "(nobody)") (or date "")
- (or id (nnmail-message-id))
- (or references "") (or chars 0) (or lines "0")
- (or xref ""))))))
+(defun nnml-parse-head (chars &optional number)
+ "Parse the head of the current buffer."
+ (save-excursion
+ (save-restriction
+ (goto-char (point-min))
+ (narrow-to-region
+ (point)
+ (1- (or (search-forward "\n\n" nil t) (point-max))))
+ ;; Fold continuation lines.
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+ (replace-match " " t t))
+ ;; Remove any tabs; they are too confusing.
+ (subst-char-in-region (point-min) (point-max) ?\t ? )
+ (let ((headers (nnheader-parse-head t)))
+ (mail-header-set-chars headers chars)
+ (mail-header-set-number headers number)
+ headers))))
(defun nnml-open-nov (group)
(or (cdr (assoc group nnml-nov-buffer-alist))
(when (and (not (= 0 chars)) ; none of them empty files...
(not (= (point-min) (point-max))))
(goto-char (point-min))
- (setq nov-line (nnml-make-nov-line chars))
+ (setq headers (nnml-parse-head chars (car files)))
(save-excursion
(set-buffer nov-buffer)
(goto-char (point-max))
- (insert (int-to-string (car files)) nov-line)))
+ (nnheader-insert-nov headers)))
(widen))
(setq files (cdr files)))
(save-excursion
projects / gnus / commitdiff