*** pub/sgnus/lisp/gnus-cache.el Sun May 19 12:19:53 1996 --- sgnus/lisp/gnus-cache.el Tue May 21 19:37:55 1996 *************** *** 29,35 **** (eval-when-compile (require 'cl)) (defvar gnus-cache-directory ! (concat (file-name-as-directory gnus-article-save-directory) "cache/") "*The directory where cached articles will be stored.") (defvar gnus-cache-active-file --- 29,35 ---- (eval-when-compile (require 'cl)) (defvar gnus-cache-directory ! (nnheader-concat gnus-directory "cache/") "*The directory where cached articles will be stored.") (defvar gnus-cache-active-file *** pub/sgnus/lisp/gnus-kill.el Sun May 19 12:19:53 1996 --- sgnus/lisp/gnus-kill.el Tue May 21 19:40:13 1996 *************** *** 312,329 **** (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"))) (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"))) (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"))))) (defun gnus-expunge (marks) "Remove lines marked with MARKS." --- 312,328 ---- (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 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) ! gnus-kill-files-directory)) (t ;; Place "KILL" under the hierarchical directory. (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) "/" gnus-kill-file-name) ! gnus-kill-files-directory)))) (defun gnus-expunge (marks) "Remove lines marked with MARKS." *** pub/sgnus/lisp/gnus-mh.el Sun May 19 12:19:53 1996 --- sgnus/lisp/gnus-mh.el Tue May 21 17:06:09 1996 *************** *** 81,123 **** (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. --- 81,86 ---- *************** *** 137,141 **** --- 100,106 ---- (if gnus-use-long-file-name newsgroup (gnus-newsgroup-directory-form newsgroup))))) + + (provide 'gnus-mh) ;;; gnus-mh.el ends here *** pub/sgnus/lisp/gnus-msg.el Sun May 19 12:19:53 1996 --- sgnus/lisp/gnus-msg.el Tue May 21 22:20:16 1996 *************** *** 71,78 **** the group.") (defvar gnus-sent-message-ids-file ! (concat (file-name-as-directory gnus-article-save-directory) ! "Sent-Message-IDs") "File where Gnus saves a cache of sent message ids.") (defvar gnus-sent-message-ids-length 1000 --- 71,77 ---- the group.") (defvar gnus-sent-message-ids-file ! (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,193 **** (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-summary-post-news () ! "Post an article." (interactive) (gnus-set-global-variables) (gnus-post-news 'post gnus-newsgroup-name)) --- 164,180 ---- (gnus-setup-message 'message (message-mail))) ! (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 () ! "Start composing a news message." (interactive) (gnus-set-global-variables) (gnus-post-news 'post gnus-newsgroup-name)) *************** *** 277,283 **** (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))) (when (and (get-buffer article-buffer) (buffer-name (get-buffer article-buffer))) (save-excursion --- 264,271 ---- (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)) ! end) (when (and (get-buffer article-buffer) (buffer-name (get-buffer article-buffer))) (save-excursion *************** *** 285,293 **** (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)) (defun gnus-post-news (post &optional group header article-buffer yank subject force-news) --- 273,287 ---- (save-restriction (widen) (copy-to-buffer gnus-article-copy (point-min) (point-max)) ! (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,694 **** (defun gnus-bug-kill-buffer () (and (get-buffer "*Gnus Help Bug*") ! (kill-buffer "*Gnus Help Bug*")) ! (kill-buffer nil)) (defun gnus-debug () "Attemps to go through the Gnus source file and report what variables have been changed. --- 681,687 ---- (defun gnus-bug-kill-buffer () (and (get-buffer "*Gnus Help Bug*") ! (kill-buffer "*Gnus Help Bug*"))) (defun gnus-debug () "Attemps to go through the Gnus source file and report what variables have been changed. *************** *** 783,789 **** (defun gnus-inews-do-gcc (&optional gcc) (save-excursion (save-restriction ! (nnheader-narrow-to-headers) (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) (cur (current-buffer)) groups group method) --- 776,782 ---- (defun gnus-inews-do-gcc (&optional gcc) (save-excursion (save-restriction ! (message-narrow-to-headers) (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) (cur (current-buffer)) groups group method) *************** *** 803,812 **** ;; If the group doesn't exist, we assume ;; it's an archive group... gnus-message-archive-method) (t (gnus-group-method group))))) (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) --- 796,809 ---- ;; 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)) (save-excursion (nnheader-set-temp-buffer " *acc*") (insert-buffer-substring cur) *** pub/sgnus/lisp/gnus-picon.el Sun May 19 12:19:54 1996 --- sgnus/lisp/gnus-picon.el Tue May 21 17:06:10 1996 *************** *** 120,126 **** (if (annotationp listitem) (delete-annotation listitem)) (setq plist (cdr plist)))) ! ) (defun gnus-picons-remove-all () "Removes all picons from the Gnus display(s)." --- 120,126 ---- (if (annotationp listitem) (delete-annotation listitem)) (setq plist (cdr plist)))) ! ) (defun gnus-picons-remove-all () "Removes all picons from the Gnus display(s)." *************** *** 133,139 **** 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." --- 133,139 ---- 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,172 **** (interactive) ;; convert the x-face header to a .xbm file (let ((process-connection-type nil) ! (process nil)) (process-kill-without-query (setq process (start-process ! "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. (while (not (equal (process-status process) 'exit)) (sleep-for .1))) ;; display it --- 160,172 ---- (interactive) ;; convert the x-face header to a .xbm file (let ((process-connection-type nil) ! (process nil)) (process-kill-without-query (setq process (start-process ! "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. (while (not (equal (process-status process) 'exit)) (sleep-for .1))) ;; display it *************** *** 177,216 **** (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))) (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))) ;; 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." (interactive) (if (and (featurep 'xpm) ! (or (not (fboundp 'device-type)) (equal (device-type) 'x))) (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") ! "\\." "/")) "/"))) (switch-to-buffer (gnus-get-buffer-name gnus-picons-display-where)) (gnus-add-current-to-buffer-list) (beginning-of-buffer) --- 177,217 ---- (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))) (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))) ;; 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." (interactive) (if (and (featurep 'xpm) ! (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") ! "\\." "/")) "/"))) (switch-to-buffer (gnus-get-buffer-name gnus-picons-display-where)) (gnus-add-current-to-buffer-list) (beginning-of-buffer) *************** *** 228,257 **** (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)))) (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-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) (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all) )))) --- 229,258 ---- (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)))) (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-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) (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all) )))) *************** *** 261,292 **** (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))))) (defun gnus-picons-insert-face-if-exists (path filename ipoint &optional rev) --- 262,293 ---- (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))))) (defun gnus-picons-insert-face-if-exists (path filename ipoint &optional rev) *************** *** 297,318 **** "[_a-zA-Z0-9-]+/\\([_A-Za-z0-9-]+\\)$" "\\1")) (annotations nil)) (if (and rev ! (not (equal filename newfilename))) (setq annotations (append ! (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)))) (setq annotations (append ! (gnus-picons-try-to-find-face ! (concat pathfile ".xbm") ipoint) ! annotations))) (if (and (not rev) ! (not (equal filename newfilename))) (setq annotations (append ! (gnus-picons-insert-face-if-exists path newfilename ipoint rev) ! annotations))) annotations ) ) --- 298,319 ---- "[_a-zA-Z0-9-]+/\\([_A-Za-z0-9-]+\\)$" "\\1")) (annotations nil)) (if (and rev ! (not (equal filename newfilename))) (setq annotations (append ! (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)))) (setq annotations (append ! (gnus-picons-try-to-find-face ! (concat pathfile ".xbm") ipoint) ! annotations))) (if (and (not rev) ! (not (equal filename newfilename))) (setq annotations (append ! (gnus-picons-insert-face-if-exists path newfilename ipoint rev) ! annotations))) annotations ) ) *** pub/sgnus/lisp/gnus-salt.el Sun May 19 12:19:54 1996 --- sgnus/lisp/gnus-salt.el Tue May 21 17:06:10 1996 *************** *** 84,90 **** ["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." (interactive "P") (when (eq major-mode 'gnus-summary-mode) (make-local-variable 'gnus-pick-mode) --- 84,92 ---- ["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. ! ! \\{gnus-pick-mode-map}" (interactive "P") (when (eq major-mode 'gnus-summary-mode) (make-local-variable 'gnus-pick-mode) *************** *** 115,121 **** (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)) ;;; --- 117,124 ---- (gnus-summary-limit-to-articles nil) (when catch-up (gnus-summary-limit-mark-excluded-as-read)) ! (gnus-summary-first-unread-article) ! (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t)) ;;; *** pub/sgnus/lisp/gnus-score.el Sun May 19 12:19:55 1996 --- sgnus/lisp/gnus-score.el Tue May 21 22:40:57 1996 *************** *** 529,535 **** ((eq type 'f) (setq match (gnus-simplify-subject-fuzzy match)))) (let ((score (gnus-score-default score)) ! (header (downcase header))) (and prompt (setq match (read-string (format "Match %s on %s, %s: " (cond ((eq date 'now) --- 529,536 ---- ((eq type 'f) (setq match (gnus-simplify-subject-fuzzy match)))) (let ((score (gnus-score-default score)) ! (header (downcase header)) ! new) (and prompt (setq match (read-string (format "Match %s on %s, %s: " (cond ((eq date 'now) *************** *** 543,554 **** (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))) --- 544,549 ---- *************** *** 557,573 **** ;; 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)) elem) ;; 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. --- 552,565 ---- ;; Add the score entry to the score file. (when (= score gnus-score-interactive-default-score) (setq score nil)) ! (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,590 **** 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)))) (defun gnus-summary-score-effect (header match type score) "Simulate the effect of a score file entry. --- 575,592 ---- 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)))) ! ! ;; 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,789 **** (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 --- 785,790 ---- *************** *** 1027,1033 **** ;; 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)) ;; This is a normal score file, so we print it very ;; prettily. (pp score (current-buffer)))) --- 1028,1034 ---- ;; 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. ! (prin1 score (current-buffer)) ;; This is a normal score file, so we print it very ;; prettily. (pp score (current-buffer)))) *************** *** 1837,1843 **** (defun gnus-summary-rescore () "Redo the entire scoring process in the current summary." (interactive) ! (setq gnus-newsgroup-scored nil) (setq gnus-score-cache nil) (setq gnus-newsgroup-scored nil) (gnus-possibly-score-headers) --- 1838,1844 ---- (defun gnus-summary-rescore () "Redo the entire scoring process in the current summary." (interactive) ! (gnus-score-save) (setq gnus-score-cache nil) (setq gnus-newsgroup-scored nil) (gnus-possibly-score-headers) *************** *** 1929,1936 **** (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/"))) ;; 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) --- 1930,1936 ---- (gnus-score-search-global-directories gnus-global-score-files))) ;; Fix the kill-file dir variable. (setq gnus-kill-files-directory ! (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,2162 **** (string-equal newsgroup "")) ;; The global score file is placed at top of the directory. (expand-file-name ! suffix (or gnus-kill-files-directory "~/News"))) ((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"))) (t ;; Place "SCORE" under the hierarchical directory. (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) "/" suffix) ! (or gnus-kill-files-directory "~/News"))))))) (defun gnus-score-search-global-directories (files) "Scan all global score directories for score files." --- 2146,2162 ---- (string-equal newsgroup "")) ;; The global score file is placed at top of the directory. (expand-file-name ! 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) ! gnus-kill-files-directory)) (t ;; Place "SCORE" under the hierarchical directory. (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) "/" suffix) ! gnus-kill-files-directory)))))) (defun gnus-score-search-global-directories (files) "Scan all global score directories for score files." *** pub/sgnus/lisp/gnus-setup.el Sun May 19 12:19:55 1996 --- sgnus/lisp/gnus-setup.el Tue May 21 20:27:56 1996 *************** *** 1,10 **** ;;; gnus-setup.el --- Initialization & Setup for Gnus 5 ! ;; Copyright (C) 1995 Miranova Systems, Inc. ;; Author: Steven L. Baur ;; Keywords: news ! ;; This file is not yet a 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 --- 1,10 ---- ;;; gnus-setup.el --- Initialization & Setup for Gnus 5 ! ;; Copyright (C) 1995, 96 Free Software Foundation, Inc. ;; Author: Steven L. Baur ;; Keywords: news ! ;; 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,45 **** "Directory where Emacs site lisp is located.") (defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory ! "gnus-5.0.12/lisp/") "Directory where Gnus Emacs lisp is found.") (defvar gnus-sgnus-lisp-directory (concat gnus-emacs-lisp-directory --- 39,45 ---- "Directory where Emacs site lisp is located.") (defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory ! "gnus-5.0.15/lisp/") "Directory where Gnus Emacs lisp is found.") (defvar gnus-sgnus-lisp-directory (concat gnus-emacs-lisp-directory *** pub/sgnus/lisp/gnus-soup.el Sun May 19 12:19:55 1996 --- sgnus/lisp/gnus-soup.el Tue May 21 18:07:39 1996 *************** *** 545,551 **** (gnus-message 5 "Sending mail to %s..." (mail-fetch-field "to")) (sit-for 1) ! (funcall message-send-mail-function)) (t (error "Unknown reply kind"))) (set-buffer msg-buf) --- 545,551 ---- (gnus-message 5 "Sending mail to %s..." (mail-fetch-field "to")) (sit-for 1) ! (message-send-mail)) (t (error "Unknown reply kind"))) (set-buffer msg-buf) *** pub/sgnus/lisp/gnus-topic.el Sun May 19 12:19:55 1996 --- sgnus/lisp/gnus-topic.el Tue May 21 22:40:58 1996 *************** *** 48,56 **** %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.") --- 48,53 ---- *************** *** 59,64 **** --- 56,64 ---- (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,94 **** --- 89,101 ---- "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,120 **** (setq gnus-topic-tallied-groups nil) ! (unless gnus-topic-alist (gnus-topic-check-topology)) (unless list-topic --- 121,128 ---- (setq gnus-topic-tallied-groups nil) ! (when (or (not gnus-topic-alist) ! (not gnus-topology-checked-p)) (gnus-topic-check-topology)) (unless list-topic *************** *** 367,373 **** (setq gnus-topic-active-topology nil gnus-topic-active-alist nil gnus-topic-killed-topics nil ! gnus-topic-tallied-groups nil)) (defun gnus-topic-check-topology () ;; The first time we set the topology to whatever we have --- 375,382 ---- (setq gnus-topic-active-topology nil gnus-topic-active-alist nil gnus-topic-killed-topics 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,380 **** --- 384,390 ---- (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,428 **** (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) --- 426,431 ---- *************** *** 435,443 **** --- 438,459 ---- 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,478 **** (forward-line 1))))) (defun gnus-topic-update-topic-line (topic-name &optional reads) ! (let* ((type (cadr (gnus-topic-find-topology topic-name))) (entries (gnus-topic-find-groups (car type) (car gnus-group-list-mode) (cdr gnus-group-list-mode))) --- 488,496 ---- (forward-line 1))))) (defun gnus-topic-update-topic-line (topic-name &optional reads) ! (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,489 **** --- 502,509 ---- ;; 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,656 **** (make-local-variable 'gnus-group-indentation-function) (setq gnus-group-indentation-function 'gnus-topic-group-indentation) ;; We check the topology. ! (gnus-topic-check-topology) (run-hooks 'gnus-topic-mode-hook)) ;; Remove topic infestation. (unless gnus-topic-mode --- 669,678 ---- (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. ! (when gnus-newsrc-alist ! (gnus-topic-check-topology)) (run-hooks 'gnus-topic-mode-hook)) ;; Remove topic infestation. (unless gnus-topic-mode *************** *** 721,727 **** (gnus-topic-goto-topic topic)) (defun gnus-topic-move-group (n topic &optional copyp) ! "Move the current group to a topic." (interactive (list current-prefix-arg (completing-read "Move to topic: " gnus-topic-alist nil t))) --- 743,750 ---- (gnus-topic-goto-topic topic)) (defun gnus-topic-move-group (n topic &optional copyp) ! "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,741 **** (mapcar (lambda (g) (gnus-group-remove-mark g) (when (and ! (setq entry (assoc (gnus-group-topic g) gnus-topic-alist)) (not copyp)) (setcdr entry (delete g (cdr entry)))) ! (when topicl ! (nconc topicl (list g)))) groups) (gnus-group-position-point)) (gnus-topic-enter-dribble) --- 754,764 ---- (mapcar (lambda (g) (gnus-group-remove-mark g) (when (and ! (setq entry (assoc (gnus-group-parent-topic) ! gnus-topic-alist)) (not copyp)) (setcdr entry (delete g (cdr entry)))) ! (nconc topicl (list g))) groups) (gnus-group-position-point)) (gnus-topic-enter-dribble) *************** *** 775,781 **** (when (and (< oldlevel gnus-level-zombie) (>= level gnus-level-zombie)) (let (alist) ! (when (setq alist (assoc (gnus-group-topic group) 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) --- 798,804 ---- (when (and (< oldlevel gnus-level-zombie) (>= level gnus-level-zombie)) (let (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,827 **** (if (gnus-group-goto-group group) t ;; The group is no longer visible. ! (let* ((list (assoc (gnus-group-topic group) gnus-topic-alist)) (after (cdr (member group (cdr list))))) ;; First try to put point on a group after the current one. (while (and after --- 844,850 ---- (if (gnus-group-goto-group group) t ;; The group is no longer visible. ! (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 *** pub/sgnus/lisp/gnus-uu.el Sun May 19 12:19:57 1996 --- sgnus/lisp/gnus-uu.el Tue May 21 18:02:32 1996 *************** *** 1129,1134 **** --- 1129,1135 ---- (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 *** pub/sgnus/lisp/gnus-vis.el Sun May 19 12:19:58 1996 --- sgnus/lisp/gnus-vis.el Tue May 21 21:32:25 1996 *************** *** 1546,1553 **** (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)) (defun gnus-insert-prev-page-button () (let ((buffer-read-only nil)) --- 1546,1553 ---- (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-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,1567 **** (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)) (defun gnus-insert-next-page-button () (let ((buffer-read-only nil)) --- 1560,1583 ---- (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-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)) *** pub/sgnus/lisp/gnus-vm.el Sun May 19 12:19:58 1996 --- sgnus/lisp/gnus-vm.el Tue May 21 17:06:15 1996 *************** *** 106,261 **** ;; 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. --- 106,111 ---- *** pub/sgnus/lisp/gnus.el Sun May 19 12:20:00 1996 --- sgnus/lisp/gnus.el Tue May 21 23:27:40 1996 *************** *** 35,40 **** --- 35,43 ---- (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,139 **** 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)) "*Method used for archiving messages you've sent. This should be a mail method.") --- 133,144 ---- see the manual for details.") (defvar gnus-message-archive-method ! '(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,284 **** 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-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-default-article-saver 'gnus-summary-save-in-rmail "*A function to save articles in your favorite format. --- 277,287 ---- saving; and if it contains the element `not-kill', long file names will not be used for kill files.") ! (defvar gnus-article-save-directory gnus-directory ! "*Name of the directory articles will be saved in (default \"~/News\").") ! ! (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,608 **** (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.") --- 603,608 ---- *************** *** 1208,1220 **** "*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}" "*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.") (defvar gnus-valid-select-methods '(("nntp" post address prompt-address) --- 1208,1221 ---- "*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}" "*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. ! %: \":\" if %S isn't \"\".") (defvar gnus-valid-select-methods '(("nntp" post address prompt-address) *************** *** 1711,1717 **** (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))) (defvar gnus-have-read-active-file nil) --- 1712,1719 ---- (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) ! (?: gnus-tmp-colon ?s))) (defvar gnus-have-read-active-file nil) *************** *** 1719,1725 **** "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.89" "Version number for this version of Gnus.") (defvar gnus-info-nodes --- 1721,1727 ---- "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") ! (defconst gnus-version "September Gnus v0.90" "Version number for this version of Gnus.") (defvar gnus-info-nodes *************** *** 2455,2461 **** (let ((case-fold-search t) (inhibit-point-motion-hooks t)) (nnheader-narrow-to-headers) ! (mail-fetch-field field))))) (defun gnus-goto-colon () (beginning-of-line) --- 2457,2463 ---- (let ((case-fold-search t) (inhibit-point-motion-hooks t)) (nnheader-narrow-to-headers) ! (message-fetch-field field))))) (defun gnus-goto-colon () (beginning-of-line) *************** *** 2823,2829 **** (gnus-capitalize-newsgroup newsgroup) (gnus-newsgroup-directory-form newsgroup)) "/" (int-to-string (mail-header-number headers))) ! (or gnus-article-save-directory "~/News")))) (if (and last-file (string-equal (file-name-directory default) (file-name-directory last-file)) --- 2825,2831 ---- (gnus-capitalize-newsgroup newsgroup) (gnus-newsgroup-directory-form newsgroup)) "/" (int-to-string (mail-header-number headers))) ! gnus-article-save-directory))) (if (and last-file (string-equal (file-name-directory default) (file-name-directory last-file)) *************** *** 2841,2847 **** newsgroup (gnus-newsgroup-directory-form newsgroup)) "/" (int-to-string (mail-header-number headers))) ! (or gnus-article-save-directory "~/News")))) (if (and last-file (string-equal (file-name-directory default) (file-name-directory last-file)) --- 2843,2849 ---- newsgroup (gnus-newsgroup-directory-form newsgroup)) "/" (int-to-string (mail-header-number headers))) ! gnus-article-save-directory))) (if (and last-file (string-equal (file-name-directory default) (file-name-directory last-file)) *************** *** 2858,2864 **** (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")))) (defun gnus-plain-save-name (newsgroup headers &optional last-file) "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. --- 2860,2866 ---- (if (gnus-use-long-file-name 'not-save) (gnus-capitalize-newsgroup newsgroup) (concat (gnus-newsgroup-directory-form newsgroup) "/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,2875 **** (if (gnus-use-long-file-name 'not-save) newsgroup (concat (gnus-newsgroup-directory-form newsgroup) "/news")) ! (or gnus-article-save-directory "~/News")))) ;; For subscribing new newsgroup --- 2871,2877 ---- (if (gnus-use-long-file-name 'not-save) newsgroup (concat (gnus-newsgroup-directory-form newsgroup) "/news")) ! gnus-article-save-directory))) ;; For subscribing new newsgroup *************** *** 3693,3709 **** ;; 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)) ! "???"))))) ;; Make a hash table (default and minimum size is 255). ;; Optional argument HASHSIZE specifies the table size. --- 3695,3724 ---- ;; 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 (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,3783 **** --- 3793,3811 ---- (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,4282 **** 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)) ;;;###autoload (defun gnus-slave (&optional arg) --- 4301,4310 ---- 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 ((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,4632 **** --- 4655,4662 ---- (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,4862 **** "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)))) (and entry (not (gnus-ephemeral-group-p group)) (gnus-dribble-enter (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry)) ")"))) (gnus-delete-line) (gnus-group-insert-group-line-info group) (forward-line -1) --- 4881,4894 ---- "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))) ! 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,5009 **** --- 5035,5043 ---- (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,5018 **** --- 5047,5053 ---- 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,5036 **** (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)) (set-buffer-modified-p t)))))) (defun gnus-group-group-name () --- 5060,5072 ---- (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)) (set-buffer-modified-p t)))))) (defun gnus-group-group-name () *************** *** 5118,5125 **** (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)) --- 5154,5161 ---- (setq gnus-group-marked (delete group gnus-group-marked))) (insert "#") (setq gnus-group-marked ! (cons group (delete group gnus-group-marked))))) ! (or no-advance (gnus-group-next-group 1)) (decf n)) (gnus-summary-position-point) n)) *************** *** 6357,6363 **** (let (list) (mapatoms (lambda (sym) ! (and (symbol-value sym) (setq list (cons (symbol-name sym) list)))) gnus-active-hashtb) list) --- 6393,6400 ---- (let (list) (mapatoms (lambda (sym) ! (and (boundp sym) ! (symbol-value sym) (setq list (cons (symbol-name sym) list)))) gnus-active-hashtb) list) *************** *** 8048,8054 **** ((null level) nil) ((zerop level) t) ((null refs) t) ! ((null(gnus-parent-id refs)) t) ((and (= 1 level) (null (setq particle (gnus-id-to-article (gnus-parent-id refs)))) --- 8085,8091 ---- ((null level) nil) ((zerop level) t) ((null refs) t) ! ((null (gnus-parent-id refs)) t) ((and (= 1 level) (null (setq particle (gnus-id-to-article (gnus-parent-id refs)))) *************** *** 8568,8580 **** (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. (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)) --- 8605,8623 ---- (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. (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,8895 **** (gnus-tmp-subject (if (and gnus-current-headers (vectorp gnus-current-headers)) ! (mail-header-subject gnus-current-headers) "")) max-len gnus-tmp-header);; passed as argument to any user-format-funcs (setq mode-string (eval mformat)) --- 8932,8939 ---- (gnus-tmp-subject (if (and gnus-current-headers (vectorp 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,10880 **** (set-buffer gnus-original-article-buffer) (nnheader-narrow-to-headers) (prog1 ! (mail-fetch-field "references") (widen))) ;; It's not the current article, so we take a bet on ;; the value we got from the server. --- 10918,10924 ---- (set-buffer gnus-original-article-buffer) (nnheader-narrow-to-headers) (prog1 ! (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,11066 **** (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." (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. (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)) (defun gnus-summary-find-matching (header regexp &optional backward unread not-case-fold) --- 11064,11108 ---- (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." (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 ! 're-search-backward 're-search-forward)) ! (sum (current-buffer)) ! (found nil)) ! ;; Hidden thread subtrees must be searched, too. (gnus-summary-show-all-threads) (gnus-summary-select-article) ! (set-buffer gnus-article-buffer) ! (while (not found) ! (gnus-message 7 "Searching article: %d..." gnus-current-article) ! (if (if backward ! (re-search-backward regexp nil t) ! (re-search-forward regexp nil t)) ! ;; We found the regexp. ! (progn ! (setq found 'found) ! (beginning-of-line) ! (set-window-start ! (get-buffer-window (current-buffer)) ! (point))) ! ;; We didn't find it, so we go to the next article. ! (set-buffer sum) ! (if (not (if backward (gnus-summary-find-prev) ! (gnus-summary-find-next))) ! ;; No more articles. ! (setq found t) ! ;; Select the next article and adjust point. ! (gnus-summary-select-article) ! (set-buffer gnus-article-buffer) ! (widen) ! (goto-char (if backward (point-max) (point-min)))))) ! (set-buffer sum) ! ;; Return whether we found the regexp. ! (eq found 'found))) (defun gnus-summary-find-matching (header regexp &optional backward unread not-case-fold) *************** *** 12773,12786 **** (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))))) ;; Summary saving commands. --- 12815,12825 ---- (defun gnus-sortable-date (date) "Make sortable string by string-lessp from DATE. Timezone package is used." ! (setq date (timezone-fix-time date nil nil)) ! (timezone-make-sortable-date ! (aref date 0) (aref date 2) (aref date 2) ! (timezone-make-time-string ! (aref date 3) (aref date 4) (aref date 5)))) ;; Summary saving commands. *************** *** 13018,13025 **** (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." (interactive) (gnus-set-global-variables) (let ((default-name --- 13057,13063 ---- (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'." (interactive) (gnus-set-global-variables) (let ((default-name *************** *** 13044,13051 **** (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." (interactive) (gnus-set-global-variables) (let ((default-name --- 13082,13088 ---- (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'." (interactive) (gnus-set-global-variables) (let ((default-name *************** *** 13077,13084 **** (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." (interactive) (gnus-set-global-variables) (let ((default-name --- 13114,13120 ---- (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'." (interactive) (gnus-set-global-variables) (let ((default-name *************** *** 13103,13110 **** (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." (interactive) (gnus-set-global-variables) (let ((default-name --- 13139,13145 ---- (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'." (interactive) (gnus-set-global-variables) (let ((default-name *************** *** 13834,13849 **** 'boring-headers))) ;; Hide boring Newsgroups header. ((eq elem 'newsgroups) ! (when (equal (mail-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")) (gnus-article-hide-header "followup-to"))) ((eq elem 'reply-to) ! (let ((from (mail-fetch-field "from")) ! (reply-to (mail-fetch-field "reply-to"))) (when (and from reply-to (equal --- 13869,13884 ---- 'boring-headers))) ;; Hide boring Newsgroups header. ((eq elem '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 (message-fetch-field "followup-to") ! (message-fetch-field "newsgroups")) (gnus-article-hide-header "followup-to"))) ((eq elem 'reply-to) ! (let ((from (message-fetch-field "from")) ! (reply-to (message-fetch-field "reply-to"))) (when (and from reply-to (equal *************** *** 13852,13858 **** reply-to)))) (gnus-article-hide-header "reply-to")))) ((eq elem 'date) ! (let ((date (mail-fetch-field "date"))) (when (and date (< (gnus-days-between date (current-time-string)) 4)) --- 13887,13893 ---- reply-to)))) (gnus-article-hide-header "reply-to")))) ((eq elem 'date) ! (let ((date (message-fetch-field "date"))) (when (and date (< (gnus-days-between date (current-time-string)) 4)) *************** *** 13950,13956 **** from) (save-restriction (nnheader-narrow-to-headers) ! (setq from (mail-fetch-field "from")) (goto-char (point-min)) (when (and gnus-article-x-face-command (or force --- 13985,13991 ---- from) (save-restriction (nnheader-narrow-to-headers) ! (setq from (message-fetch-field "from")) (goto-char (point-min)) (when (and gnus-article-x-face-command (or force *************** *** 14213,14219 **** (defun gnus-make-date-line (date type) "Return a DATE line of TYPE." (cond ! ;; 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. --- 14248,14254 ---- (defun gnus-make-date-line (date type) "Return a DATE line of TYPE." (cond ! ;; 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,14665 **** ((or (null newsgroup) (string-equal newsgroup "")) (expand-file-name gnus-kill-file-name ! (or gnus-kill-files-directory "~/News"))) ;; 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"))) ;; 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"))))) ;;; --- 14684,14700 ---- ((or (null newsgroup) (string-equal newsgroup "")) (expand-file-name gnus-kill-file-name ! 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) ! gnus-kill-files-directory)) ;; Place "KILL" under the hierarchical directory. (t (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) "/" gnus-kill-file-name) ! gnus-kill-files-directory)))) ;;; *************** *** 14704,14710 **** (bury-buffer (current-buffer)) (set-buffer-modified-p nil) (let ((auto (make-auto-save-file-name)) ! (gnus-dribble-ignore t)) (when (or (file-exists-p auto) (file-exists-p dribble-file)) ;; Load whichever file is newest -- the auto save file ;; or the "real" file. --- 14739,14746 ---- (bury-buffer (current-buffer)) (set-buffer-modified-p nil) (let ((auto (make-auto-save-file-name)) ! (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,14723 **** (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))) ;; Possibly eval the file later. (when (gnus-y-or-n-p "Auto-save file exists. Do you want to read it? ") --- 14751,14759 ---- (set-buffer-modified-p t)) ;; Set the file modes to reflect the .newsrc file modes. (save-buffer) ! (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? ") *** pub/sgnus/lisp/message.el Sun May 19 12:20:01 1996 --- sgnus/lisp/message.el Tue May 21 20:22:03 1996 *************** *** 35,40 **** --- 35,46 ---- (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,156 **** "*Local news organization file.") ;;;###autoload ! (defvar message-autosave-directory "~/Mail/drafts/" "*Directory where message autosaves buffers. If nil, message won't autosave.") --- 156,163 ---- "*Local news organization file.") ;;;###autoload ! (defvar message-autosave-directory ! (concat (file-name-as-directory message-directory) "drafts/") "*Directory where message autosaves buffers. If nil, message won't autosave.") *************** *** 181,190 **** ;; Useful to set in site-init.el ;;;###autoload ! (defvar message-send-mail-function 'message-send-mail "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'.") ;;;###autoload (defvar message-send-news-function 'message-send-news --- 188,200 ---- ;; Useful to set in site-init.el ;;;###autoload ! (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'. ! ! 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,460 **** "Alist used for formatting headers.") (eval-and-compile ! (autoload 'message-setup-toolbar "message-xmas")) --- 464,471 ---- "Alist used for formatting headers.") (eval-and-compile ! (autoload 'message-setup-toolbar "message-xmas") ! (autoload 'mh-send-letter "mh-comp")) *************** *** 498,510 **** (setq beg (match-end 0))) (nreverse elems))) (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)))) (defun message-set-work-buffer () (if (get-buffer " *message work*") --- 509,527 ---- (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) ! (message-fetch-field header)))) (defun message-set-work-buffer () (if (get-buffer " *message work*") *************** *** 586,601 **** (save-excursion (save-restriction (message-narrow-to-headers) ! (mail-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"))))) (defun message-next-header () "Go to the beginning of the next header." --- 603,618 ---- (save-excursion (save-restriction (message-narrow-to-headers) ! (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 (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,632 **** (let ((max (1+ (length message-header-format-alist))) rank) (message-narrow-to-headers) ! (while (re-search-forward "^[^ ]+:" nil t) (put-text-property (match-beginning 0) (1+ (match-beginning 0)) 'message-rank --- 643,649 ---- (let ((max (1+ (length message-header-format-alist))) rank) (message-narrow-to-headers) ! (while (re-search-forward "^[^ \n]+:" nil t) (put-text-property (match-beginning 0) (1+ (match-beginning 0)) 'message-rank *************** *** 675,698 **** (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\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)) (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] ["Body" message-goto-body t] ["Signature" message-goto-signature t] "----" --- 692,718 ---- (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-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] ["Body" message-goto-body t] ["Signature" message-goto-signature t] "----" *************** *** 703,710 **** ["Fill Yanked Message" message-fill-yanked-message t] ;; ["Insert Signature" news-reply-signature t] ["Caesar (rot13) Message" message-caesar-buffer-body t] "----" ! ["Post Message" message-send-and-exit t] ["Abort Message" message-dont-send t])) ;;;###autoload --- 723,731 ---- ["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] "----" ! ["Send Message" message-send-and-exit t] ["Abort Message" message-dont-send t])) ;;;###autoload *************** *** 964,969 **** --- 985,1012 ---- (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,1168 **** (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-do-fcc) (when (fboundp 'mail-hist-put-headers-into-history) (mail-hist-put-headers-into-history)) --- 1205,1211 ---- (and (or (not (memq 'mail message-sent-message-via)) (y-or-n-p "Already sent message via mail; resend? ")) ! (message-send-mail arg)))) (message-do-fcc) (when (fboundp 'mail-hist-put-headers-into-history) (mail-hist-put-headers-into-history)) *************** *** 1200,1216 **** (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")) (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))) --- 1243,1254 ---- (defun message-send-mail (&optional arg) (require 'mail-utils) ! (let ((tembuf (generate-new-buffer " message temp")) (case-fold-search nil) (news (message-news-p)) (mailbuf (current-buffer))) (save-restriction (message-narrow-to-headers) ;; Insert some headers. (let ((message-deletable-headers (if news nil message-deletable-headers))) *************** *** 1232,1293 **** (or (= (preceding-char) ?\n) (insert ?\n)) (when (and news ! (or (mail-fetch-field "cc") ! (mail-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))) (set-buffer mailbuf) (push 'mail message-sent-message-via))) (defun message-send-news (&optional arg) (let ((tembuf (generate-new-buffer " *message temp*")) (case-fold-search nil) --- 1270,1347 ---- (or (= (preceding-char) ?\n) (insert ?\n)) (when (and news ! (or (message-fetch-field "cc") ! (message-fetch-field "to"))) (message-insert-courtesy-copy)) ! (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,1360 **** (or (message-check-element 'subject-cmsg) (save-excursion ! (if (string-match "^cmsg " (mail-fetch-field "subject")) (y-or-n-p "The control code \"cmsg \" is in the subject. Really post? ") t))) --- 1408,1414 ---- (or (message-check-element 'subject-cmsg) (save-excursion ! (if (string-match "^cmsg " (message-fetch-field "subject")) (y-or-n-p "The control code \"cmsg \" is in the subject. Really post? ") t))) *************** *** 1387,1394 **** 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")) to) (when (and newsgroups (string-match "," newsgroups) (not followup-to) --- 1441,1448 ---- t))) ;; See whether we can shorten Followup-To. (or (message-check-element 'shorten-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,1422 **** (or (message-check-element 'message-id) (save-excursion (let* ((case-fold-search t) ! (message-id (mail-fetch-field "message-id"))) (or (not message-id) (and (string-match "@" message-id) (string-match "@[^\\.]*\\." message-id)) --- 1470,1476 ---- (or (message-check-element 'message-id) (save-excursion (let* ((case-fold-search t) ! (message-id (message-fetch-field "message-id"))) (or (not message-id) (and (string-match "@" message-id) (string-match "@[^\\.]*\\." message-id)) *************** *** 1429,1435 **** (message-check-element 'subject) (save-excursion (let* ((case-fold-search t) ! (subject (mail-fetch-field "subject"))) (or (and subject (not (string-match "\\`[ \t]*\\'" subject))) --- 1483,1489 ---- (message-check-element 'subject) (save-excursion (let* ((case-fold-search t) ! (subject (message-fetch-field "subject"))) (or (and subject (not (string-match "\\`[ \t]*\\'" subject))) *************** *** 1441,1447 **** (or (message-check-element 'from) (save-excursion (let* ((case-fold-search t) ! (from (mail-fetch-field "from"))) (cond ((not from) (message "There is no From line. Posting is denied.") --- 1495,1501 ---- (or (message-check-element 'from) (save-excursion (let* ((case-fold-search t) ! (from (message-fetch-field "from"))) (cond ((not from) (message "There is no From line. Posting is denied.") *************** *** 1554,1560 **** (insert-buffer-substring buf) (save-restriction (message-narrow-to-headers) ! (while (setq file (mail-fetch-field "fcc")) (push file list) (message-remove-header "fcc" nil t))) (goto-char (point-min)) --- 1608,1614 ---- (insert-buffer-substring buf) (save-restriction (message-narrow-to-headers) ! (while (setq file (message-fetch-field "fcc")) (push file list) (message-remove-header "fcc" nil t))) (goto-char (point-min)) *************** *** 1620,1626 **** (defun message-make-message-id () "Make a unique Message-ID." (concat "<" (message-unique-id) ! (let ((psubject (save-excursion (mail-fetch-field "subject")))) (if (and message-reply-headers (mail-header-references message-reply-headers) (mail-header-subject message-reply-headers) --- 1674,1680 ---- (defun message-make-message-id () "Make a unique Message-ID." (concat "<" (message-unique-id) ! (let ((psubject (save-excursion (message-fetch-field "subject")))) (if (and message-reply-headers (mail-header-references message-reply-headers) (mail-header-subject message-reply-headers) *************** *** 1862,1868 **** (Distribution (message-make-distribution)) (Lines (message-make-lines)) (X-Newsreader message-newsreader) ! (X-Mailer (and (not (mail-fetch-field "X-Newsreader")) message-mailer)) (Expires (message-make-expires)) (case-fold-search t) --- 1916,1922 ---- (Distribution (message-make-distribution)) (Lines (message-make-lines)) (X-Newsreader message-newsreader) ! (X-Mailer (and (not (message-fetch-field "X-Newsreader")) message-mailer)) (Expires (message-make-expires)) (case-fold-search t) *************** *** 1944,1951 **** (point) (match-end 0) '(message-deletable t face italic) (current-buffer))))))) ;; Insert new Sender if the From is strange. ! (let ((from (mail-fetch-field "from")) ! (sender (mail-fetch-field "sender")) (secure-sender (message-make-sender))) (when (and from (not (message-check-element 'sender)) --- 1998,2005 ---- (point) (match-end 0) '(message-deletable t face italic) (current-buffer))))))) ;; Insert new Sender if the From is strange. ! (let ((from (message-fetch-field "from")) ! (sender (message-fetch-field "sender")) (secure-sender (message-make-sender))) (when (and from (not (message-check-element 'sender)) *************** *** 1972,1978 **** (save-excursion (save-restriction (message-narrow-to-headers) ! (let ((newsgroups (mail-fetch-field "newsgroups"))) (when newsgroups (goto-char (point-max)) (insert "Posted-To: " newsgroups "\n")))) --- 2026,2032 ---- (save-excursion (save-restriction (message-narrow-to-headers) ! (let ((newsgroups (message-fetch-field "newsgroups"))) (when newsgroups (goto-char (point-max)) (insert "Posted-To: " newsgroups "\n")))) *************** *** 2150,2171 **** (setq follow-to (funcall message-wide-reply-to-function))))) ;; Find all relevant headers we need. ! (setq from (mail-fetch-field "from") ! date (mail-fetch-field "date") ! subject (or (mail-fetch-field "subject") "none") ! to (mail-fetch-field "to") ! cc (mail-fetch-field "cc") ! mct (mail-fetch-field "mail-copies-to") ! reply-to (unless ignore-reply-to (mail-fetch-field "reply-to")) ! references (mail-fetch-field "references") ! message-id (mail-fetch-field "message-id")) ;; Remove any (buggy) Re:'s that are present and make a ;; proper one. (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject) (setq subject (substring subject (match-end 0)))) (setq subject (concat "Re: " subject)) ! (when (and (setq gnus-warning (mail-fetch-field "gnus-warning")) (string-match "<[^>]+>" gnus-warning)) (setq message-id (match-string 0 gnus-warning))) --- 2204,2225 ---- (setq follow-to (funcall message-wide-reply-to-function))))) ;; Find all relevant headers we need. ! (setq from (message-fetch-field "from") ! date (message-fetch-field "date") ! subject (or (message-fetch-field "subject") "none") ! to (message-fetch-field "to") ! cc (message-fetch-field "cc") ! mct (message-fetch-field "mail-copies-to") ! reply-to (unless ignore-reply-to (message-fetch-field "reply-to")) ! references (message-fetch-field "references") ! message-id (message-fetch-field "message-id")) ;; Remove any (buggy) Re:'s that are present and make a ;; proper one. (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject) (setq subject (substring subject (match-end 0)))) (setq subject (concat "Re: " subject)) ! (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) (string-match "<[^>]+>" gnus-warning)) (setq message-id (match-string 0 gnus-warning))) *************** *** 2244,2260 **** (when (message-functionp message-followup-to-function) (setq follow-to (funcall message-followup-to-function))) ! (setq from (mail-fetch-field "from") ! date (mail-fetch-field "date") ! subject (or (mail-fetch-field "subject") "none") ! references (mail-fetch-field "references") ! message-id (mail-fetch-field "message-id") ! followup-to (mail-fetch-field "followup-to") ! newsgroups (mail-fetch-field "newsgroups") ! reply-to (mail-fetch-field "reply-to") ! distribution (mail-fetch-field "distribution") ! mct (mail-fetch-field "mail-copies-to")) ! (when (and (setq gnus-warning (mail-fetch-field "gnus-warning")) (string-match "<[^>]+>" gnus-warning)) (setq message-id (match-string 0 gnus-warning))) ;; Remove bogus distribution. --- 2298,2314 ---- (when (message-functionp message-followup-to-function) (setq follow-to (funcall message-followup-to-function))) ! (setq from (message-fetch-field "from") ! date (message-fetch-field "date") ! subject (or (message-fetch-field "subject") "none") ! references (message-fetch-field "references") ! message-id (message-fetch-field "message-id") ! followup-to (message-fetch-field "followup-to") ! newsgroups (message-fetch-field "newsgroups") ! reply-to (message-fetch-field "reply-to") ! distribution (message-fetch-field "distribution") ! mct (message-fetch-field "mail-copies-to")) ! (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) (string-match "<[^>]+>" gnus-warning)) (setq message-id (match-string 0 gnus-warning))) ;; Remove bogus distribution. *************** *** 2279,2292 **** (cond ((equal (downcase followup-to) "poster") (if (or (eq message-use-followup-to 'use) ! (y-or-n-p "Use Followup-To \"poster\"? ")) (cons 'To (or reply-to from "")) (cons 'Newsgroups newsgroups))) (t (if (or (equal followup-to newsgroups) (not (eq message-use-followup-to 'ask)) ! (y-or-n-p ! (format "Use Followup-To %s? " followup-to))) (cons 'Newsgroups followup-to) (cons 'Newsgroups newsgroups)))))) (t --- 2333,2366 ---- (cond ((equal (downcase followup-to) "poster") (if (or (eq message-use-followup-to 'use) ! (message-y-or-n-p "Obey Followup-To: poster? " t "\ ! You should normally obey the Followup-To: header. ! ! `Followup-To: poster' sends your response via e-mail instead of news. ! ! A typical situation where `Followup-To: poster' is used is when the poster ! does not read the newsgroup, so he wouldn't see any replies sent to it.")) (cons 'To (or reply-to from "")) (cons 'Newsgroups newsgroups))) (t (if (or (equal followup-to newsgroups) (not (eq message-use-followup-to 'ask)) ! (message-y-or-n-p ! (concat "Obey Followup-To: " followup-to "? ") t "\ ! You should normally obey the Followup-To: header. ! ! `Followup-To: " followup-to "' ! directs your response to " (if (string-match "," followup-to) ! "the specified newsgroups" ! "that newsgroup only") ". ! ! If a message is posted to several newsgroups, Followup-To is often ! used to direct the following discussion to one newsgroup only, ! because discussions that are spread over several newsgroup tend to ! be fragmented and very difficult to follow. ! ! Also, some source/announcment newsgroups are not indented for discussion; ! responses here are directed to other newsgroups.")) (cons 'Newsgroups followup-to) (cons 'Newsgroups newsgroups)))))) (t *************** *** 2318,2327 **** ;; Get header info. from original article. (save-restriction (message-narrow-to-head) ! (setq from (mail-fetch-field "from") ! newsgroups (mail-fetch-field "newsgroups") ! message-id (mail-fetch-field "message-id") ! distribution (mail-fetch-field "distribution"))) ;; Make sure that this article was written by the user. (unless (string-equal (downcase (mail-strip-quoted-names from)) --- 2392,2401 ---- ;; Get header info. from original article. (save-restriction (message-narrow-to-head) ! (setq from (message-fetch-field "from") ! newsgroups (message-fetch-field "newsgroups") ! message-id (message-fetch-field "message-id") ! distribution (message-fetch-field "distribution"))) ;; Make sure that this article was written by the user. (unless (string-equal (downcase (mail-strip-quoted-names from)) *************** *** 2355,2361 **** (let ((cur (current-buffer))) ;; Check whether the user owns the article that is to be superseded. (unless (string-equal ! (downcase (mail-strip-quoted-names (mail-fetch-field "from"))) (downcase (mail-strip-quoted-names (message-make-address)))) (error "This article is not yours")) ;; Get a normal message buffer. --- 2429,2435 ---- (let ((cur (current-buffer))) ;; Check whether the user owns the article that is to be superseded. (unless (string-equal ! (downcase (mail-strip-quoted-names (message-fetch-field "from"))) (downcase (mail-strip-quoted-names (message-make-address)))) (error "This article is not yours")) ;; Get a normal message buffer. *************** *** 2396,2403 **** (defun message-make-forward-subject () "Return a Subject header suitable for the message in the current buffer." ! (concat "[" (mail-fetch-field (if (message-news-p) "newsgroups" "from")) ! "] " (or (mail-fetch-field "Subject") ""))) ;;;###autoload (defun message-forward (&optional news) --- 2470,2478 ---- (defun message-make-forward-subject () "Return a Subject header suitable for the message in the current buffer." ! (concat "[" (or (message-fetch-field (if (message-news-p) "newsgroups" "from")) ! "(nowhere)") ! "] " (or (message-fetch-field "Subject") ""))) ;;;###autoload (defun message-forward (&optional news) *************** *** 2469,2475 **** (beginning-of-line) (insert "Also-")) ;; Send it. ! (funcall message-send-mail-function) (kill-buffer (current-buffer))))) ;;;###autoload --- 2544,2550 ---- (beginning-of-line) (insert "Also-")) ;; Send it. ! (message-send-mail) (kill-buffer (current-buffer))))) ;;;###autoload *************** *** 2485,2492 **** (insert-buffer-substring cur) (undo-boundary) (message-narrow-to-head) ! (if (and (mail-fetch-field "Mime-Version") ! (setq boundary (mail-fetch-field "Content-Type"))) (if (string-match "boundary=\"\\([^\"]+\\)\"" boundary) (setq boundary (concat (match-string 1 boundary) " *\n" "Content-Type: message/rfc822")) --- 2560,2567 ---- (insert-buffer-substring cur) (undo-boundary) (message-narrow-to-head) ! (if (and (message-fetch-field "Mime-Version") ! (setq boundary (message-fetch-field "Content-Type"))) (if (string-match "boundary=\"\\([^\"]+\\)\"" boundary) (setq boundary (concat (match-string 1 boundary) " *\n" "Content-Type: message/rfc822")) *************** *** 2605,2610 **** --- 2680,2761 ---- ;; Support for toolbar (when (string-match "XEmacs\\|Lucid" emacs-version) (require 'message-xmas)) + + ;;; Group name completion. + + (defvar message-newgroups-header-regexp + "^\\(Newsgroups\\|Followup-To\\|Posted-To\\):" + "Regexp that match headers that lists groups.") + + (defun message-tab () + "Expand group names in Newsgroups and Followup-To headers. + Do a `tab-to-tab-stop' if not in those headers." + (interactive) + (if (let ((mail-abbrev-mode-regexp message-newgroups-header-regexp)) + (mail-abbrev-in-expansion-header-p)) + (message-expand-group) + (tab-to-tab-stop))) + + (defvar gnus-active-hashtb) + (defun message-expand-group () + (let* ((b (save-excursion (skip-chars-backward "^, :\t\n") (point))) + (completion-ignore-case t) + (string (buffer-substring b (point))) + (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb)) + (completions (all-completions string hashtb)) + (cur (current-buffer)) + comp) + (delete-region b (point)) + (cond + ((= (length completions) 1) + (if (string= (car completions) string) + (progn + (insert string) + (message "Only matching group")) + (insert (car completions)))) + ((and (setq comp (try-completion string hashtb)) + (not (string= comp string))) + (insert comp)) + (t + (insert string) + (if (not comp) + (message "No matching groups") + (pop-to-buffer "*Completions*") + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (let ((standard-output (current-buffer))) + (display-completion-list (sort completions 'string<))) + (goto-char (point-min)) + (pop-to-buffer cur)))))) + + ;;; Help stuff. + + (defmacro message-y-or-n-p (question show &rest text) + "Ask QUESTION, displaying the rest of the arguments in a temporary buffer." + `(message-talkative-question 'y-or-n-p ,question ,show ,@text)) + + (defun message-talkative-question (ask question show &rest text) + "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW. + The following arguments may contain lists of values." + (if (and show + (setq text (message-flatten-list text))) + (save-window-excursion + (save-excursion + (with-output-to-temp-buffer " *MESSAGE information message*" + (set-buffer " *MESSAGE information message*") + (mapcar 'princ text) + (goto-char (point-min)))) + (funcall ask question)) + (funcall ask question))) + + (defun message-flatten-list (&rest list) + (message-flatten-list-1 list)) + + (defun message-flatten-list-1 (list) + (cond ((consp list) + (apply 'append (mapcar 'message-flatten-list-1 list))) + (list + (list list)))) (provide 'message) *** pub/sgnus/lisp/nnfolder.el Sun May 19 12:20:01 1996 --- sgnus/lisp/nnfolder.el Tue May 21 19:28:28 1996 *************** *** 40,50 **** (nnoo-declare nnfolder) ! (defvoo nnfolder-directory (expand-file-name "~/Mail/") "The name of the nnfolder directory.") (defvoo nnfolder-active-file ! (concat (file-name-as-directory nnfolder-directory) "active") "The name of the active file.") ;; I renamed this variable to something more in keeping with the general GNU --- 40,50 ---- (nnoo-declare nnfolder) ! (defvoo nnfolder-directory (expand-file-name message-directory) "The name of the nnfolder directory.") (defvoo nnfolder-active-file ! (nnheader-concat nnfolder-directory "active") "The name of the active file.") ;; I renamed this variable to something more in keeping with the general GNU *************** *** 560,565 **** --- 560,568 ---- (obuf (current-buffer))) (set-buffer nnfolder-current-buffer) (goto-char (point-max)) + (unless (eolp) + (insert "\n")) + (insert "\n") (insert-buffer-substring obuf beg end) (set-buffer obuf))) *** pub/sgnus/lisp/nnheader.el Sun May 19 12:20:02 1996 --- sgnus/lisp/nnheader.el Tue May 21 19:28:31 1996 *************** *** 540,547 **** (or (and (symbolp form) (fboundp form)) (and (listp form) (eq (car form) 'lambda)))) (fset 'nnheader-find-file-noselect 'find-file-noselect) ! (fset 'nnheader-insert-raw-file-contents 'insert-file-contents) (provide 'nnheader) --- 540,551 ---- (or (and (symbolp form) (fboundp form)) (and (listp form) (eq (car form) 'lambda)))) + (defun nnheader-concat (dir file) + "Concat DIR as directory to FILE." + (concat (file-name-as-directory dir) file)) + (fset 'nnheader-find-file-noselect 'find-file-noselect) ! (fset 'nnheader-insert-raw-file-contents 'insert-file-contents-literally) (provide 'nnheader) *** pub/sgnus/lisp/nnkiboze.el Sun May 19 12:20:02 1996 --- sgnus/lisp/nnkiboze.el Tue May 21 19:37:45 1996 *************** *** 37,45 **** (eval-when-compile (require 'cl)) (nnoo-declare nnkiboze) ! ! (defvoo nnkiboze-directory ! (expand-file-name (or gnus-article-save-directory "~/News/")) "nnkiboze will put its files in this directory.") (defvoo nnkiboze-level 9 --- 37,43 ---- (eval-when-compile (require 'cl)) (nnoo-declare nnkiboze) ! (defvoo nnkiboze-directory gnus-directory "nnkiboze will put its files in this directory.") (defvoo nnkiboze-level 9 *** pub/sgnus/lisp/nnmail.el Sun May 19 12:20:02 1996 --- sgnus/lisp/nnmail.el Tue May 21 19:28:30 1996 *************** *** 746,752 **** (mapcar (lambda (group) (cons group (funcall func group))) (condition-case nil ! (funcall nnmail-split-methods) (error (message "Error in `nnmail-split-methods'; using `bogus' mail group") --- 746,753 ---- (mapcar (lambda (group) (cons group (funcall func group))) (condition-case nil ! (or (funcall nnmail-split-methods) ! '("bogus")) (error (message "Error in `nnmail-split-methods'; using `bogus' mail group") *************** *** 791,796 **** --- 792,798 ---- (save-excursion (when (re-search-backward "^Lines: " nil t) (delete-region (point) (progn (forward-line 1) (point))))) + (beginning-of-line) (insert (format "Lines: %d\n" (max lines 0))) chars)))) *** pub/sgnus/lisp/nnmh.el Sun May 19 12:20:02 1996 --- sgnus/lisp/nnmh.el Tue May 21 19:28:28 1996 *************** *** 38,44 **** (nnoo-declare nnmh) ! (defvoo nnmh-directory "~/Mail/" "*Mail spool directory.") (defvoo nnmh-get-new-mail t --- 38,44 ---- (nnoo-declare nnmh) ! (defvoo nnmh-directory message-directory "*Mail spool directory.") (defvoo nnmh-get-new-mail t *** pub/sgnus/lisp/nnml.el Sun May 19 12:20:02 1996 --- sgnus/lisp/nnml.el Tue May 21 19:28:27 1996 *************** *** 37,43 **** (nnoo-declare nnml) ! (defvoo nnml-directory "~/Mail/" "Mail spool directory.") (defvoo nnml-active-file --- 37,43 ---- (nnoo-declare nnml) ! (defvoo nnml-directory message-directory "Mail spool directory.") (defvoo nnml-active-file *************** *** 195,200 **** --- 195,202 ---- (cond ((not (nnml-possibly-change-directory group server)) (nnheader-report 'nnml "Invalid group (no such directory)")) + ((not (file-directory-p nnml-current-directory)) + (nnheader-report 'nnml "%s is not a directory" nnml-current-directory)) (dont-check (nnheader-report 'nnml "Group %s selected" group) t) *** pub/sgnus/lisp/nnsoup.el Sun May 19 12:20:02 1996 --- sgnus/lisp/nnsoup.el Tue May 21 17:06:26 1996 *************** *** 261,266 **** --- 261,268 ---- (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) + (unless nnsoup-group-alist + (nnsoup-read-active-file)) (let ((alist nnsoup-group-alist) (standard-output (current-buffer)) entry) *************** *** 342,348 **** t)) (defun nnsoup-read-active-file () ! (setq nnsoup-group-alist) (when (file-exists-p nnsoup-active-file) (condition-case () (load nnsoup-active-file t t t) --- 344,350 ---- t)) (defun nnsoup-read-active-file () ! (setq nnsoup-group-alist nil) (when (file-exists-p nnsoup-active-file) (condition-case () (load nnsoup-active-file t t t) *** pub/sgnus/lisp/nntp.el Sun May 19 12:20:02 1996 --- sgnus/lisp/nntp.el Tue May 21 17:06:26 1996 *************** *** 1184,1199 **** (defun nntp-open-rlogin (server) (let ((proc (if nntp-rlogin-user-name ! (start-process "nntpd" nntp-server-buffer "rsh" ! "-l" ! nntp-rlogin-user-name ! server ! (mapconcat 'identity ! nntp-rlogin-parameters " ")) ! (start-process "nntpd" nntp-server-buffer "rsh" ! server ! (mapconcat 'identity ! nntp-rlogin-parameters " "))))) proc)) (defun nntp-telnet-to-machine () --- 1184,1198 ---- (defun nntp-open-rlogin (server) (let ((proc (if nntp-rlogin-user-name ! (start-process ! "nntpd" nntp-server-buffer "rsh" ! "-l" nntp-rlogin-user-name server ! (mapconcat 'identity ! nntp-rlogin-parameters " ")) ! (start-process ! "nntpd" nntp-server-buffer "rsh" server ! (mapconcat 'identity ! nntp-rlogin-parameters " "))))) proc)) (defun nntp-telnet-to-machine () *** pub/sgnus/lisp/ChangeLog Sun May 19 12:20:09 1996 --- sgnus/lisp/ChangeLog Tue May 21 23:27:40 1996 *************** *** 1,4 **** --- 1,138 ---- + Tue May 21 20:08:33 1996 Lars Magne Ingebrigtsen + + * 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 + + * 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 + + * gnus-setup.el: Copyright assigned to FSF. + + Tue May 21 17:09:27 1996 Lars Magne Ingebrigtsen + + * 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 + + * 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 + + * message.el (message-rename-buffer): New command and keystroke. + + Mon May 20 10:15:12 1996 Lars Magne Ingebrigtsen + + * 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 + + * nnmail.el (nnmail-article-group): Do not split into empty list + of groups. + + Mon May 20 09:42:15 1996 Lars Magne Ingebrigtsen + + * 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 + + * 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 + + * 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 + + * 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 + + * gnus.el: September Gnus v0.89 is released. * gnus.el (gnus-group-set-mode-line): Make sure we're in the group buffer. *** pub/sgnus/texi/Makefile Sun May 19 12:20:11 1996 --- sgnus/texi/Makefile Tue May 21 17:06:28 1996 *************** *** 1,17 **** TEXI2DVI=texi2dvi EMACS=emacs ! MAKEINFO=$(EMACS) -batch -q -no-site-file gnus.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer # MAKEINFO=makeinfo -o gnus.info gnus.texi LATEX=latex DVIPS=dvips PERL=perl ! all: gnus.info refcard.dvi most: texi2latexi.elc latex latexps gnus.info: gnus.texi ! $(MAKEINFO) dvi: gnus.texi $(PERL) -n -e 'if (/\@iflatex/) { $$latex=1; } if (!$$latex) { print; } if (/\@end iflatex/) { $$latex=0; }' gnus.texi > gnus.tmptexi --- 1,21 ---- TEXI2DVI=texi2dvi EMACS=emacs ! MAKEINFO=$(EMACS) -batch -q -no-site-file ! INFOSWI=-l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer # MAKEINFO=makeinfo -o gnus.info gnus.texi LATEX=latex DVIPS=dvips PERL=perl ! all: gnus.info message.info refcard.dvi most: texi2latexi.elc latex latexps gnus.info: gnus.texi ! $(MAKEINFO) gnus.texi $(INFOSWI) ! ! message.info: message.texi ! $(MAKEINFO) message.texi $(INFOSWI) dvi: gnus.texi $(PERL) -n -e 'if (/\@iflatex/) { $$latex=1; } if (!$$latex) { print; } if (/\@end iflatex/) { $$latex=0; }' gnus.texi > gnus.tmptexi *** pub/sgnus/texi/gnus.texi Sun May 19 12:20:11 1996 --- sgnus/texi/gnus.texi Tue May 21 20:44:15 1996 *************** *** 182,188 **** \thispagestyle{empty} ! Copyright \copyright{} 1995 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice --- 182,188 ---- \thispagestyle{empty} ! Copyright \copyright{} 1995,96 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice *************** *** 205,211 **** This file documents Gnus, the GNU Emacs newsreader. ! Copyright (C) 1995 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice --- 205,211 ---- This file documents Gnus, the GNU Emacs newsreader. ! Copyright (C) 1995,96 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice *************** *** 236,242 **** @page @vskip 0pt plus 1filll ! Copyright @copyright{} 1995 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice --- 236,242 ---- @page @vskip 0pt plus 1filll ! Copyright @copyright{} 1995,96 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice *************** *** 300,306 **** * The Group Buffer:: Selecting, subscribing and killing groups. * The Summary Buffer:: Reading, saving and posting articles. * The Article Buffer:: Displaying and handling articles. - * Message:: Message sending interface. * Composing Messages:: Information on sending mail and news. * Select Methods:: Gnus reads all messages from various select methods. * Scoring:: Assigning values to articles. --- 300,305 ---- *************** *** 2098,2108 **** @subsection Topic Variables @cindex topic variables - @vindex gnus-topic-unique - If @code{gnus-topic-unique} is non-@code{nil}, each group will be member - of (tops) one topic each. If this is @code{nil}, each group might end - up being a member of several topics. - Now, if you select a topic, if will fold/unfold that topic, which is really neat, I think. --- 2097,2102 ---- *************** *** 6396,7240 **** This is the delimiter mentioned above. By default, it is @samp{^L} (form linefeed). @end table - - - @node Message - @chapter Message - @cindex reply - @cindex followup - @cindex post - - All message composition (both mail and news) takes place in - @code{message} mode buffers. - - @menu - * Message Interface:: Setting up message buffers. - * Message Commands:: Commands you can execute in message mode buffers. - * Message Variables:: Customizing the message buffers. - @end menu - - - @node Message Interface - @section Message Interface - - When a program (or a person) wants to respond to a message -- reply, - follow up, forward, cancel -- the program (or person) should just put - point in the buffer where the message is and call the required command. - @code{Message} will then pop up a new @code{message} mode buffer with - appropriate headers filled out, and the user can edit the message before - sending it. - - @menu - * New Mail Message:: Editing a brand new mail message. - * New News Message:: Editing a brand new news message. - * Reply:: Replying via mail. - * Wide Reply:: Responding to all people via mail. - * Followup:: Following up via news. - * Canceling News:: Canceling a news article. - * Superseding:: Superseding a message. - * Forwarding:: Forwarding a message via news or mail. - * Resending:: Resending a mail message. - * Bouncing:: Bouncing a mail message. - @end menu - - - @node New Mail Message - @subsection New Mail Message - - @findex message-mail - The @code{message-mail} command pops up a new message buffer. - - Two optional parameters are accepted: The first will be used as the - @code{To} header and the second as the @code{Subject} header. If these - aren't present, those two headers will be empty. - - - @node New News Message - @subsection New News Message - - @findex message-news - The @code{message-news} command pops up a new message buffer. - - This function accepts two optional parameters. The first will be used - as the @code{Newsgroups} header and the second as the @code{Subject} - header. If these aren't present, those two headers will be empty. - - - @node Reply - @subsection Reply - - @findex message-reply - The @code{message-reply} function pops up a message buffer that's a - reply to the message in the current buffer. - - @vindex message-reply-to-function - Message uses the normal methods to determine where replies are to go, - but you can change the behavior to suit your needs by fiddling with the - @code{message-reply-to-function} variable. - - If you want the replies to go to the @code{Sender} instead of the - @code{From}, you could do something like this: - - @lisp - (setq message-reply-to-function - (lambda () - (cond ((equal (mail-fetch-field "from") "somebody") - (mail-fetch-field "sender")) - (t - nil)))) - @end lisp - - This function will be called narrowed to the head of the article that is - being replied to. - - As you can see, this function should return a string if it has an - opinion as to what the To header should be. If it does not, it should - just return @code{nil}, and the normal methods for determining the To - header will be used. - - This function can also return a list. In that case, each list element - should be a cons, where the car should be the name of an header - (eg. @code{Cc}) and the cdr should be the header value - (eg. @samp{larsi@@ifi.uio.no}). All these headers will be inserted into - the head of the outgoing mail. - - - @node Wide Reply - @subsection Wide Reply - - @findex message-wide-reply - The @code{message-wide-reply} pops up a message buffer that's a wide - reply to the message in the current buffer. - - @vindex message-wide-reply-to-function - Message uses the normal methods to determine where wide replies are to go, - but you can change the behavior to suit your needs by fiddling with the - @code{message-wide-reply-to-function}. It is used in the same way as - @code{message-reply-to-function} (@pxref{Reply}). - - - @node Followup - @subsection Followup - - @findex message-followup - The @code{message-followup} command pops up a message buffer that's a - followup to the message in the current buffer. - - @vindex message-followup-to-function - Message uses the normal methods to determine where followups are to go, - but you can change the behavior to suit your needs by fiddling with the - @code{message-followup-to-function}. It is used in the same way as - @code{message-reply-to-function} (@pxref{Reply}). - - @vindex message-use-followup-to - The @code{message-use-followup-to} variable says what to do about - @code{Followup-To} headers. If it is @code{use}, always use the value. - If it is @code{ask} (which is the default), ask whether to use the - value. If it is @code{t}, use the value unless it is @samp{poster}. If - it is @code{nil}, don't use the value. - - - @node Canceling News - @subsection Canceling News - - @findex message-cancel-news - The @code{message-cancel-news} command cancels the article in the - current buffer. - - - @node Superseding - @subsection Superseding - - @findex message-supersede - The @code{message-supersede} command pops up a message buffer that will - supersede the message in the current buffer. - - @vindex message-ignored-supersedes-headers - Headers matching the @code{message-ignored-supersedes-headers} are - removed before popping up the new message buffer. The default is - @samp{^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|Return-Path:}. - - - - @node Forwarding - @subsection Forwarding - - @findex message-forward - The @code{message-forward} command pops up a message buffer to forward - the message in the current buffer. If given a prefix, forward using - news. - - @table @code - @item message-forward-start-separator - @vindex message-forward-start-separator - Delimiter inserted before forwarded messages. The default is - @samp{------- Start of forwarded message -------\n}. - - @vindex message-forward-end-separator - @item message-forward-end-separator - @vindex message-forward-end-separator - Delimiter inserted after forwarded messages. The default is - @samp{------- End of forwarded message -------\n}. - - @item message-signature-before-forwarded-message - @vindex message-signature-before-forwarded-message - If this variable is @code{t}, which it is by default, your personal - signature will be inserted before the forwarded message. If not, the - forwarded message will be inserted first in the new mail. - - @item message-forward-included-headers - @vindex message-forward-included-headers - Regexp matching header lines to be included in forwarded messages. - - @end table - - - @node Resending - @subsection Resending - - @findex message-resend - The @code{message-resend} command will prompt the user for an address - and resend the message in the current buffer to that address. - - @vindex message-ignored-resent-headers - Headers the match the @code{message-ignored-resent-headers} regexp will - be removed before sending the message. The default is - @samp{^Return-receipt}. - - - @node Bouncing - @subsection Bouncing - - @findex message-bounce - The @code{message-bounce} command will, if the current buffer contains a - bounced mail message, pop up a message buffer stripped of the bounce - information. - - @vindex message-ignored-bounced-headers - Headers that match the @code{message-ignored-bounced-headers} regexp - will be removed before popping up the buffer. The default is - @samp{^Received:}. - - - @node Message Commands - @section Message Commands - - @menu - * Message Header Commands:: Commands for moving to headers. - * Message Movement:: Moving around in message buffers. - * Message Insertion:: Inserting things into message buffers. - * Various Message:: Various things. - * Sending Messages:: Actually sending the message. - @end menu - - - @node Message Header Commands - @subsection Message Header Commands - - All these commands move to the header in question. If it doesn't exist, - it will be inserted. - - @table @kbd - - @item C-c ? - @kindex C-c ? (Message) - @findex message-goto-to - Describe the message mode. - - @item C-c C-f C-t - @kindex C-c C-f C-t (Message) - @findex message-goto-to - Go to the @code{To} header (@code{message-goto-to}). - - @item C-c C-f C-b - @kindex C-c C-f C-b (Message) - @findex message-goto-bcc - Go to the @code{Bcc} header (@code{message-goto-bcc}). - - @item C-c C-f C-f - @kindex C-c C-f C-f (Message) - @findex message-goto-fcc - Go to the @code{Fcc} header (@code{message-goto-fcc}). - - @item C-c C-f C-c - @kindex C-c C-f C-c (Message) - @findex message-goto-cc - Go to the @code{Cc} header (@code{message-goto-cc}). - - @item C-c C-f C-s - @kindex C-c C-f C-s (Message) - @findex message-goto-subject - Go to the @code{Subject} header (@code{message-goto-subject}). - - @item C-c C-f C-r - @kindex C-c C-f C-r (Message) - @findex message-goto-reply-to - Go to the @code{Reply-To} header (@code{message-goto-reply-to}). - - @item C-c C-f C-n - @kindex C-c C-f C-n (Message) - @findex message-goto-newsgroups - Go to the @code{Newsgroups} header (@code{message-goto-newsgroups}). - - @item C-c C-f C-d - @kindex C-c C-f C-d (Message) - @findex message-goto-distribution - Go to the @code{Distribution} header (@code{message-goto-distribution}). - - @item C-c C-f C-o - @kindex C-c C-f C-o (Message) - @findex message-goto-followup-to - Go to the @code{Followup-To} header (@code{message-goto-followup-to}). - - @item C-c C-f C-k - @kindex C-c C-f C-k (Message) - @findex message-goto-keywords - Go to the @code{Keywords} header (@code{message-goto-keywords}). - - @item C-c C-f C-u - @kindex C-c C-f C-u (Message) - @findex message-goto-summary - Go to the @code{Summary} header (@code{message-goto-summary}). - - @end table - - - @node Message Movement - @subsection Message Movement - - @table @kbd - @item C-c C-b - @kindex C-c C-b (Message) - @findex message-goto-body - Move to the beginning of the body of the message - (@code{message-goto-body}). - - @item C-c C-i - @kindex C-c C-i (Message) - @findex message-goto-signature - Move to the signature of the message (@code{message-goto-signature}). - - @end table - - - @node Message Insertion - @subsection Message Insertion - - @table @kbd - - @item C-c C-y - @kindex C-c C-y (Message) - @findex message-yank-original - Yank the message that's being replied to into the message buffer - (@code{message-yank-original}). - - @item C-c C-q - @kindex C-c C-q (Message) - @findex message-fill-yanked-message - Fill the yanked message (@code{message-fill-yanked-message}). - - @item C-c C-w - @kindex C-c C-w (Message) - @findex message-insert-signature - Insert a signature at the end of the buffer - (@code{message-insert-signature}). - - @end table - - @table @code - @item message-ignored-cited-headers - @vindex message-ignored-cited-headers - All headers that match this regexp will be removed from yanked - messages. The default is @samp{.}, which means that all headers will be - removed. - - @item message-citation-line-function - @vindex message-citation-line-function - Function called to insert the citation line. The default is - @code{message-insert-citation-line}. - - @item message-yank-prefix - @vindex message-yank-prefix - @cindex yanking - @cindex quoting - When you are replying to or following up an article, you normally want - to quote the person you are answering. Inserting quoted text is done by - @dfn{yanking}, and each quoted line you yank will have - @code{message-yank-prefix} prepended to it. The default is @samp{> }. - If it is @code{nil}, just indent the message. - - @item message-indentation-spaces - @vindex message-indentation-spaces - Number of spaces to indent yanked messages. - - @item message-cite-function - @vindex message-cite-function - Function for citing an original message. The default is - @code{message-cite-original}. - - @item message-indent-citation-function - @vindex message-indent-citation-function - Function for modifying a citation just inserted in the mail buffer. - This can also be a list of functions. Each function can find the - citation between @code{(point)} and @code{(mark t)}. And each function - should leave point and mark around the citation text as modified. - - @item message-signature - @vindex message-signature - String to be inserted at the end of the message buffer. If @code{t} - (which is the default), the @code{message-signature-file} file will be - inserted instead. If a function, the result from the function will be - used instead. If a form, the result from the form will be used instead. - If this variable is @code{nil}, no signature will be inserted at all. - - @item message-signature-file - @vindex message-signature-file - File containing the signature to be inserted at the end of the buffer. - The default is @samp{~/.signature}. - - @end table - - Note that RFC1036 says that a signature should be preceded by the three - characters @samp{-- } on a line by themselves. This is to make it - easier for the recipient to automatically recognize and process the - signature. So don't remove those characters, even though you might feel - that they ruin you beautiful design, like, totally. - - Also note that no signature should be more than four lines long. - Including ASCII graphics is an efficient way to get everybody to believe - that you are silly and have nothing important to say. - - - - @node Various Message - @subsection Various Message - - @table @kbd - - @item C-c C-r - @kindex C-c C-r (Message) - @findex message-caesar-buffer-body - Caesar rotate (aka. rot13) the current message - (@code{message-caesar-buffer-body}). If narrowing is in effect, just - rotate the visible portion of the buffer. A numerical prefix says how - many places to rotate the text. The default is 13. - - @item C-c C-t - @kindex C-c C-t (Message) - @findex message-insert-to - Insert a @code{To} header that contains the @code{Reply-To} or - @code{From} header of the message you're following up - (@code{message-insert-to}). - - @item C-c C-n - @kindex C-c C-n (Message) - @findex message-insert-newsgroups - Insert a @code{Newsgroups} header that reflects the @code{Followup-To} - or @code{Newsgroups} header of the article you're replying to - (@code{message-insert-newsgroups}). - - @end table - - - @node Sending Messages - @subsection Sending Messages - - @table @kbd - @item C-c C-c - @kindex C-c C-c (Message) - @findex message-send-and-exit - Send the message and bury the current buffer - (@code{message-send-and-exit}). - - @item C-c C-s - @kindex C-c C-s (Message) - @findex message-send - Send the message (@code{message-send}). - - @end table - - - @node Message Variables - @section Message Variables - - @menu - * Message Headers:: General message header stuff. - * Mail Headers:: Customizing mail headers. - * Mail Variables:: Other mail variables. - * News Headers:: Customizing news headers. - * News Variables:: Other news variables. - * Various Message Variables:: Other message variables. - * Sending Variables:: Variables for sending. - * Message Actions:: Actions to be performed when exiting. - @end menu - - - @node Message Headers - @subsection Message Headers - - Message is a quite aggressive on the message generation front. It has - to be -- it's a combined news and mail agent. To be able to send - combined messages, it has to generate all headers itself to ensure that - mail and news copies of messages look sufficiently similar. - - @table @code - - @item message-generate-headers-first - @vindex message-generate-headers-first - If non-@code{nil}, generate all headers before starting to compose the - message. - - @item message-from-style - @vindex message-from-style - Specifies how @code{From} headers should look. There are four legal - values: - - @table @code - @item nil - Just the address -- @samp{king@@grassland.com}. - - @item parens - @samp{king@@grassland.com (Elvis Parsley)}. - - @item angles - @samp{Elvis Parsley }. - - @item default - Look like @code{angles} if that doesn't require quoting, and - @code{parens} if it does. If even @code{parens} requires quoting, use - @code{angles} anyway. - - @end table - - @item message-deletable-headers - @vindex message-deletable-headers - Headers in this list that were previously generated by Gnus will be - deleted before posting. Let's say you post an article. Then you decide - to post it again to some other group, you naughty boy, so you jump back - to the @code{*post-buf*} buffer, edit the @code{Newsgroups} line, and - ship it off again. By default, this variable makes sure that the old - generated @code{Message-ID} is deleted, and a new one generated. If - this isn't done, the entire empire would probably crumble, anarchy would - prevail, and cats would start walking on two legs and rule the world. - Allegedly. - - @item message-default-headers - @vindex message-default-headers - This string is inserted at the end of the headers in all message - buffers. - - @end table - - - @node Mail Headers - @subsection Mail Headers - - @table @code - @item message-required-mail-headers - @vindex message-required-mail-headers - See @pxref{News Headers} for the syntax of this variable. It is - @code{(From Date Subject (optional . In-Reply-To) Message-ID Lines - (optional . X-Mailer))} by default. - - @item message-ignored-mail-headers - @vindex message-ignored-mail-headers - Regexp of headers to be removed before mailing. The default is - @samp{^Gcc:\\|^Fcc:}. - - @item message-default-mail-headers - @vindex message-default-mail-headers - This string is inserted at the end of the headers in all message - buffers that are initialized as mail. - - @end table - - - @node Mail Variables - @subsection Mail Variables - - @table @code - @item message-send-mail-function - @vindex message-send-mail-function - Function used to send the current buffer as mail. The default is - @code{message-send-mail}. - - @end table - - - @node News Headers - @subsection News Headers - - @vindex message-required-news-headers - @code{message-required-news-headers} a list of header symbols. These - headers will either be automatically generated, or, if that's - impossible, they will be prompted for. The following symbols are legal: - - @table @code - - @item From - @cindex From - This required header will be filled out with the result of the - @code{message-make-from} function, which depends on the - @code{message-from-style}, @code{user-full-name}, - @code{user-mail-address} variables. - - @item Subject - @cindex Subject - This required header will be prompted for if not present already. - - @item Newsgroups - @cindex Newsgroups - This required header says which newsgroups the article is to be posted - to. If it isn't present already, it will be prompted for. - - @item Organization - @cindex organization - This optional header will be filled out depending on the - @code{message-user-organization} variable. - @code{message-user-organization-file} will be used if that variable is - @code{t}. - - @item Lines - @cindex Lines - This optional header will be computed by Gnus. - - @item Message-ID - @cindex Message-ID - This required header will be generated by Gnus. A unique ID will be - created based on date, time, user name and system name. - - @item X-Newsreader - @cindex X-Newsreader - This optional header will be filled out according to the - @code{message-newsreader} local variable. - - @item X-Mailer - This optional header will be filled out according to the - @code{message-mailer} local variable, unless there already is an - @code{X-Newsreader} header present. - - @item In-Reply-To - This optional header is filled out using the @code{Date} and @code{From} - header of the article being replied. - - @item Expires - @cindex Expires - This extremely optional header will be inserted according to the - @code{message-expires} variable. It is highly deprecated and shouldn't - be used unless you know what you're doing. - - @item Distribution - @cindex Distribution - This optional header is filled out according to the - @code{message-distribution-function} variable. It is a deprecated and - much misunderstood header. - - @item Path - @cindex path - This extremely optional header should probably not ever be used. - However, some @emph{very} old servers require that this header is - present. @code{message-user-path} further controls how this - @code{Path} header is to look. If is is @code{nil}, the the server name - as the leaf node. If is is a string, use the string. If it is neither - a string nor @code{nil}, use the user name only. However, it is highly - unlikely that you should need to fiddle with this variable at all. - @end table - - @findex yow - @cindex Mime-Version - In addition, you can enter conses into this list. The car of this cons - should be a symbol. This symbol's name is the name of the header, and - the cdr can either be a string to be entered verbatim as the value of - this header, or it can be a function to be called. This function should - return a string to be inserted. For instance, if you want to insert - @code{Mime-Version: 1.0}, you should enter @code{(Mime-Version . "1.0")} - into the list. If you want to insert a funny quote, you could enter - something like @code{(X-Yow . yow)} into the list. The function - @code{yow} will then be called without any arguments. - - If the list contains a cons where the car of the cons is - @code{optional}, the cdr of this cons will only be inserted if it is - non-@code{nil}. - - Other variables for customizing outgoing news articles: - - @table @code - - @item message-syntax-checks - @vindex message-syntax-checks - If non-@code{nil}, message will attempt to check the legality of the - headers, as well as some other stuff, before posting. You can control - the granularity of the check by adding or removing elements from this - list. Legal elements are: - - @table @code - @item subject-cmsg - Check the subject for commands. - @item sender - @cindex Sender - Insert a new @code{Sender} header if the @code{From} header looks odd. - @item multiple-headers - Check for the existence of multiple equal headers. - @item sendsys - @cindex sendsys - Check for the existence of version and sendsys commands. - @item message-id - Check whether the @code{Message-ID} looks ok. - @item from - Check whether the @code{From} header seems nice. - @item long-lines - @cindex long lines - Check for too long lines. - @item control-chars - Check for illegal characters. - @item size - Check for excessive size. - @item new-text - Check whether there is any new text in the messages. - @item signature - Check the length of the signature. - @item approved - @cindex approved - Check whether the article has an @code{Approved} header, which is - something only moderators should include. - @item empty - Check whether the article is empty. - @item empty-headers - Check whether any of the headers are empty. - @end table - - All these conditions are checked by default. - - @item message-ignored-news-headers - @vindex message-ignored-news-headers - Regexp of headers to be removed before posting. The default is - @samp{^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:}. - - @item message-default-news-headers - @vindex message-default-news-headers - This string is inserted at the end of the headers in all message - buffers that are initialized as news. - - @end table - - - @node News Variables - @subsection News Variables - - @table @code - @item message-send-news-function - @vindex message-send-news-function - Function used to send the current buffer as news. The default is - @code{message-send-news}. - - @item message-post-method - @vindex message-post-method - Method used for posting a prepared news message. - - @end table - - - @node Various Message Variables - @subsection Various Message Variables - - @table @code - @item message-signature-separator - @vindex message-signature-separator - Regexp matching the signature separator. It is @samp{^-- *$} by - default. - - @item mail-header-separator - @vindex mail-header-separator - String used to separate the headers from the body. It is @samp{--text - follows this line--} by default. - - @item message-autosave-directory - @vindex message-autosave-directory - Directory where message buffers will be autosaved to. - - @item message-setup-hook - @vindex message-setup-hook - Hook run when the message buffer has been initialized. - - @item message-header-setup-hook - @vindex message-header-setup-hook - Hook called narrowed to the headers after initializing the headers. - - @item message-send-hook - @vindex message-send-hook - Hook run before sending messages. - - @item message-sent-hook - @vindex message-sent-hook - Hook run after sending messages. - - @item message-mode-syntax-table - @vindex message-mode-syntax-table - Syntax table used in message mode buffers. - - @end table - - - - @node Sending Variables - @subsection Sending Variables - - @table @code - - @item message-fcc-handler-function - @vindex message-fcc-handler-function - A function called to save outgoing articles. This function will be - called with the name of the file to store the article in. The default - function is @code{rmail-output} which saves in Unix mailbox format. - - @item message-courtesy-message - @vindex message-courtesy-message - When sending combined messages, this string is inserted at the start of - the mailed copy. If this variable is @code{nil}, no such courtesy - message will be added. - - @end table - - - @node Message Actions - @subsection Message Actions - - When Message is being used from a news/mail reader, the reader is likely - to want to perform some task after the message has been sent. Perhaps - return to the previous window configuration or mark an article as - replied. - - @vindex message-kill-actions - @vindex message-postpone-actions - @vindex message-exit-actions - @vindex message-send-actions - The user may exit from the message buffer in various ways. The most - common is @kbd{C-c C-c}, which sends the message and exits. Other - possibilities are @kbd{C-c C-s} which just sends the message, @kbd{C-c - C-p} which postpones the message editing and buries the message buffer, - and @kbd{C-c C-k} which kills the message buffer. Each of these actions - have lists associated with them that contains actions to be executed: - @code{message-send-actions}, @code{message-exit-actions}, - @code{message-postpone-actions}, and @code{message-kill-actions}. - - Message provides a function to interface with these lists: - @code{message-add-action}. The first parameter is the action to be - added, and the rest of the arguments are which lists to add this action - to. Here's an example from Gnus: - - @lisp - (message-add-action - `(set-window-configuration ,(current-window-configuration)) - 'exit 'postpone 'kill) - @end lisp - - This restores the Gnus window configuration when the message buffer is - killed, postponed or exited. - - An @dfn{action} can be either a normal function; or a list where the - @code{car} is a function and the @code{cdr} is the list of arguments; or - a form to be @code{eval}ed. - @node Composing Messages --- 6390,6395 ---- *** pub/sgnus/texi/ChangeLog Sun May 19 12:20:10 1996 --- sgnus/texi/ChangeLog Tue May 21 17:06:27 1996 *************** *** 1,3 **** --- 1,13 ---- + Tue May 21 12:52:34 1996 Lars Magne Ingebrigtsen + + * gnus.texi: Excised message documentation. + + * message.texi (Various Message): New file. + + Sun May 19 17:54:23 1996 Lars Magne Ingebrigtsen + + * gnus.texi (Mail Variables): Addition. + Sat May 18 15:05:42 1996 Lars Magne Ingebrigtsen * gnus.texi (Message Actions): New.