Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

*** empty log message ***

  • Loading branch information...
commit 9e963b33beeb05c21d330e1ee5008cb0b9c9c2a1 1 parent 44a2a6a
@larsmagne larsmagne authored
View
12 Makefile
@@ -1,12 +0,0 @@
-EMACS=emacs
-
-all: lick info
-
-lick:
- cd lisp; $(MAKE) EMACS=$(EMACS) all
-
-some:
- cd lisp; $(MAKE) EMACS=$(EMACS) some
-
-info:
- cd texi; $(MAKE) EMACS=$(EMACS) all
View
134 lisp/ChangeLog
@@ -1,5 +1,139 @@
+Tue May 21 20:08:33 1996 Lars Magne Ingebrigtsen <larsi@trym.ifi.uio.no>
+
+ * gnus.el (gnus-dribble-read-file): Don't do modes unless they are
+ available.
+
+ * gnus-score.el (gnus-summary-score-entry): Wouldn't show
+ immediate scorign of followups.
+ (gnus-score-save): Use prin1 instead of format.
+
+ * gnus-msg.el (gnus-bug-kill-buffer): Bogus.
+
+Tue May 21 18:32:29 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * gnus-vis.el (gnus-button-next-page): New command.
+ (gnus-button-prev-page): Ditto.
+
+ * gnus-topic.el (gnus-topic-unique): Removed variable.
+ (gnus-current-topic): New function.
+ (gnus-topic-move-group): Use it.
+ (gnus-topic-goto-next-group): Use it.
+
+Tue May 21 11:08:42 1996 Steven L Baur <steve@miranova.com>
+
+ * gnus-setup.el: Copyright assigned to FSF.
+
+Tue May 21 17:09:27 1996 Lars Magne Ingebrigtsen <larsi@ylfing.ifi.uio.no>
+
+ * message.el (message-fetch-field): New function.
+
+ * gnus.el (gnus-directory): New variable.
+
+ * message.el (message-directory): New variable.
+
+ * nnmail.el (nnmail-insert-lines): Make sure point is at the
+ beginning of the line.
+ (nnmail-directory): New variable.
+
+ * gnus.el (gnus-mode-string-quote): New function.
+ (gnus-set-mode-line): Use it.
+
+Tue May 21 10:34:26 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-msg.el (gnus-inews-do-gcc): Use message narrow to headers.
+ (gnus-inews-do-gcc): Find the right archive method.
+
+ * gnus.el (gnus-select-newsgroup): Check whether the group can be
+ requested first.
+ (gnus-no-server): Nonsensical.
+ (gnus-group-mark-group): Go past topic lines.
+ (gnus-server-to-method): Would return nil on select methods.
+
+ * gnus-topic.el (gnus-topic-mode): Don't check topology unless we
+ have the newsrc alist.
+ (gnus-topic-check-topology): Wouldn't check topology properly.
+
+ * nnsoup.el (nnsoup-request-list): Make sure the active file is
+ read first.
+
+ * gnus.el (gnus-sortable-date): Simplified.
+ (gnus-group-set-mode-line): Remove the ":" if the server is "".
+
+Tue May 21 10:13:28 1996 Jack Vinson <jvinson@cheux.ecs.umass.edu>
+
+ * message.el (message-rename-buffer): New command and keystroke.
+
+Mon May 20 10:15:12 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-summary-search-article): New implementation; set
+ point in the article buffer to the match.
+ (gnus-parent-headers): New function.
+ (gnus-dd-mmm): Protect against broken dates.
+
+ * gnus-topic.el (gnus-topic-unread): New function.
+ (gnus-topic-update-topic-line): Use it.
+
+ * gnus.el (gnus-group-list-active): Protect against unbound
+ symbols.
+
+Mon May 20 00:31:36 1996 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * nnmail.el (nnmail-article-group): Do not split into empty list
+ of groups.
+
+Mon May 20 09:42:15 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-picon.el: Ran `indent-sexp' over file.
+ (gnus-article-display-picons): Make sure there is a From before
+ doing anything.
+
+ * nnfolder.el (nnfolder-save-mail): Insert a blank line before the
+ From line.
+
+ * message.el (message-mode-map): Changed key.
+ (message-sort-headers): `start-open' text props.
+ (message-sort-headers): Would sort oddly on continuation lines.
+
+Sun May 19 20:26:50 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-group-set-mode-line): Longer "modified".
+
+ * gnus-uu.el (gnus-uu-grab-articles): Don't do any display hooks.
+
+Sun May 19 19:42:55 1996 Hallvard B. Furuseth <h.b.furuseth@usit.uio.no>
+
+ * message.el (message-y-or-n-p, message-talkative-question,
+ message-flatten-list, message-flatten-list-1): New functions.
+
+Sun May 19 17:28:48 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * message.el (message-mode-map): Define \t.
+ (message-newgroups-header-regexp): New variable.
+ (message-tab): New command.
+ (message-expand-group): New function.
+
+ * gnus-msg.el (gnus-group-post-news): Don't prompt.
+
+ * gnus.el (gnus-group-update-group-line): Preserve indentation.
+
+ * gnus-msg.el (gnus-copy-article-buffer): Copy the head from the
+ original article buffer.
+
+ * gnus-vm.el: Decimated.
+
+ * gnus-mh.el (gnus-mh-mail-send-and-exit): Removed.
+ (gnus-mh-mail-setup): Removed.
+
+ * message.el (message-send-mail-with-sendmail): Renamed.
+ (message-send-mail-with-mh): New function.
+
+ * gnus-salt.el (gnus-pick-start-reading): Select the first
+ article.
+
Sun May 19 09:58:30 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
+ * gnus.el: September Gnus v0.89 is released.
+
* gnus.el (gnus-group-set-mode-line): Make sure we're in the group
buffer.
View
2  lisp/gnus-cache.el
@@ -29,7 +29,7 @@
(eval-when-compile (require 'cl))
(defvar gnus-cache-directory
- (concat (file-name-as-directory gnus-article-save-directory) "cache/")
+ (nnheader-concat gnus-directory "cache/")
"*The directory where cached articles will be stored.")
(defvar gnus-cache-active-file
View
7 lisp/gnus-kill.el
@@ -312,18 +312,17 @@ If NEWSGROUP is nil, return the global kill file instead."
(cond ((or (null newsgroup)
(string-equal newsgroup ""))
;; The global kill file is placed at top of the directory.
- (expand-file-name gnus-kill-file-name
- (or gnus-kill-files-directory "~/News")))
+ (expand-file-name gnus-kill-file-name gnus-kill-files-directory))
(gnus-use-long-file-name
;; Append ".KILL" to capitalized newsgroup name.
(expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
"." gnus-kill-file-name)
- (or gnus-kill-files-directory "~/News")))
+ gnus-kill-files-directory))
(t
;; Place "KILL" under the hierarchical directory.
(expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
"/" gnus-kill-file-name)
- (or gnus-kill-files-directory "~/News")))))
+ gnus-kill-files-directory))))
(defun gnus-expunge (marks)
"Remove lines marked with MARKS."
View
39 lisp/gnus-mh.el
@@ -81,43 +81,6 @@ Optional argument FOLDER specifies folder name."
(kill-buffer errbuf))))
(setq gnus-newsgroup-last-folder folder)))
-(defun gnus-mh-mail-setup (to subject in-reply-to cc replybuffer actions)
- (let ((config (current-window-configuration)))
- (mh-find-path)
- (mh-send-sub (or to "") (or cc "") (or subject "") config)
- (when in-reply-to
- (save-excursion
- (goto-char (point-min))
- (insert "In-Reply-To: " in-reply-to "\n")))
- (setq mh-sent-from-folder gnus-original-article-buffer)
- (setq mh-sent-from-msg 1)
- (setq gnus-message-buffer (buffer-name (current-buffer)))
- (setq mail-reply-buffer replybuffer)
- (save-excursion
- (set-buffer mh-sent-from-folder)
- (setq mh-show-buffer replybuffer))
- (use-local-map (copy-keymap (current-local-map)))
- (local-set-key "\C-c\C-c" 'gnus-mh-mail-send-and-exit)
- (setq mh-show-buffer gnus-article-copy)
- (setq mh-previous-window-config config)))
-
-(defun gnus-mh-mail-send-and-exit (&optional dont-send)
- "Send the current mail and return to Gnus."
- (interactive)
- (let ((reply gnus-article-reply)
- (winconf gnus-prev-winconf))
- (or dont-send (mh-send-letter))
- (bury-buffer)
- (if (get-buffer gnus-group-buffer)
- (progn
- (if (gnus-buffer-exists-p (car-safe reply))
- (progn
- (set-buffer (car reply))
- (and (cdr reply)
- (gnus-summary-mark-article-as-replied
- (cdr reply)))))
- (and winconf (set-window-configuration winconf))))))
-
(defun gnus-Folder-save-name (newsgroup headers &optional last-folder)
"Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
If variable `gnus-use-long-file-name' is nil, it is +News.group.
@@ -138,4 +101,6 @@ Otherwise, it is like +news/group."
newsgroup
(gnus-newsgroup-directory-form newsgroup)))))
+(provide 'gnus-mh)
+
;;; gnus-mh.el ends here
View
59 lisp/gnus-msg.el
@@ -71,8 +71,7 @@ gatewayed to a newsgroup, and you want to followup to an article in
the group.")
(defvar gnus-sent-message-ids-file
- (concat (file-name-as-directory gnus-article-save-directory)
- "Sent-Message-IDs")
+ (nnheader-concat gnus-directory "Sent-Message-IDs")
"File where Gnus saves a cache of sent message ids.")
(defvar gnus-sent-message-ids-length 1000
@@ -165,29 +164,17 @@ the group.")
(gnus-setup-message 'message
(message-mail)))
-(defun gnus-group-post-news (&optional arg)
- "Post an article.
-The newsgroup under the cursor is used as the group to post to.
-
-If you wish to get an empty post buffer, use a prefix ARG. You can
-also do this by calling this function from the bottom of the Group
-buffer."
- (interactive "P")
- (gnus-setup-message 'message
- (let ((gnus-newsgroup-name nil)
- (group (unless arg (gnus-group-group-name))))
- ;; We might want to prompt here.
- (when (and gnus-interactive-post
- (not gnus-expert-user))
- (setq gnus-newsgroup-name
- (setq group
- (gnus-completing-read group "Group:"
- gnus-active-hashtb nil nil nil
- 'gnus-group-history))))
- (gnus-post-news 'post group))))
+(defun gnus-group-post-news ()
+ "Start composing a news message.
+The newsgroup under the cursor is used as the group to post to."
+ (interactive)
+ ;; Bind this variable here to make message mode hooks
+ ;; work ok.
+ (let ((gnus-newsgroup-name (gnus-group-group-name)))
+ (gnus-post-news 'post (gnus-group-group-name))))
(defun gnus-summary-post-news ()
- "Post an article."
+ "Start composing a news message."
(interactive)
(gnus-set-global-variables)
(gnus-post-news 'post gnus-newsgroup-name))
@@ -277,7 +264,8 @@ header line with the old Message-ID."
(buffer-disable-undo gnus-article-copy)
(or (memq gnus-article-copy gnus-buffer-list)
(setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list)))
- (let ((article-buffer (or article-buffer gnus-article-buffer)))
+ (let ((article-buffer (or article-buffer gnus-article-buffer))
+ end)
(when (and (get-buffer article-buffer)
(buffer-name (get-buffer article-buffer)))
(save-excursion
@@ -285,9 +273,15 @@ header line with the old Message-ID."
(save-restriction
(widen)
(copy-to-buffer gnus-article-copy (point-min) (point-max))
- (gnus-set-text-properties (point-min) (point-max)
- nil gnus-article-copy))))
- gnus-article-copy))
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (setq end (or (search-forward "\n\n" nil t) (point)))
+ (set-buffer gnus-article-copy)
+ (gnus-set-text-properties (point-min) (point-max) nil)
+ (delete-region (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point)))
+ (insert-buffer-substring gnus-original-article-buffer 1 end)))
+ gnus-article-copy)))
(defun gnus-post-news (post &optional group header article-buffer yank subject
force-news)
@@ -687,8 +681,7 @@ If YANK is non-nil, include the original article."
(defun gnus-bug-kill-buffer ()
(and (get-buffer "*Gnus Help Bug*")
- (kill-buffer "*Gnus Help Bug*"))
- (kill-buffer nil))
+ (kill-buffer "*Gnus Help Bug*")))
(defun gnus-debug ()
"Attemps to go through the Gnus source file and report what variables have been changed.
@@ -783,7 +776,7 @@ this is a reply."
(defun gnus-inews-do-gcc (&optional gcc)
(save-excursion
(save-restriction
- (nnheader-narrow-to-headers)
+ (message-narrow-to-headers)
(let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
(cur (current-buffer))
groups group method)
@@ -803,10 +796,14 @@ this is a reply."
;; If the group doesn't exist, we assume
;; it's an archive group...
gnus-message-archive-method)
+ ;; Use the method.
+ ((gnus-info-method (gnus-get-info group))
+ (gnus-info-method (gnus-get-info group)))
+ ;; Find the method.
(t (gnus-group-method group)))))
+ (gnus-check-server method)
(unless (gnus-request-group group t method)
(gnus-request-create-group group method))
- (gnus-check-server method)
(save-excursion
(nnheader-set-temp-buffer " *acc*")
(insert-buffer-substring cur)
View
165 lisp/gnus-picon.el
@@ -120,7 +120,7 @@ Some people may want to add \"unknown\" to this list."
(if (annotationp listitem)
(delete-annotation listitem))
(setq plist (cdr plist))))
-)
+ )
(defun gnus-picons-remove-all ()
"Removes all picons from the Gnus display(s)."
@@ -133,7 +133,7 @@ Some people may want to add \"unknown\" to this list."
gnus-x-face-annotations nil)
(if (bufferp gnus-picons-buffer)
(kill-buffer gnus-picons-buffer))
-)
+ )
(defun gnus-get-buffer-name (variable)
"Returns the buffer name associated with the contents of a variable."
@@ -160,13 +160,13 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
(interactive)
;; convert the x-face header to a .xbm file
(let ((process-connection-type nil)
- (process nil))
+ (process nil))
(process-kill-without-query
(setq process (start-process
- "gnus-x-face" nil "sh" "-c" gnus-picons-convert-x-face)))
+ "gnus-x-face" nil "sh" "-c" gnus-picons-convert-x-face)))
(process-send-region "gnus-x-face" beg end)
(process-send-eof "gnus-x-face")
- ;; wait for it.
+ ;; wait for it.
(while (not (equal (process-status process) 'exit))
(sleep-for .1)))
;; display it
@@ -177,40 +177,41 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
(beginning-of-buffer)
(let ((iconpoint (point)))
(if (not (looking-at "^$"))
- (if buffer-read-only
- (progn
- (toggle-read-only)
- (open-line 1)
- (toggle-read-only)
- )
- (open-line 1)))
+ (if buffer-read-only
+ (progn
+ (toggle-read-only)
+ (open-line 1)
+ (toggle-read-only)
+ )
+ (open-line 1)))
(end-of-line)
;; append the annotation to gnus-article-annotations for deletion.
(setq gnus-x-face-annotations
- (append
- (gnus-picons-try-to-find-face
- gnus-picons-x-face-file-name iconpoint)
- gnus-x-face-annotations)))
+ (append
+ (gnus-picons-try-to-find-face
+ gnus-picons-x-face-file-name iconpoint)
+ gnus-x-face-annotations)))
;; delete the tmp file
(delete-file gnus-picons-x-face-file-name)))
(defun gnus-article-display-picons ()
-"Display faces for an author and his/her domain in gnus-picons-display-where."
+ "Display faces for an author and his/her domain in gnus-picons-display-where."
(interactive)
(if (and (featurep 'xpm)
- (or (not (fboundp 'device-type)) (equal (device-type) 'x)))
+ (or (not (fboundp 'device-type)) (equal (device-type) 'x))
+ (mail-fetch-field "from"))
(save-excursion
(let* ((iconpoint (point)) (from (mail-fetch-field "from"))
- (username
- (progn
- (string-match "\\([-_a-zA-Z0-9]+\\)@" from)
- (match-string 1 from)))
- (hostpath
- (concat (gnus-picons-reverse-domain-path
- (replace-in-string
- (replace-in-string from ".*@\\([_a-zA-Z0-9-.]+\\).*"
- "\\1")
- "\\." "/")) "/")))
+ (username
+ (progn
+ (string-match "\\([-_a-zA-Z0-9]+\\)@" from)
+ (match-string 1 from)))
+ (hostpath
+ (concat (gnus-picons-reverse-domain-path
+ (replace-in-string
+ (replace-in-string from ".*@\\([_a-zA-Z0-9-.]+\\).*"
+ "\\1")
+ "\\." "/")) "/")))
(switch-to-buffer (gnus-get-buffer-name gnus-picons-display-where))
(gnus-add-current-to-buffer-list)
(beginning-of-buffer)
@@ -228,30 +229,30 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
(gnus-picons-remove gnus-article-annotations)
(setq gnus-article-annotations 'nil)
(if (equal username from)
- (setq username (progn
- (string-match "<\\([_a-zA-Z0-9-.]+\\)>" from)
- (match-string 1 from))))
+ (setq username (progn
+ (string-match "<\\([_a-zA-Z0-9-.]+\\)>" from)
+ (match-string 1 from))))
(mapcar '(lambda (pathpart)
(setq gnus-article-annotations
(append
- (gnus-picons-insert-face-if-exists
- (concat
- (file-name-as-directory
- gnus-picons-database) pathpart)
- (concat hostpath username)
- iconpoint)
- gnus-article-annotations)))
+ (gnus-picons-insert-face-if-exists
+ (concat
+ (file-name-as-directory
+ gnus-picons-database) pathpart)
+ (concat hostpath username)
+ iconpoint)
+ gnus-article-annotations)))
gnus-picons-user-directories)
(mapcar '(lambda (pathpart)
(setq gnus-article-annotations
(append
- (gnus-picons-insert-face-if-exists
- (concat (file-name-as-directory
- gnus-picons-database) pathpart)
- (concat hostpath "unknown")
- iconpoint)
- gnus-article-annotations)))
- gnus-picons-domain-directories)
+ (gnus-picons-insert-face-if-exists
+ (concat (file-name-as-directory
+ gnus-picons-database) pathpart)
+ (concat hostpath "unknown")
+ iconpoint)
+ gnus-article-annotations)))
+ gnus-picons-domain-directories)
(add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)
))))
@@ -261,32 +262,32 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
(if (and (featurep 'xpm)
(or (not (fboundp 'device-type)) (equal (device-type) 'x)))
(save-excursion
- (let
- ((iconpoint (point)))
- (switch-to-buffer (gnus-get-buffer-name gnus-picons-display-where))
- (gnus-add-current-to-buffer-list)
- (beginning-of-buffer)
- (cond
- ((listp gnus-group-annotations)
- (mapcar 'delete-annotation gnus-group-annotations)
- (setq gnus-group-annotations nil))
- ((annotationp gnus-group-annotations)
- (delete-annotation gnus-group-annotations)
- (setq gnus-group-annotations nil))
- )
- (setq iconpoint (point))
- (if (not (looking-at "^$"))
- (open-line 1))
- (gnus-picons-remove gnus-group-annotations)
- (setq gnus-group-annotations nil)
- (setq gnus-group-annotations
- (gnus-picons-insert-face-if-exists
- (concat (file-name-as-directory gnus-picons-database)
- gnus-picons-news-directory)
- (concat (replace-in-string gnus-newsgroup-name "\\." "/")
- "/unknown")
- iconpoint t))
- (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))))
+ (let
+ ((iconpoint (point)))
+ (switch-to-buffer (gnus-get-buffer-name gnus-picons-display-where))
+ (gnus-add-current-to-buffer-list)
+ (beginning-of-buffer)
+ (cond
+ ((listp gnus-group-annotations)
+ (mapcar 'delete-annotation gnus-group-annotations)
+ (setq gnus-group-annotations nil))
+ ((annotationp gnus-group-annotations)
+ (delete-annotation gnus-group-annotations)
+ (setq gnus-group-annotations nil))
+ )
+ (setq iconpoint (point))
+ (if (not (looking-at "^$"))
+ (open-line 1))
+ (gnus-picons-remove gnus-group-annotations)
+ (setq gnus-group-annotations nil)
+ (setq gnus-group-annotations
+ (gnus-picons-insert-face-if-exists
+ (concat (file-name-as-directory gnus-picons-database)
+ gnus-picons-news-directory)
+ (concat (replace-in-string gnus-newsgroup-name "\\." "/")
+ "/unknown")
+ iconpoint t))
+ (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))))
(defun gnus-picons-insert-face-if-exists (path filename ipoint &optional rev)
@@ -297,22 +298,22 @@ To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
"[_a-zA-Z0-9-]+/\\([_A-Za-z0-9-]+\\)$" "\\1"))
(annotations nil))
(if (and rev
- (not (equal filename newfilename)))
+ (not (equal filename newfilename)))
(setq annotations (append
- (gnus-picons-insert-face-if-exists path newfilename ipoint rev)
- annotations)))
+ (gnus-picons-insert-face-if-exists path newfilename ipoint rev)
+ annotations)))
(if (eq (length annotations) (length (setq annotations (append
- (gnus-picons-try-to-find-face (concat pathfile ".xpm") ipoint)
- annotations))))
+ (gnus-picons-try-to-find-face (concat pathfile ".xpm") ipoint)
+ annotations))))
(setq annotations (append
- (gnus-picons-try-to-find-face
- (concat pathfile ".xbm") ipoint)
- annotations)))
+ (gnus-picons-try-to-find-face
+ (concat pathfile ".xbm") ipoint)
+ annotations)))
(if (and (not rev)
- (not (equal filename newfilename)))
+ (not (equal filename newfilename)))
(setq annotations (append
- (gnus-picons-insert-face-if-exists path newfilename ipoint rev)
- annotations)))
+ (gnus-picons-insert-face-if-exists path newfilename ipoint rev)
+ annotations)))
annotations
)
)
View
7 lisp/gnus-salt.el
@@ -84,7 +84,9 @@
["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
(defun gnus-pick-mode (&optional arg)
- "Minor mode for providing a pick-and-read interface in Gnus summary buffers."
+ "Minor mode for providing a pick-and-read interface in Gnus summary buffers.
+
+\\{gnus-pick-mode-map}"
(interactive "P")
(when (eq major-mode 'gnus-summary-mode)
(make-local-variable 'gnus-pick-mode)
@@ -115,7 +117,8 @@ If given a prefix, mark all unpicked articles as read."
(gnus-summary-limit-to-articles nil)
(when catch-up
(gnus-summary-limit-mark-excluded-as-read))
- (gnus-configure-windows (if gnus-pick-display-summary 'summary 'pick) t))
+ (gnus-summary-first-unread-article)
+ (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t))
;;;
View
54 lisp/gnus-score.el
@@ -529,7 +529,8 @@ If optional argument `SILENT' is nil, show effect of score entry."
((eq type 'f)
(setq match (gnus-simplify-subject-fuzzy match))))
(let ((score (gnus-score-default score))
- (header (downcase header)))
+ (header (downcase header))
+ new)
(and prompt (setq match (read-string
(format "Match %s on %s, %s: "
(cond ((eq date 'now)
@@ -543,12 +544,6 @@ If optional argument `SILENT' is nil, show effect of score entry."
(int-to-string match)
match))))
- ;; Score the current buffer.
- (and (>= (nth 1 (assoc header gnus-header-index)) 0)
- (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-string)
- (not silent)
- (gnus-summary-score-effect header match type score))
-
;; If this is an integer comparison, we transform from string to int.
(and (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
(setq match (string-to-int match)))
@@ -557,17 +552,14 @@ If optional argument `SILENT' is nil, show effect of score entry."
;; Add the score entry to the score file.
(when (= score gnus-score-interactive-default-score)
(setq score nil))
- (let ((new (cond
- (type
- (list match score (and date (gnus-day-number date)) type))
- (date
- (list match score (gnus-day-number date)))
- (score
- (list match score))
- (t
- (list match))))
- (old (gnus-score-get header))
+ (let ((old (gnus-score-get header))
elem)
+ (setq new
+ (cond
+ (type (list match score (and date (gnus-day-number date)) type))
+ (date (list match score (gnus-day-number date)))
+ (score (list match score))
+ (t (list match))))
;; We see whether we can collapse some score entries.
;; This isn't quite correct, because there may be more elements
;; later on with the same key that have matching elems... Hm.
@@ -583,8 +575,18 @@ If optional argument `SILENT' is nil, show effect of score entry."
gnus-score-interactive-default-score)))
;; Nope, we have to add a new elem.
(gnus-score-set header (if old (cons new old) (list new))))
- (gnus-score-set 'touched '(t))
- new))))
+ (gnus-score-set 'touched '(t))))
+
+ ;; Score the current buffer.
+ (unless silent
+ (if (and (>= (nth 1 (assoc header gnus-header-index)) 0)
+ (eq (nth 2 (assoc header gnus-header-index))
+ 'gnus-score-string))
+ (gnus-summary-score-effect header match type score)
+ (gnus-summary-rescore)))
+
+ ;; Return the new scoring rule.
+ new))
(defun gnus-summary-score-effect (header match type score)
"Simulate the effect of a score file entry.
@@ -783,7 +785,6 @@ SCORE is the score to add."
(defun gnus-score-load-file (file)
;; Load score file FILE. Returns a list a retrieved score-alists.
- (setq gnus-kill-files-directory (or gnus-kill-files-directory "~/News/"))
(let* ((file (expand-file-name
(or (and (string-match
(concat "^" (expand-file-name
@@ -1027,7 +1028,7 @@ SCORE is the score to add."
;; This is an adaptive score file, so we do not run
;; it through `pp'. These files can get huge, and
;; are not meant to be edited by human hands.
- (insert (format "%S" score))
+ (prin1 score (current-buffer))
;; This is a normal score file, so we print it very
;; prettily.
(pp score (current-buffer))))
@@ -1837,7 +1838,7 @@ SCORE is the score to add."
(defun gnus-summary-rescore ()
"Redo the entire scoring process in the current summary."
(interactive)
- (setq gnus-newsgroup-scored nil)
+ (gnus-score-save)
(setq gnus-score-cache nil)
(setq gnus-newsgroup-scored nil)
(gnus-possibly-score-headers)
@@ -1929,8 +1930,7 @@ SCORE is the score to add."
(gnus-score-search-global-directories gnus-global-score-files)))
;; Fix the kill-file dir variable.
(setq gnus-kill-files-directory
- (file-name-as-directory
- (or gnus-kill-files-directory "~/News/")))
+ (file-name-as-directory gnus-kill-files-directory))
;; If we can't read it, there are no score files.
(if (not (file-exists-p (expand-file-name gnus-kill-files-directory)))
(setq gnus-score-file-list nil)
@@ -2146,17 +2146,17 @@ The list is determined from the variable gnus-score-file-alist."
(string-equal newsgroup ""))
;; The global score file is placed at top of the directory.
(expand-file-name
- suffix (or gnus-kill-files-directory "~/News")))
+ suffix gnus-kill-files-directory))
((gnus-use-long-file-name 'not-score)
;; Append ".SCORE" to newsgroup name.
(expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
"." suffix)
- (or gnus-kill-files-directory "~/News")))
+ gnus-kill-files-directory))
(t
;; Place "SCORE" under the hierarchical directory.
(expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
"/" suffix)
- (or gnus-kill-files-directory "~/News")))))))
+ gnus-kill-files-directory))))))
(defun gnus-score-search-global-directories (files)
"Scan all global score directories for score files."
View
6 lisp/gnus-setup.el
@@ -1,10 +1,10 @@
;;; gnus-setup.el --- Initialization & Setup for Gnus 5
-;; Copyright (C) 1995 Miranova Systems, Inc.
+;; Copyright (C) 1995, 96 Free Software Foundation, Inc.
;; Author: Steven L. Baur <steve@miranova.com>
;; Keywords: news
-;; This file is not yet a part of GNU Emacs.
+;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -39,7 +39,7 @@
"Directory where Emacs site lisp is located.")
(defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory
- "gnus-5.0.12/lisp/")
+ "gnus-5.0.15/lisp/")
"Directory where Gnus Emacs lisp is found.")
(defvar gnus-sgnus-lisp-directory (concat gnus-emacs-lisp-directory
View
2  lisp/gnus-soup.el
@@ -545,7 +545,7 @@ Return whether the unpacking was successful."
(gnus-message 5 "Sending mail to %s..."
(mail-fetch-field "to"))
(sit-for 1)
- (funcall message-send-mail-function))
+ (message-send-mail))
(t
(error "Unknown reply kind")))
(set-buffer msg-buf)
View
63 lisp/gnus-topic.el
@@ -48,9 +48,6 @@ with some simple extensions.
%A Number of unread articles in the groups in the topic and its subtopics.
")
-(defvar gnus-topic-unique t
- "*If non-nil, each group will only belong to one topic.")
-
(defvar gnus-topic-indent-level 2
"*How much each subtopic should be indented.")
@@ -59,6 +56,9 @@ with some simple extensions.
(defvar gnus-topic-active-topology nil)
(defvar gnus-topic-active-alist nil)
+(defvar gnus-topology-checked-p nil
+ "Whether the topology has been checked in this session.")
+
(defvar gnus-topic-killed-topics nil)
(defvar gnus-topic-inhibit-change-level nil)
(defvar gnus-topic-tallied-groups nil)
@@ -89,6 +89,13 @@ with some simple extensions.
"The number of unread articles in topic on the current line."
(get-text-property (gnus-point-at-bol) 'gnus-topic-unread))
+(defun gnus-topic-unread (topic)
+ "Return the number of unread articles in TOPIC."
+ (or (save-excursion
+ (and (gnus-topic-goto-topic topic)
+ (gnus-group-topic-unread)))
+ 0))
+
(defun gnus-topic-init-alist ()
"Initialize the topic structures."
(setq gnus-topic-topology
@@ -114,7 +121,8 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
(setq gnus-topic-tallied-groups nil)
- (unless gnus-topic-alist
+ (when (or (not gnus-topic-alist)
+ (not gnus-topology-checked-p))
(gnus-topic-check-topology))
(unless list-topic
@@ -367,7 +375,8 @@ articles in the topic and its subtopics."
(setq gnus-topic-active-topology nil
gnus-topic-active-alist nil
gnus-topic-killed-topics nil
- gnus-topic-tallied-groups nil))
+ gnus-topic-tallied-groups nil
+ gnus-topology-checked-p nil))
(defun gnus-topic-check-topology ()
;; The first time we set the topology to whatever we have
@@ -375,6 +384,7 @@ articles in the topic and its subtopics."
(unless gnus-topic-alist
(gnus-topic-init-alist))
+ (setq gnus-topology-checked-p t)
(let ((topics (gnus-topic-list))
(alist gnus-topic-alist)
changed)
@@ -416,13 +426,6 @@ articles in the topic and its subtopics."
(incf total number)))
total))
-(defun gnus-group-parent-topic ()
- "Return the topic the current group belongs in."
- (let ((group (gnus-group-group-name)))
- (if group
- (gnus-group-topic group)
- (gnus-group-topic-name))))
-
(defun gnus-group-topic (group)
"Return the topic GROUP is a member of."
(let ((alist gnus-topic-alist)
@@ -435,9 +438,22 @@ articles in the topic and its subtopics."
out))
(defun gnus-topic-goto-topic (topic)
+ "Go to TOPIC."
(when topic
(gnus-goto-char (text-property-any (point-min) (point-max)
'gnus-topic (intern topic)))))
+
+(defun gnus-group-parent-topic ()
+ "Return the name of the current topic."
+ (let ((result
+ (or (get-text-property (point) 'gnus-topic)
+ (save-excursion
+ (and (gnus-goto-char (previous-single-property-change
+ (point) 'gnus-topic))
+ (get-text-property (max (1- (point)) (point-min))
+ 'gnus-topic))))))
+ (when result
+ (symbol-name result))))
(defun gnus-topic-update-topic ()
"Update all parent topics to the current group."
@@ -472,7 +488,9 @@ articles in the topic and its subtopics."
(forward-line 1)))))
(defun gnus-topic-update-topic-line (topic-name &optional reads)
- (let* ((type (cadr (gnus-topic-find-topology topic-name)))
+ (let* ((top (gnus-topic-find-topology topic-name))
+ (type (cadr top))
+ (children (cddr top))
(entries (gnus-topic-find-groups
(car type) (car gnus-group-list-mode)
(cdr gnus-group-list-mode)))
@@ -484,6 +502,8 @@ articles in the topic and its subtopics."
;; Tally all the groups that belong in this topic.
(if reads
(setq unread (- (gnus-group-topic-unread) reads))
+ (while children
+ (incf unread (gnus-topic-unread (caar (pop children)))))
(while (setq entry (pop entries))
(when (numberp (car entry))
(incf unread (car entry)))))
@@ -649,8 +669,10 @@ articles in the topic and its subtopics."
(make-local-variable 'gnus-group-indentation-function)
(setq gnus-group-indentation-function
'gnus-topic-group-indentation)
+ (setq gnus-topology-checked-p nil)
;; We check the topology.
- (gnus-topic-check-topology)
+ (when gnus-newsrc-alist
+ (gnus-topic-check-topology))
(run-hooks 'gnus-topic-mode-hook))
;; Remove topic infestation.
(unless gnus-topic-mode
@@ -721,7 +743,8 @@ group."
(gnus-topic-goto-topic topic))
(defun gnus-topic-move-group (n topic &optional copyp)
- "Move the current group to a topic."
+ "Move the next N groups to TOPIC.
+If COPYP, copy the groups instead."
(interactive
(list current-prefix-arg
(completing-read "Move to topic: " gnus-topic-alist nil t)))
@@ -731,11 +754,11 @@ group."
(mapcar (lambda (g)
(gnus-group-remove-mark g)
(when (and
- (setq entry (assoc (gnus-group-topic g) gnus-topic-alist))
+ (setq entry (assoc (gnus-group-parent-topic)
+ gnus-topic-alist))
(not copyp))
(setcdr entry (delete g (cdr entry))))
- (when topicl
- (nconc topicl (list g))))
+ (nconc topicl (list g)))
groups)
(gnus-group-position-point))
(gnus-topic-enter-dribble)
@@ -775,7 +798,7 @@ group."
(when (and (< oldlevel gnus-level-zombie)
(>= level gnus-level-zombie))
(let (alist)
- (when (setq alist (assoc (gnus-group-topic group) gnus-topic-alist))
+ (when (setq alist (assoc (gnus-group-parent-topic) gnus-topic-alist))
(setcdr alist (delete group (cdr alist))))))
;; If the group is subscribed. then we enter it into the topics.
(when (and (< level gnus-level-zombie)
@@ -821,7 +844,7 @@ group."
(if (gnus-group-goto-group group)
t
;; The group is no longer visible.
- (let* ((list (assoc (gnus-group-topic group) gnus-topic-alist))
+ (let* ((list (assoc (gnus-group-parent-topic) gnus-topic-alist))
(after (cdr (member group (cdr list)))))
;; First try to put point on a group after the current one.
(while (and after
View
1  lisp/gnus-uu.el
@@ -1129,6 +1129,7 @@ The headers will be included in the sequence they are matched.")
(let ((state 'first)
has-been-begin article result-file result-files process-state
gnus-summary-display-article-function
+ gnus-article-display-hook gnus-article-prepare-hook
article-series files)
(while (and articles
View
24 lisp/gnus-vis.el
@@ -1546,8 +1546,8 @@ specified by `gnus-button-alist'."
(defvar gnus-prev-page-map nil)
(unless gnus-prev-page-map
(setq gnus-prev-page-map (make-sparse-keymap))
- (define-key gnus-prev-page-map gnus-mouse-2 'gnus-article-prev-page)
- (define-key gnus-prev-page-map "\r" 'gnus-article-prev-page))
+ (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page)
+ (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page))
(defun gnus-insert-prev-page-button ()
(let ((buffer-read-only nil))
@@ -1560,8 +1560,24 @@ specified by `gnus-button-alist'."
(unless gnus-next-page-map
(setq gnus-next-page-map (make-keymap))
(suppress-keymap gnus-prev-page-map)
- (define-key gnus-next-page-map gnus-mouse-2 'gnus-article-next-page)
- (define-key gnus-next-page-map "\r" 'gnus-article-next-page))
+ (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page)
+ (define-key gnus-next-page-map "\r" 'gnus-button-next-page))
+
+(defun gnus-button-next-page ()
+ "Go to the next page."
+ (interactive)
+ (let ((win (selected-window)))
+ (select-window (get-buffer-window gnus-article-buffer t))
+ (gnus-article-next-page)
+ (select-window win)))
+
+(defun gnus-button-prev-page ()
+ "Go to the prev page."
+ (interactive)
+ (let ((win (selected-window)))
+ (select-window (get-buffer-window gnus-article-buffer t))
+ (gnus-article-prev-page)
+ (select-window win)))
(defun gnus-insert-next-page-button ()
(let ((buffer-read-only nil))
View
150 lisp/gnus-vm.el
@@ -106,156 +106,6 @@ save those articles instead."
;; Remember the directory name to save articles.
(setq gnus-newsgroup-last-mail folder)))
-(defun gnus-vm-mail-setup (to subject in-reply-to cc replybuffer actions)
- ;;
- )
-
-(defun gnus-mail-forward-using-vm (&optional buffer)
- "Forward the current message to another user using vm."
- (let* ((gnus-buffer (or buffer (current-buffer)))
- (subject (message-make-forward-subject)))
- (or (featurep 'win-vm)
- (if gnus-use-full-window
- (pop-to-buffer gnus-article-buffer)
- (switch-to-buffer gnus-article-buffer)))
- (gnus-copy-article-buffer)
- (set-buffer gnus-article-copy)
- (save-excursion
- (save-restriction
- (widen)
- (let ((vm-folder (gnus-vm-make-folder))
- (vm-forward-message-hook
- (append (symbol-value 'vm-forward-message-hook)
- '((lambda ()
- (save-excursion
- (mail-position-on-field "Subject")
- (beginning-of-line)
- (looking-at "^\\(Subject: \\).*$")
- (replace-match (concat "\\1" subject))))))))
- (vm-forward-message)
- (gnus-vm-init-reply-buffer gnus-buffer)
- (run-hooks 'gnus-mail-hook)
- (kill-buffer vm-folder))))))
-
-(defun gnus-vm-init-reply-buffer (buffer)
- (make-local-variable 'gnus-summary-buffer)
- (setq gnus-summary-buffer buffer)
- (set 'vm-mail-buffer nil)
- (use-local-map (copy-keymap (current-local-map)))
- (local-set-key "\C-c\C-y" 'gnus-yank-article))
-
-(defun gnus-mail-reply-using-vm (&optional yank)
- "Compose reply mail using vm.
-Optional argument YANK means yank original article.
-The command \\[vm-yank-message] yank the original message into current buffer."
- (let ((gnus-buffer (current-buffer)))
- (gnus-copy-article-buffer)
- (set-buffer gnus-article-copy)
- (save-excursion
- (save-restriction
- (widen)
- (let ((vm-folder (gnus-vm-make-folder gnus-article-copy)))
- (vm-reply 1)
- (gnus-vm-init-reply-buffer gnus-buffer)
- (setq gnus-buffer (current-buffer))
- (and yank
- ;; nil will (magically :-)) yank the current article
- (gnus-yank-article nil))
- (kill-buffer vm-folder))))
- (if (featurep 'win-vm) nil
- (pop-to-buffer gnus-buffer))
- (run-hooks 'gnus-mail-hook)))
-
-(defun gnus-mail-other-window-using-vm ()
- "Compose mail in the other window using VM."
- (interactive)
- (let ((gnus-buffer (current-buffer)))
- (vm-mail)
- (gnus-vm-init-reply-buffer gnus-buffer))
- (run-hooks 'gnus-mail-hook))
-
-(defun gnus-yank-article (article &optional prefix)
- ;; Based on vm-yank-message by Kyle Jones.
- "Yank article number N into the current buffer at point.
-When called interactively N is read from the minibuffer.
-
-This command is meant to be used in GNUS created Mail mode buffers;
-the yanked article comes from the newsgroup containing the article
-you are replying to or forwarding.
-
-All article headers are yanked along with the text. Point is left
-before the inserted text, the mark after. Any hook functions bound to
-`mail-citation-hook' are run, after inserting the text and setting
-point and mark.
-
-Prefix arg means to ignore `mail-citation-hook', don't set the mark,
-prepend the value of `vm-included-text-prefix' to every yanked line.
-For backwards compatibility, if `mail-citation-hook' is set to nil,
-`mail-yank-hooks' is run instead. If that is also nil, a default
-action is taken."
- (interactive
- (list
- (let ((result 0)
- default prompt)
- (setq default (and gnus-summary-buffer
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (and gnus-current-article
- (int-to-string gnus-current-article))))
- prompt (if default
- (format "Yank article number: (default %s) " default)
- "Yank article number: "))
- (while (and (not (stringp result)) (zerop result))
- (setq result (read-string prompt))
- (and (string= result "") default (setq result default))
- (or (string-match "^<.*>$" result)
- (setq result (string-to-int result))))
- result)
- current-prefix-arg))
- (if gnus-summary-buffer
- (save-excursion
- (let ((message (current-buffer))
- (start (point)) end
- (tmp (generate-new-buffer " *tmp-yank*")))
- (set-buffer gnus-summary-buffer)
- ;; Make sure the connection to the server is alive.
- (or (gnus-server-opened (gnus-find-method-for-group
- gnus-newsgroup-name))
- (progn
- (gnus-check-server
- (gnus-find-method-for-group gnus-newsgroup-name))
- (gnus-request-group gnus-newsgroup-name t)))
- (and (stringp article)
- (let ((gnus-override-method gnus-refer-article-method))
- (gnus-read-header article)))
- (gnus-request-article (or article
- gnus-current-article)
- gnus-newsgroup-name tmp)
- (set-buffer tmp)
- (run-hooks 'gnus-article-prepare-hook)
- ;; Decode MIME message.
- (if (and gnus-show-mime
- (gnus-fetch-field "Mime-Version"))
- (funcall gnus-show-mime-method))
- ;; Perform the article display hooks.
- (let ((buffer-read-only nil))
- (run-hooks 'gnus-article-display-hook))
- (append-to-buffer message (point-min) (point-max))
- (kill-buffer tmp)
- (set-buffer message)
- (setq end (point))
- (goto-char start)
- (if (or prefix
- (not (or mail-citation-hook mail-yank-hooks)))
- (save-excursion
- (while (< (point) end)
- (insert (symbol-value 'vm-included-text-prefix))
- (forward-line 1)))
- (push-mark end)
- (cond
- (mail-citation-hook (run-hooks 'mail-citation-hook))
- (mail-yank-hooks (run-hooks 'mail-yank-hooks))))))))
-
(provide 'gnus-vm)
;;; gnus-vm.el ends here.
View
262 lisp/gnus.el
@@ -35,6 +35,9 @@
(eval-when-compile (require 'cl))
+(defvar gnus-directory (or (getenv "SAVEDIR") "~/News/")
+ "*Directory variable from which all other Gnus file variables are derived.")
+
;; Site dependent variables. These variables should be defined in
;; paths.el.
@@ -130,10 +133,12 @@ There is a lot more to know about select methods and virtual servers -
see the manual for details.")
(defvar gnus-message-archive-method
- '(nnfolder "archive" (nnfolder-directory "~/Mail/archive/")
- (nnfolder-active-file "~/Mail/archive/active")
- (nnfolder-get-new-mail nil)
- (nnfolder-inhibit-expiry t))
+ '(nnfolder
+ "archive"
+ (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.
This should be a mail method.")
@@ -272,13 +277,11 @@ contains the element `not-save', long file names will not be used for
saving; and if it contains the element `not-kill', long file names
will not be used for kill files.")
-(defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
- "*Name of the directory articles will be saved in (default \"~/News\").
-Initialized from the SAVEDIR environment variable.")
+(defvar gnus-article-save-directory gnus-directory
+ "*Name of the directory articles will be saved in (default \"~/News\").")
-(defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
- "*Name of the directory where kill files will be stored (default \"~/News\").
-Initialized from the SAVEDIR environment variable.")
+(defvar gnus-kill-files-directory gnus-directory
+ "*Name of the directory where kill files will be stored (default \"~/News\").")
(defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
"*A function to save articles in your favorite format.
@@ -600,9 +603,6 @@ nil if you set this variable to nil.")
(defvar gnus-interactive-catchup t
"*If non-nil, require your confirmation when catching up a group.")
-(defvar gnus-interactive-post t
- "*If non-nil, group name will be asked for when posting.")
-
(defvar gnus-interactive-exit t
"*If non-nil, require your confirmation when exiting Gnus.")
@@ -1208,13 +1208,14 @@ with some simple extensions:
"*The format specification for the article mode line.
See `gnus-summary-mode-line-format' for a closer description.")
-(defvar gnus-group-mode-line-format "Gnus: %%b {%M:%S}"
+(defvar gnus-group-mode-line-format "Gnus: %%b {%M%:%S}"
"*The format specification for the group mode line.
It works along the same lines as a normal formatting string,
with some simple extensions:
%S The native news server.
-%M The native select method.")
+%M The native select method.
+%: \":\" if %S isn't \"\".")
(defvar gnus-valid-select-methods
'(("nntp" post address prompt-address)
@@ -1711,7 +1712,8 @@ variable (string, integer, character, etc).")
(defvar gnus-group-mode-line-format-alist
`((?S gnus-tmp-news-server ?s)
(?M gnus-tmp-news-method ?s)
- (?u gnus-tmp-user-defined ?s)))
+ (?u gnus-tmp-user-defined ?s)
+ (?: gnus-tmp-colon ?s)))
(defvar gnus-have-read-active-file nil)
@@ -1719,7 +1721,7 @@ variable (string, integer, character, etc).")
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.89"
+(defconst gnus-version "September Gnus v0.90"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
@@ -2455,7 +2457,7 @@ Thank you for your help in stamping out bugs.
(let ((case-fold-search t)
(inhibit-point-motion-hooks t))
(nnheader-narrow-to-headers)
- (mail-fetch-field field)))))
+ (message-fetch-field field)))))
(defun gnus-goto-colon ()
(beginning-of-line)
@@ -2823,7 +2825,7 @@ Otherwise, it is like ~/News/news/group/num."
(gnus-capitalize-newsgroup newsgroup)
(gnus-newsgroup-directory-form newsgroup))
"/" (int-to-string (mail-header-number headers)))
- (or gnus-article-save-directory "~/News"))))
+ gnus-article-save-directory)))
(if (and last-file
(string-equal (file-name-directory default)
(file-name-directory last-file))
@@ -2841,7 +2843,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
newsgroup
(gnus-newsgroup-directory-form newsgroup))
"/" (int-to-string (mail-header-number headers)))
- (or gnus-article-save-directory "~/News"))))
+ gnus-article-save-directory)))
(if (and last-file
(string-equal (file-name-directory default)
(file-name-directory last-file))
@@ -2858,7 +2860,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(if (gnus-use-long-file-name 'not-save)
(gnus-capitalize-newsgroup newsgroup)
(concat (gnus-newsgroup-directory-form newsgroup) "/news"))
- (or gnus-article-save-directory "~/News"))))
+ gnus-article-save-directory)))
(defun gnus-plain-save-name (newsgroup headers &optional last-file)
"Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
@@ -2869,7 +2871,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(if (gnus-use-long-file-name 'not-save)
newsgroup
(concat (gnus-newsgroup-directory-form newsgroup) "/news"))
- (or gnus-article-save-directory "~/News"))))
+ gnus-article-save-directory)))
;; For subscribing new newsgroup
@@ -3693,17 +3695,30 @@ simple-first is t, first argument is already simplified."
;; it yet. -erik selberg@cs.washington.edu
(defun gnus-dd-mmm (messy-date)
"Return a string like DD-MMM from a big messy string"
- (let ((datevec (timezone-parse-date messy-date)))
- (format "%2s-%s"
- (condition-case ()
- ;; Make sure leading zeroes are stripped.
- (number-to-string (string-to-number (aref datevec 2)))
- (error "??"))
- (capitalize
- (or (car
- (nth (1- (string-to-number (aref datevec 1)))
- timezone-months-assoc))
- "???")))))
+ (let ((datevec (condition-case () (timezone-parse-date messy-date)
+ (error nil))))
+ (if (not datevec)
+ "??-???"
+ (format "%2s-%s"
+ (condition-case ()
+ ;; Make sure leading zeroes are stripped.
+ (number-to-string (string-to-number (aref datevec 2)))
+ (error "??"))
+ (capitalize
+ (or (car
+ (nth (1- (string-to-number (aref datevec 1)))
+ timezone-months-assoc))
+ "???"))))))
+
+(defun gnus-mode-string-quote (string)
+ "Quote all \"%\" in STRING."
+ (save-excursion
+ (gnus-set-work-buffer)
+ (insert string)
+ (goto-char (point-min))
+ (while (search-forward "%" nil t)
+ (insert "%"))
+ (buffer-string)))
;; Make a hash table (default and minimum size is 255).
;; Optional argument HASHSIZE specifies the table size.
@@ -3778,6 +3793,19 @@ simple-first is t, first argument is already simplified."
(memq class gnus-visual))
t))))
+(defun gnus-parent-headers (headers &optional generation)
+ "Return the headers of the GENERATIONeth parent of HEADERS."
+ (unless generation
+ (setq generation 1))
+ (let (references parent)
+ (while (and headers (not (zerop generation)))
+ (setq references (mail-header-references headers))
+ (when (and references
+ (setq parent (gnus-parent-id references))
+ (setq headers (car (gnus-id-to-thread parent))))
+ (decf generation)))
+ headers))
+
(defun gnus-parent-id (references)
"Return the last Message-ID in REFERENCES."
(when (and references
@@ -4273,10 +4301,10 @@ If ARG is non-nil and not a positive number, Gnus will
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")
- (make-local-variable 'gnus-group-use-permanent-levels)
- (setq gnus-group-use-permanent-levels
- (or arg (1- gnus-level-default-subscribed)))
- (gnus gnus-group-use-permanent-levels t slave))
+ (let ((val (or arg (1- gnus-level-default-subscribed))))
+ (gnus val t slave)
+ (make-local-variable 'gnus-group-use-permanent-levels)
+ (setq gnus-group-use-permanent-levels val)))
;;;###autoload
(defun gnus-slave (&optional arg)
@@ -4627,6 +4655,8 @@ If REGEXP, only list groups matching REGEXP."
(defun gnus-server-to-method (server)
"Map virtual server names to select methods."
(or
+ ;; Is this a method, perhaps?
+ (and server (listp server) server)
;; Perhaps this is the native server?
(and (equal server "native") gnus-select-method)
;; It should be in the server alist.
@@ -4851,12 +4881,14 @@ increase the score of each group you read."
"Update the current line in the group buffer."
(let* ((buffer-read-only nil)
(group (gnus-group-group-name))
- (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
+ (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))
+ gnus-group-indentation)
(and entry
(not (gnus-ephemeral-group-p group))
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
(prin1-to-string (nth 2 entry)) ")")))
+ (setq gnus-group-indentation (gnus-group-group-indentation))
(gnus-delete-line)
(gnus-group-insert-group-line-info group)
(forward-line -1)
@@ -5003,7 +5035,9 @@ already."
(gnus-group-set-mode-line)))))
(defun gnus-group-set-mode-line ()
+ "Update the mode line in the group buffer."
(when (memq 'group gnus-updated-mode-lines)
+ ;; Yes, we want to keep this mode line updated.
(save-excursion
(set-buffer gnus-group-buffer)
(let* ((gformat (or gnus-group-mode-line-format-spec
@@ -5013,6 +5047,7 @@ already."
gnus-group-mode-line-format-alist))))
(gnus-tmp-news-server (cadr gnus-select-method))
(gnus-tmp-news-method (car gnus-select-method))
+ (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
(max-len 60)
gnus-tmp-header ;Dummy binding for user-defined formats
;; Get the resulting string.
@@ -5025,12 +5060,13 @@ already."
(save-excursion
(set-buffer gnus-dribble-buffer)
(not (zerop (buffer-size)))))
- "-* " "-- "))
+ "---*- " "----- "))
;; If the line is too long, we chop it off.
(when (> (length mode-string) max-len)
(setq mode-string (substring mode-string 0 (- max-len 4))))
(prog1
- (setq mode-line-buffer-identification (list mode-string))
+ (setq mode-line-buffer-identification
+ (list mode-string))
(set-buffer-modified-p t))))))
(defun gnus-group-group-name ()
@@ -5118,8 +5154,8 @@ If FIRST-TOO, the current line is also eligible as a target."
(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))))
+ (cons group (delete group gnus-group-marked)))))
+ (or no-advance (gnus-group-next-group 1))
(decf n))
(gnus-summary-position-point)
n))
@@ -6357,7 +6393,8 @@ entail asking the server for the groups."
(let (list)
(mapatoms
(lambda (sym)
- (and (symbol-value sym)
+ (and (boundp sym)
+ (symbol-value sym)
(setq list (cons (symbol-name sym) list))))
gnus-active-hashtb)
list)
@@ -8048,7 +8085,7 @@ If NO-DISPLAY, don't generate a summary buffer."
((null level) nil)
((zerop level) t)
((null refs) t)
- ((null(gnus-parent-id refs)) t)
+ ((null (gnus-parent-id refs)) t)
((and (= 1 level)
(null (setq particle (gnus-id-to-article
(gnus-parent-id refs))))
@@ -8568,13 +8605,19 @@ If READ-ALL is non-nil, all articles in the group are selected."
(error "Couldn't open server"))
(or (and entry (not (eq (car entry) t))) ; Either it's active...
- (gnus-activate-group group) ; Or we can activate it...
- (progn ; Or we bug out.
+ (gnus-activate-group group) ; Or we can activate it...
+ (progn ; Or we bug out.
(when (equal major-mode 'gnus-summary-mode)
(kill-buffer (current-buffer)))
(error "Couldn't request group %s: %s"
group (gnus-status-message group))))
+ (unless (gnus-request-group group t)
+ (when (equal major-mode 'gnus-summary-mode)
+ (kill-buffer (current-buffer)))
+ (error "Couldn't request group %s: %s"
+ group (gnus-status-message group)))
+
(setq gnus-newsgroup-name group)
(setq gnus-newsgroup-unselected nil)
(setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
@@ -8889,7 +8932,8 @@ If WHERE is `summary', the summary mode line format will be used."
(gnus-tmp-subject
(if (and gnus-current-headers
(vectorp gnus-current-headers))
- (mail-header-subject gnus-current-headers) ""))
+ (gnus-mode-string-quote
+ (mail-header-subject gnus-current-headers)) ""))
max-len
gnus-tmp-header);; passed as argument to any user-format-funcs
(setq mode-string (eval mformat))
@@ -10874,7 +10918,7 @@ The difference between N and the number of articles fetched is returned."
(set-buffer gnus-original-article-buffer)
(nnheader-narrow-to-headers)
(prog1
- (mail-fetch-field "references")
+ (message-fetch-field "references")
(widen)))
;; It's not the current article, so we take a bet on
;; the value we got from the server.
@@ -11020,47 +11064,45 @@ If BACKWARD, search backward instead."
(defun gnus-summary-search-article (regexp &optional backward)
"Search for an article containing REGEXP.
Optional argument BACKWARD means do search for backward.
-gnus-select-article-hook is not called during the search."
+`gnus-select-article-hook' is not called during the search."
(let ((gnus-select-article-hook nil) ;Disable hook.
(gnus-article-display-hook nil)
(gnus-mark-article-hook nil) ;Inhibit marking as read.
(re-search
(if backward
- (function re-search-backward) (function re-search-forward)))
- (found nil)
- (last nil))
- ;; Hidden thread subtrees must be searched for ,too.
+ 're-search-backward 're-search-forward))
+ (sum (current-buffer))
+ (found nil))
+ ;; Hidden thread subtrees must be searched, too.
(gnus-summary-show-all-threads)
- ;; First of all, search current article.
- ;; We don't want to read article again from NNTP server nor reset
- ;; current point.
(gnus-summary-select-article)
- (gnus-message 9 "Searching article: %d..." gnus-current-article)
- (setq last gnus-current-article)
- (gnus-eval-in-buffer-window
- gnus-article-buffer
- (save-restriction
- (widen)
- ;; Begin search from current point.
- (setq found (funcall re-search regexp nil t))))
- ;; Then search next articles.
- (while (and (not found)
- (gnus-summary-display-article
- (if backward (gnus-summary-find-prev)
- (gnus-summary-find-next))))
- (gnus-message 9 "Searching article: %d..." gnus-current-article)
- (gnus-eval-in-buffer-window
- gnus-article-buffer
- (save-restriction
- (widen)
- (goto-char (if backward (point-max) (point-min)))
- (setq found (funcall re-search regexp nil t)))))
- (message "")
- ;; Adjust article pointer.
- (or (eq last gnus-current-article)
- (setq gnus-last-article last))
- ;; Return T if found such article.
- found))
+ (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)
+ ;; Return whether we found the regexp.
+ (eq found 'found)))
(defun gnus-summary-find-matching (header regexp &optional backward unread
not-case-fold)
@@ -12773,14 +12815,11 @@ Argument REVERSE means reverse order."
(defun gnus-sortable-date (date)
"Make sortable string by string-lessp from DATE.
Timezone package is used."
- (let* ((date (timezone-fix-time date nil nil)) ;[Y M D H M S]
- (year (aref date 0))
- (month (aref date 1))
- (day (aref date 2)))
- (timezone-make-sortable-date
- year month day
- (timezone-make-time-string
- (aref date 3) (aref date 4) (aref date 5)))))
+ (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))))
;; Summary saving commands.
@@ -13018,8 +13057,7 @@ save those articles instead."
(defun gnus-summary-save-in-rmail (&optional filename)
"Append this article to Rmail file.
Optional argument FILENAME specifies file name.
-Directory to save to is default to `gnus-article-save-directory' which
-is initialized from the SAVEDIR environment variable."
+Directory to save to is default to `gnus-article-save-directory'."
(interactive)
(gnus-set-global-variables)
(let ((default-name
@@ -13044,8 +13082,7 @@ is initialized from the SAVEDIR environment variable."
(defun gnus-summary-save-in-mail (&optional filename)
"Append this article to Unix mail file.
Optional argument FILENAME specifies file name.
-Directory to save to is default to `gnus-article-save-directory' which
-is initialized from the SAVEDIR environment variable."
+Directory to save to is default to `gnus-article-save-directory'."
(interactive)
(gnus-set-global-variables)
(let ((default-name
@@ -13077,8 +13114,7 @@ is initialized from the SAVEDIR environment variable."
(defun gnus-summary-save-in-file (&optional filename)
"Append this article to file.
Optional argument FILENAME specifies file name.
-Directory to save to is default to `gnus-article-save-directory' which
-is initialized from the SAVEDIR environment variable."
+Directory to save to is default to `gnus-article-save-directory'."
(interactive)
(gnus-set-global-variables)
(let ((default-name
@@ -13103,8 +13139,7 @@ is initialized from the SAVEDIR environment variable."
(defun gnus-summary-save-body-in-file (&optional filename)
"Append this article body to a file.
Optional argument FILENAME specifies file name.
-The directory to save in defaults to `gnus-article-save-directory' which
-is initialized from the SAVEDIR environment variable."
+The directory to save in defaults to `gnus-article-save-directory'."
(interactive)
(gnus-set-global-variables)
(let ((default-name
@@ -13834,16 +13869,16 @@ always hide."
'boring-headers)))
;; Hide boring Newsgroups header.
((eq elem 'newsgroups)
- (when (equal (mail-fetch-field "newsgroups")
+ (when (equal (message-fetch-field "newsgroups")
(gnus-group-real-name gnus-newsgroup-name))
(gnus-article-hide-header "newsgroups")))
((eq elem 'followup-to)
- (when (equal (mail-fetch-field "followup-to")
- (mail-fetch-field "newsgroups"))
+ (when (equal (message-fetch-field "followup-to")
+ (message-fetch-field "newsgroups"))
(gnus-article-hide-header "followup-to")))
((eq elem 'reply-to)
- (let ((from (mail-fetch-field "from"))
- (reply-to (mail-fetch-field "reply-to")))
+ (let ((from (message-fetch-field "from"))
+ (reply-to (message-fetch-field "reply-to")))
(when (and
from reply-to
(equal
@@ -13852,7 +13887,7 @@ always hide."
reply-to))))
(gnus-article-hide-header "reply-to"))))
((eq elem 'date)
- (let ((date (mail-fetch-field "date")))
+ (let ((date (message-fetch-field "date")))
(when (and date
(< (gnus-days-between date (current-time-string))
4))
@@ -13950,7 +13985,7 @@ always hide."
from)
(save-restriction
(nnheader-narrow-to-headers)
- (setq from (mail-fetch-field "from"))
+ (setq from (message-fetch-field "from"))
(goto-char (point-min))
(when (and gnus-article-x-face-command
(or force
@@ -14213,7 +14248,7 @@ how much time has lapsed since DATE."
(defun gnus-make-date-line (date type)
"Return a DATE line of TYPE."
(cond
- ;; Convert to the local timezone. We have to slap a
+ ;; Convert to the local timezone. We have to slap a
;; `condition-case' round the calls to the timezone
;; functions since they aren't particularly resistant to
;; buggy dates.
@@ -14649,17 +14684,17 @@ If NEWSGROUP is nil, return the global kill file name instead."
((or (null newsgroup)
(string-equal newsgroup ""))
(expand-file-name gnus-kill-file-name
- (or gnus-kill-files-directory "~/News")))
+ gnus-kill-files-directory))
;; Append ".KILL" to newsgroup name.
((gnus-use-long-file-name 'not-kill)
(expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
"." gnus-kill-file-name)
- (or gnus-kill-files-directory "~/News")))
+ gnus-kill-files-directory))
;; Place "KILL" under the hierarchical directory.
(t
(expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
"/" gnus-kill-file-name)
- (or gnus-kill-files-directory "~/News")))))
+ gnus-kill-files-directory))))
;;;
@@ -14704,7 +14739,8 @@ If NEWSGROUP is nil, return the global kill file name instead."
(bury-buffer (current-buffer))
(set-buffer-modified-p nil)
(let ((auto (make-auto-save-file-name))
- (gnus-dribble-ignore t))
+ (gnus-dribble-ignore t)
+ modes)
(when (or (file-exists-p auto) (file-exists-p dribble-file))
;; Load whichever file is newest -- the auto save file
;; or the "real" file.
@@ -14715,9 +14751,9 @@ If NEWSGROUP is nil, return the global kill file name instead."
(set-buffer-modified-p t))
;; Set the file modes to reflect the .newsrc file modes.
(save-buffer)
- (when (file-exists-p gnus-current-startup-file)
- (set-file-modes dribble-file
- (file-modes gnus-current-startup-file)))
+ (when (and (file-exists-p gnus-current-startup-file)
+ (setq modes (file-modes gnus-current-startup-file)))
+ (set-file-modes dribble-file modes))
;; Possibly eval the file later.
(when (gnus-y-or-n-p
"Auto-save file exists. Do you want to read it? ")
View
399 lisp/message.el
@@ -35,6 +35,12 @@
(require 'nnheader)
(require 'timezone)
(require 'easymenu)
+(if (string-match "XEmacs\\|Lucid" emacs-version)
+ (require 'mail-abbrev)
+ (require 'mailabbrev))
+
+(defvar message-directory "~/Mail/"
+ "*Directory from which all other mail file variables are derived.")
;;;###autoload
(defvar message-fcc-handler-function 'rmail-output
@@ -150,7 +156,8 @@ If t, use `message-user-organization-file'.")
"*Local news organization file.")
;;;###autoload
-(defvar message-autosave-directory "~/Mail/drafts/"
+(defvar message-autosave-directory
+ (concat (file-name-as-directory message-directory) "drafts/")
"*Directory where message autosaves buffers.
If nil, message won't autosave.")
@@ -181,10 +188,13 @@ If nil, message won't autosave.")
;; Useful to set in site-init.el
;;;###autoload
-(defvar message-send-mail-function 'message-send-mail
+(defvar message-send-mail-function 'message-send-mail-with-sendmail
"Function to call to send the current buffer as mail.
The headers should be delimited by a line whose contents match the
-variable `mail-header-separator'.")
+variable `mail-header-separator'.
+
+Legal values include `message-send-mail-with-mh' and
+`message-send-mail-with-sendmail', which is the default.")
;;;###autoload
(defvar message-send-news-function 'message-send-news
@@ -454,7 +464,8 @@ The cdr of ech entry is a function for applying the face to a region.")
"Alist used for formatting headers.")
(eval-and-compile
- (autoload 'message-setup-toolbar "message-xmas"))
+ (autoload 'message-setup-toolbar "message-xmas")
+ (autoload 'mh-send-letter "mh-comp"))
@@ -498,13 +509,19 @@ The cdr of ech entry is a function for applying the face to a region.")
(setq beg (match-end 0)))
(nreverse elems)))
+(defun message-fetch-field (header)
+ "The same as `mail-fetch-field', only remove all newlines."
+ (let ((value (mail-fetch-field header)))
+ (when value
+ (nnheader-replace-chars-in-string value ?\n ? ))))
+
(defun message-fetch-reply-field (header)
"Fetch FIELD from the message we're replying to."
(when (and message-reply-buffer
(buffer-name message-reply-buffer))
(save-excursion
(set-buffer message-reply-buffer)
- (mail-fetch-field header))))
+ (message-fetch-field header))))
(defun message-set-work-buffer ()
(if (get-buffer " *message work*")
@@ -586,16 +603,16 @@ Return the number of headers removed."
(save-excursion
(save-restriction
(message-narrow-to-headers)
- (mail-fetch-field "newsgroups"))))
+ (message-fetch-field "newsgroups"))))
(defun message-mail-p ()
"Say whether the current buffer contains a mail message."
(save-excursion
(save-restriction
(message-narrow-to-headers)
- (or (mail-fetch-field "to")
- (mail-fetch-field "cc")
- (mail-fetch-field "bcc")))))
+ (or (message-fetch-field "to")
+ (message-fetch-field "cc")
+ (message-fetch-field "bcc")))))
(defun message-next-header ()
"Go to the beginning of the next header."
@@ -626,7 +643,7 @@ Return the number of headers removed."
(let ((max (1+ (length message-header-format-alist)))
rank)
(message-narrow-to-headers)
- (while (re-search-forward "^[^ ]+:" nil t)
+ (while (re-search-forward "^[^ \n]+:" nil t)
(put-text-property
(match-beginning 0) (1+ (match-beginning 0))
'message-rank
@@ -675,24 +692,27 @@ Return the number of headers removed."
(define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
(define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body)
(define-key message-mode-map "\C-c\C-o" 'message-sort-headers)
+ (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer)
(define-key message-mode-map "\C-c\C-c" 'message-send-and-exit)
(define-key message-mode-map "\C-c\C-s" 'message-send)
(define-key message-mode-map "\C-c\C-k" 'message-kill-buffer)
- (define-key message-mode-map "\C-c\C-p" 'message-dont-send))
+ (define-key message-mode-map "\C-c\C-d" 'message-dont-send)
+
+ (define-key message-mode-map "\t" 'message-tab))
(easy-menu-define message-mode-menu message-mode-map
"Message Menu."
'("Message"
"Go to Field:"
"----"
- ["To:" message-goto-to t]
- ["Subject:" message-goto-subject t]
- ["Summary:" message-goto-summary t]
- ["Keywords:" message-goto-keywords t]
- ["Newsgroups:" message-goto-newsgroups t]
- ["Followup-To:" message-goto-followup-to t]
- ["Distribution:" message-goto-distribution t]
+ ["To" message-goto-to t]
+ ["Subject" message-goto-subject t]
+ ["Summary" message-goto-summary t]
+ ["Keywords" message-goto-keywords t]
+ ["Newsgroups" message-goto-newsgroups t]
+ ["Followup-To" message-goto-followup-to t]
+ ["Distribution" message-goto-distribution t]
["Body" message-goto-body t]
["Signature" message-goto-signature t]
"----"
@@ -703,8 +723,9 @@ Return the number of headers removed."
["Fill Yanked Message" message-fill-yanked-message t]
;; ["Insert Signature" news-reply-signature t]
["Caesar (rot13) Message" message-caesar-buffer-body t]
+ ["Rename buffer" message-rename-buffer t]
"----"
- ["Post Message" message-send-and-exit t]
+ ["Send Message" message-send-and-exit t]
["Abort Message" message-dont-send t]))
;;;###autoload
@@ -964,6 +985,28 @@ Mail and USENET news headers are not rotated."
(narrow-to-region (point) (point-max)))
(message-caesar-region (point-min) (point-max) rotnum))))
+(defun message-rename-buffer (&optional enter-string)
+ "Rename the *message* buffer to \"*message* RECIPIENT\".
+If the function is run with a prefix, it will ask for a new buffer
+name, rather than giving an automatic name."
+ (interactive "Pbuffer name: ")
+ (save-excursion
+ (save-restriction
+ (goto-char (point-min))
+ (narrow-to-region (point)
+ (search-forward mail-header-separator nil 'end))
+ (let* ((mail-to (if (message-news-p) (message-fetch-field "Newsgroups")
+ (message-fetch-field "To")))
+ (mail-trimmed-to
+ (if (string-match "," mail-to)
+ (concat (substring mail-to 0 (match-beginning 0)) ", ...")
+ mail-to))
+ (name-default (concat "*message* " mail-trimmed-to))
+ (name (if enter-string
+ (read-string "New buffer name: " name-default)
+ name-default)))
+ (rename-buffer name t)))))
+
(defun message-fill-yanked-message (&optional justifyp)
"Fill the paragraphs of a message yanked into this one.
Numeric argument means justify as well."
@@ -1162,7 +1205,7 @@ the user from the mailer."
(and (or (not (memq 'mail message-sent-message-via))
(y-or-n-p
"Already sent message via mail; resend? "))
- (funcall message-send-mail-function arg))))
+ (message-send-mail arg))))
(message-do-fcc)
(when (fboundp 'mail-hist-put-headers-into-history)
(mail-hist-put-headers-into-history))
@@ -1200,17 +1243,12 @@ the user from the mailer."
(defun message-send-mail (&optional arg)
(require 'mail-utils)
- (let ((errbuf (if message-interactive
- (generate-new-buffer " sendmail errors")
- 0))
- (tembuf (generate-new-buffer " message temp"))
+ (let ((tembuf (generate-new-buffer " message temp"))
(case-fold-search nil)
(news (message-news-p))
- resend-to-addresses delimline
(mailbuf (current-buffer)))
(save-restriction
(message-narrow-to-headers)
- (setq resend-to-addresses (mail-fetch-field "resent-to"))
;; Insert some headers.
(let ((message-deletable-headers
(if news nil message-deletable-headers)))
@@ -1232,62 +1270,78 @@ the user from the mailer."
(or (= (preceding-char) ?\n)
(insert ?\n))
(when (and news
- (or (mail-fetch-field "cc")
- (mail-fetch-field "to")))
+ (or (message-fetch-field "cc")
+ (message-fetch-field "to")))
(message-insert-courtesy-copy))
- (let ((case-fold-search t))
- ;; Change header-delimiter to be what sendmail expects.
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"))
- (replace-match "\n")
- (backward-char 1)
- (setq delimline (point-marker))
- ;; Insert an extra newline if we need it to work around
- ;; Sun's bug that swallows newlines.
- (goto-char (1+ delimline))
- (when (eval message-mailer-swallows-blank-line)
- (newline))
- (when message-interactive
- (save-excursion
- (set-buffer errbuf)
- (erase-buffer))))
- (let ((default-directory "/"))
- (apply 'call-process-region
- (append (list (point-min) (point-max)
- (if (boundp 'sendmail-program)
- sendmail-program
- "/usr/lib/sendmail")
- nil errbuf nil "-oi")
- ;; Always specify who from,
- ;; since some systems have broken sendmails.
- (list "-f" (user-login-name))
- ;; These mean "report errors by mail"
- ;; and "deliver in background".
- (if (null message-interactive) '("-oem" "-odb"))
- ;; Get the addresses from the message
- ;; unless this is a resend.
- ;; We must not do that for a resend
- ;; because we would find the original addresses.
- ;; For a resend, include the specific addresses.
- (if resend-to-addresses
- (list resend-to-addresses)
- '("-t")))))
- (when message-interactive
- (save-excursion
- (set-buffer errbuf)
- (goto-char (point-min))
- (while (re-search-forward "\n\n* *" nil t)
- (replace-match "; "))
- (if (not (zerop (buffer-size)))
- (error "Sending...failed to %s"
- (buffer-substring (point-min) (point-max)))))))
- (kill-buffer tembuf)
- (when (bufferp errbuf)
- (kill-buffer errbuf)))
+ (funcall message-send-mail-function))
+ (kill-buffer tembuf))
(set-buffer mailbuf)
(push 'mail message-sent-message-via)))
+(defun message-send-mail-with-sendmail ()
+ "Send off the prepared buffer with sendmail."
+ (let ((errbuf (if message-interactive
+ (generate-new-buffer " sendmail errors")
+ 0))
+ resend-to-addresses delimline)
+ (let ((case-fold-search t))
+ (save-restriction
+ (message-narrow-to-headers)
+ (setq resend-to-addresses (message-fetch-field "resent-to")))
+ ;; Change header-delimiter to be what sendmail expects.
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n")
+ (backward-char 1)
+ (setq delimline (point-marker))
+ ;; Insert an extra newline if we need it to work around
+ ;; Sun's bug that swallows newlines.
+ (goto-char (1+ delimline))
+ (when (eval message-mailer-swallows-blank-line)
+ (newline))
+ (when message-interactive
+ (save-excursion
+ (set-buffer errbuf)
+ (erase-buffer))))
+ (let ((default-directory "/"))
+ (apply 'call-process-region
+ (append (list (point-min) (point-max)
+ (if (boundp 'sendmail-program)
+ sendmail-program
+ "/usr/lib/sendmail")
+ nil errbuf nil "-oi")
+ ;; Always specify who from,
+ ;; since some systems have broken sendmails.
+ (list "-f" (user-login-name))
+ ;; These mean "report errors by mail"
+ ;; and "deliver in background".
+ (if (null message-interactive) '("-oem" "-odb"))
+ ;; Get the addresses from the message
+ ;; unless this is a resend.
+ ;; We must not do that for a resend
+ ;; because we would find the original addresses.
+ ;; For a resend, include the specific addresses.
+ (if resend-to-addresses
+ (list resend-to-addresses)
+ '("-t")))))
+ (when message-interactive
+ (save-excursion
+ (set-buffer errbuf)
+ (goto-char (point-min))
+ (while (re-search-forward "\n\n* *" nil t)
+ (replace-match "; "))
+ (if (not (zerop (buffer-size)))
+ (error "Sending...failed to %s"
+ (buffer-substring (point-min) (point-max)))))
+ (when (bufferp errbuf)
+ (kill-buffer errbuf)))))
+
+(defun message-send-mail-with-mh ()
+ "Send the prepared message buffer with mh."
+ (let (mh-previous-window-config)
+ (mh-send-letter)))
+
(defun message-send-news (&optional arg)
(let ((tembuf (generate-new-buffer " *message temp*"))
(case-fold-search nil)
@@ -1354,7 +1408,7 @@ the user from the mailer."
(or
(message-check-element 'subject-cmsg)
(save-excursion
- (if (string-match "^cmsg " (mail-fetch-field "subject"))
+ (if (string-match "^cmsg " (message-fetch-field "subject"))
(y-or-n-p
"The control code \"cmsg \" is in the subject. Really post? ")
t)))
@@ -1387,8 +1441,8 @@ the user from the mailer."
t)))
;; See whether we can shorten Followup-To.
(or (message-check-element 'shorten-followup-to)
- (let ((newsgroups (mail-fetch-field "newsgroups"))
- (followup-to (mail-fetch-field "followup-to"))
+ (let ((newsgroups (message-fetch-field "newsgroups"))
+ (followup-to (message-fetch-field "followup-to"))
to)
(when (and newsgroups (string-match "," newsgroups)
(not followup-to)
@@ -1416,7 +1470,7 @@ the user from the mailer."
(or (message-check-element 'message-id)
(save-excursion
(let* ((case-fold-search t)
- (message-id (mail-fetch-field "message-id")))
+ (message-id (message-fetch-field "message-id")))
(or (not message-id)
(and (string-match "@" message-id)
(string-match "@[^\\.]*\\." message-id))
@@ -1429,7 +1483,7 @@ the user from the mailer."
(message-check-element 'subject)
(save-excursion
(let* ((case-fold-search t)
- (subject (mail-fetch-field "subject")))
+ (subject (message-fetch-field "subject")))
(or
(and subject
(not (string-match "\\`[ \t]*\\'" subject)))
@@ -1441,7 +1495,7 @@ the user from the mailer."
(or (message-check-element 'from)
(save-excursion
(let* ((case-fold-search t)
- (from (mail-fetch-field "from")))
+ (from (message-fetch-field "from")))
(cond
((not from)
(message "There is no From line. Posting is denied.")
@@ -1554,7 +1608,7 @@ the user from the mailer."
(insert-buffer-substring buf)
(save-restriction
(message-narrow-to-headers)
- (while (setq file (mail-fetch-field "fcc"))
+ (while (setq file (message-fetch-field "fcc"))
(push file list)
(message-remove-header "fcc" nil</