+Sun May 19 09:58:30 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
+
+ * gnus.el (gnus-group-set-mode-line): Make sure we're in the group
+ buffer.
+
+Sun May 19 11:14:54 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.el (gnus-group-set-mode-line): Empty dribble is unchanged.
+ (gnus-article-set-window-start): Search all frames.
+ (gnus-eval-in-buffer-window): Select window in different frame.
+ (gnus-get-unread-articles): Update info here.
+
+Sun May 19 07:30:07 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
+
+ * gnus.el (gnus-backlog-remove-article): Read-only.
+
+ * gnus-xmas.el (gnus-xmas-put-text-property): New function.
+
+ * gnus.el (gnus-subscribe-newsgroup-method): Doc fix.
+
+Sat May 18 14:33:37 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-save-newsrc-file): Update mode line.
+
+ * message.el (message-exit-actions, message-kill-actions,
+ message-postpone-actions): New variables.
+ (message-kill-buffer): New command and keystroke.
+ (message-bury): Changed keystroke.
+ (message-do-actions): New function.
+ (message-add-action): New function.
+ (message-send-news): Report failures.
+ (message-send-mail): Don't remove Message-ID already generated for
+ news.
+
+Sat May 18 08:20:03 1996 Lars Magne Ingebrigtsen <larsi@eistla.ifi.uio.no>
+
+ * nnspool.el (nnspool-retrieve-headers-with-nov): Escape buggy nov
+ files.
+
Sat May 18 08:42:34 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+ * gnus.el: 0.88 is released.
+
* gnus.el (gnus-group-set-mode-line): Say whether the dribble
buffer has been modified.
(setq beg nil)
(setq beg (point))))
(when (and beg end)
- (add-text-properties beg end props)
+ (gnus-add-text-properties beg end props)
(goto-char beg)
(unless (save-excursion (search-backward "\n\n" nil t))
(insert "\n"))
(if (text-property-any
(car region) (1- (cdr region))
(car gnus-hidden-properties) (cadr gnus-hidden-properties))
- 'remove-text-properties 'add-text-properties)
+ 'remove-text-properties 'gnus-add-text-properties)
(car region) (cdr region) gnus-hidden-properties)))
(defun gnus-article-hide-citation-maybe (&optional arg force)
total (cdr total))
(goto-line hiden)
(or (assq hiden gnus-cite-attribution-alist)
- (add-text-properties
+ (gnus-add-text-properties
(point) (progn (forward-line 1) (point))
(nconc (list 'gnus-type 'cite)
gnus-hidden-properties)))))))))))
gnus-hidden-properties))
((assq number gnus-cite-attribution-alist))
(t
- (add-text-properties
+ (gnus-add-text-properties
(point) (progn (forward-line 1) (point))
(nconc (list 'gnus-type 'cite)
gnus-hidden-properties))))))))
(defalias 'gnus-extent-detached-p 'ignore)
(defalias 'gnus-extent-start-open 'ignore)
(defalias 'gnus-set-text-properties 'set-text-properties)
+(defalias 'gnus-group-remove-excess-properties 'ignore)
+(defalias 'gnus-topic-remove-excess-properties 'ignore)
(defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
(defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
(defalias 'gnus-make-local-hook 'make-local-hook)
(defalias 'gnus-character-to-event 'identity)
(defalias 'gnus-add-text-properties 'add-text-properties)
+(defalias 'gnus-put-text-property 'put-text-property)
(eval-and-compile
(autoload 'gnus-xmas-define "gnus-xmas")
`(lambda (arg)
(gnus-post-method arg ,gnus-newsgroup-name)))
(setq message-newsreader (setq message-mailer (gnus-extended-version)))
- (let ((actions
- `((set-window-configuration ,winconf)
- ((lambda ()
- (when (buffer-name ,buffer)
- (set-buffer ,buffer)
- ,(when article
- `(gnus-summary-mark-article-as-replied ,article))))))))
- (setq message-send-actions (append message-send-actions actions))))
+ (message-add-action
+ `(set-window-configuration ,winconf) 'exit 'postpone 'kill)
+ (message-add-action
+ `(when (buffer-name ,buffer)
+ (save-excursion
+ (set-buffer ,buffer)
+ ,(when article
+ `(gnus-summary-mark-article-as-replied ,article))))
+ 'send))
(put 'gnus-setup-message 'lisp-indent-function 1)
(put 'gnus-setup-message 'lisp-indent-hook 1)
(t (cdar gnus-tree-brackets))))
(buffer-read-only nil)
beg end)
- (add-text-properties
+ (gnus-add-text-properties
(setq beg (point))
(setq end (progn (eval gnus-tree-line-format-spec) (point)))
(list 'gnus-number gnus-tmp-number))
(not (eval (caar list))))
(setq list (cdr list)))))
(unless (eq (setq face (cdar list)) (get-text-property beg 'face))
- (put-text-property
+ (gnus-put-text-property
beg end 'face
(if (boundp face) (symbol-value face) face)))))
(set-buffer (gnus-get-tree-buffer))
(let (region)
(when (setq region (gnus-tree-article-region article))
- (put-text-property (car region) (cdr region) 'face face)
+ (gnus-put-text-property (car region) (cdr region) 'face face)
(set-window-point
(get-buffer-window (current-buffer) t) (cdr region))))))
(t
"(closed)"))))
(beginning-of-line)
- (add-text-properties
+ (gnus-add-text-properties
(point)
(prog1 (1+ (point))
;; Insert the text.
(gnus-add-text-properties
(point)
(prog1 (1+ (point))
- (eval gnus-topic-line-format-spec))
+ (eval gnus-topic-line-format-spec)
+ (gnus-topic-remove-excess-properties)1)
(list 'gnus-topic (intern name)
'gnus-topic-level level
'gnus-topic-unread unread
(setq list (cdr list)))
(let ((face (cdar list)))
(unless (eq face (get-text-property beg 'face))
- (put-text-property
+ (gnus-put-text-property
beg end 'face
(setq face (if (boundp face) (symbol-value face) face)))
(when gnus-summary-highlight-line-function
(setq list (cdr list)))
(let ((face (cdar list)))
(unless (eq face (get-text-property beg 'face))
- (put-text-property
+ (gnus-put-text-property
beg end 'face
(setq face (if (boundp face) (symbol-value face) face)))
(gnus-extent-start-open beg)))
(when (and header-face
(not (memq (point) hpoints)))
(push (point) hpoints)
- (put-text-property from (point) 'face header-face))
+ (gnus-put-text-property from (point) 'face header-face))
(when (and field-face
(not (memq (setq from (point)) fpoints)))
(push from fpoints)
(if (re-search-forward "^[^ \t]" nil t)
(forward-char -2)
(goto-char (point-max)))
- (put-text-property from (point) 'face field-face)))))))))
+ (gnus-put-text-property from (point) 'face field-face)))))))))
(defun gnus-article-highlight-signature ()
"Highlight the signature in an article.
(and gnus-article-button-face
(gnus-overlay-put (gnus-make-overlay from to)
'face gnus-article-button-face))
- (add-text-properties
+ (gnus-add-text-properties
from to
(nconc (and gnus-article-mouse-face
(list gnus-mouse-face-prop gnus-article-mouse-face))
(list (extent-property extent 'text-prop) nil)
buffer))
buffer start end nil nil 'text-prop)
- (add-text-properties start end props buffer)))
+ (gnus-add-text-properties start end props buffer)))
(defun gnus-xmas-highlight-selected-summary ()
;; Highlight selected article in summary buffer
(add-text-properties start end props object)
(put-text-property start end 'start-closed nil object))
+(defun gnus-xmas-put-text-property (start end prop value &optional object)
+ (put-text-property start end prop value object)
+ (put-text-property start end 'start-closed nil object))
+
(defun gnus-xmas-extent-start-open (point)
(map-extents (lambda (extent arg)
(set-extent-property extent 'start-open t))
(and gnus-article-button-face
(gnus-overlay-put (gnus-make-overlay from to)
'face gnus-article-button-face))
- (add-text-properties
+ (gnus-add-text-properties
from to
(nconc
(and gnus-article-mouse-face
(event-to-character event))
event)))
+(defun gnus-xmas-group-remove-excess-properties ()
+ (let ((end (point))
+ (beg (progn (forward-line -1) (point))))
+ (remove-text-properties (1+ beg) end '(gnus-group nil))
+ (remove-text-properties
+ beg end
+ '(gnus-topic nil gnus-topic-level nil gnus-topic-visible nil))
+ (goto-char end)
+ (map-extents
+ (lambda (e ma)
+ (set-extent-property e 'start-closed t))
+ (current-buffer) beg end)))
+
+(defun gnus-xmas-topic-remove-excess-properties ()
+ (let ((end (point))
+ (beg (progn (forward-line -1) (point))))
+ (remove-text-properties beg end '(gnus-group nil gnus-unread nil))
+ (remove-text-properties (1+ beg) end '(gnus-topic nil))
+ (goto-char end)))
+
(defun gnus-xmas-seconds-since-epoch (date)
"Return a floating point number that says how many seconds have lapsed between Jan 1 12:00:00 1970 and DATE."
(let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti)))
(fset 'gnus-overlay-end 'extent-end-position)
(fset 'gnus-extent-detached-p 'extent-detached-p)
(fset 'gnus-add-text-properties 'gnus-xmas-add-text-properties)
+ (fset 'gnus-put-text-property 'gnus-xmas-put-text-property)
(require 'text-props)
(if (< emacs-minor-version 14)
(add-hook 'gnus-grouplens-mode-hook 'gnus-xmas-grouplens-menu-add)
(add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar)
- (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar))
+ (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar)
+
+ (when (and (<= emacs-major-version 19)
+ (<= emacs-minor-version 13))
+ (fset 'gnus-group-remove-excess-properties
+ 'gnus-xmas-group-remove-excess-properties)
+ (fset 'gnus-topic-remove-excess-properties
+ 'gnus-xmas-topic-remove-excess-properties)))
;;; XEmacs logo and toolbar.
`gnus-subscribe-alphabetically' inserts new groups in strict
alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
-for your decision; `gnus-subscribe-killed' kills all new groups.")
+for your decision; `gnus-subscribe-killed' kills all new groups;
+`gnus-subscribe-zombies' will make all new groups into zombies.")
;; Suggested by a bug report by Hallvard B Furuseth.
;; <h.b.furuseth@usit.uio.no>.
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.88"
+(defconst gnus-version "September Gnus v0.89"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
(defmacro gnus-eval-in-buffer-window (buffer &rest forms)
"Pop to BUFFER, evaluate FORMS, and then return to the original window."
- (let ((tempvar (make-symbol "GnusStartBufferWindow")))
- `(let ((,tempvar (selected-window)))
+ (let ((tempvar (make-symbol "GnusStartBufferWindow"))
+ (w (make-symbol "w"))
+ (buf (make-symbol "buf")))
+ `(let* ((,tempvar (selected-window))
+ (,buf ,buffer)
+ (,w (get-buffer-window ,buf 'visible)))
(unwind-protect
(progn
- (pop-to-buffer ,buffer)
+ (if ,w
+ (select-window ,w)
+ (pop-to-buffer ,buf))
,@forms)
(select-window ,tempvar)))))
(defun gnus-summary-line-format-spec ()
(insert gnus-tmp-unread gnus-tmp-replied
gnus-tmp-score-char gnus-tmp-indentation)
- (put-text-property
+ (gnus-put-text-property
(point)
(progn
(insert
(defun gnus-summary-dummy-line-format-spec ()
(insert "* ")
- (put-text-property
+ (gnus-put-text-property
(point)
(progn
(insert ": :")
gnus-tmp-process-marked
gnus-group-indentation
(format "%5s: " gnus-tmp-number-of-unread))
- (put-text-property
+ (gnus-put-text-property
(point)
(progn
(insert gnus-tmp-group "\n")
(defvar gnus-mouse-face-4 'highlight)
(defun gnus-mouse-face-function (form type)
- `(put-text-property
+ `(gnus-put-text-property
(point) (progn ,@form (point))
gnus-mouse-face-prop
,(if (equal type 0)
(defvar gnus-face-4 'bold)
(defun gnus-face-face-function (form type)
- `(put-text-property
+ `(gnus-put-text-property
(point) (progn ,@form (point))
'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
"Set text PROPS on the B to E region, extending `intangible' 1 past B."
(gnus-add-text-properties b e props)
(when (memq 'intangible props)
- (put-text-property (max (1- b) (point-min))
+ (gnus-put-text-property (max (1- b) (point-min))
b 'intangible (cddr (memq 'intangible props)))))
(defsubst gnus-unhide-text (b e)
"Remove hidden text properties from region between B and E."
(remove-text-properties b e gnus-hidden-properties)
(when (memq 'intangible gnus-hidden-properties)
- (put-text-property (max (1- b) (point-min))
+ (gnus-put-text-property (max (1- b) (point-min))
b 'intangible nil)))
(defun gnus-hide-text-type (b e type)
;; Fontify some.
(goto-char (point-min))
(and (search-forward "Praxis" nil t)
- (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
+ (gnus-put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
(goto-char (point-min))
(let* ((mode-string (gnus-group-set-mode-line)))
(setq mode-line-buffer-identification
(when (inline (gnus-visual-p 'group-highlight 'highlight))
(forward-line -1)
(run-hooks 'gnus-group-update-hook)
- (forward-line))))
+ (forward-line))
+ ;; Allow XEmacs to remove front-sticky text properties.
+ (gnus-group-remove-excess-properties)))
(defun gnus-group-update-group (group &optional visible-only)
"Update all lines where GROUP appear.
(defun gnus-group-set-mode-line ()
(when (memq 'group gnus-updated-mode-lines)
- (let* ((gformat (or gnus-group-mode-line-format-spec
- (setq gnus-group-mode-line-format-spec
- (gnus-parse-format
- gnus-group-mode-line-format
- gnus-group-mode-line-format-alist))))
- (gnus-tmp-news-server (cadr gnus-select-method))
- (gnus-tmp-news-method (car gnus-select-method))
- (max-len 60)
- gnus-tmp-header ;Dummy binding for user-defined formats
- ;; Get the resulting string.
- (mode-string (eval gformat)))
- ;; Say whether the dribble buffer has been modified.
- (setq mode-line-modified
- (if (and gnus-dribble-buffer
- (buffer-name gnus-dribble-buffer)
- (buffer-modified-p gnus-dribble-buffer))
- "-* " "-- "))
- ;; 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)))))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (let* ((gformat (or gnus-group-mode-line-format-spec
+ (setq gnus-group-mode-line-format-spec
+ (gnus-parse-format
+ gnus-group-mode-line-format
+ gnus-group-mode-line-format-alist))))
+ (gnus-tmp-news-server (cadr gnus-select-method))
+ (gnus-tmp-news-method (car gnus-select-method))
+ (max-len 60)
+ gnus-tmp-header ;Dummy binding for user-defined formats
+ ;; Get the resulting string.
+ (mode-string (eval gformat)))
+ ;; Say whether the dribble buffer has been modified.
+ (setq mode-line-modified
+ (if (and gnus-dribble-buffer
+ (buffer-name gnus-dribble-buffer)
+ (buffer-modified-p gnus-dribble-buffer)
+ (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 ()
"Get the name of the newsgroup on the current line."
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
(or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
- (put-text-property
+ (gnus-put-text-property
(point)
(progn (eval gnus-summary-line-format-spec) (point))
'gnus-number gnus-tmp-number)
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
(or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
- (put-text-property
+ (gnus-put-text-property
(point)
(progn (eval gnus-summary-line-format-spec) (point))
'gnus-number number)
;; from the head of the article.
(defun gnus-article-set-window-start (&optional line)
(set-window-start
- (get-buffer-window gnus-article-buffer)
+ (get-buffer-window gnus-article-buffer t)
(save-excursion
(set-buffer gnus-article-buffer)
(goto-char (point-min))
(beginning-of-line)
;; We add the headers we want to keep to a list and delete
;; them from the buffer.
- (put-text-property
+ (gnus-put-text-property
(point) (1+ (point)) 'message-rank
(if (or (and visible (looking-at visible))
(and ignored
;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
(gnus-hide-text-type beg (point-max) 'headers))
;; Work around XEmacs lossage.
- (put-text-property (point-min) beg 'invisible nil))))))))
+ (gnus-put-text-property (point-min) beg 'invisible nil))))))))
(defun gnus-article-hide-boring-headers (&optional arg)
"Toggle hiding of headers that aren't very interesting.
(let ((next (following-char))
(previous (char-after (- (point) 2))))
(cond ((eq next previous)
- (put-text-property (- (point) 2) (point) 'invisible t)
- (put-text-property (point) (1+ (point)) 'face 'bold))
+ (gnus-put-text-property (- (point) 2) (point) 'invisible t)
+ (gnus-put-text-property (point) (1+ (point)) 'face 'bold))
((eq next ?_)
- (put-text-property (1- (point)) (1+ (point)) 'invisible t)
- (put-text-property
+ (gnus-put-text-property (1- (point)) (1+ (point)) 'invisible t)
+ (gnus-put-text-property
(- (point) 2) (1- (point)) 'face 'underline))
((eq previous ?_)
- (put-text-property (- (point) 2) (point) 'invisible t)
- (put-text-property
+ (gnus-put-text-property (- (point) 2) (point) 'invisible t)
+ (gnus-put-text-property
(point) (1+ (point)) 'face 'underline))))))))
(defun gnus-article-word-wrap ()
(forward-line -1)
(when (and (gnus-visual-p 'article-highlight 'highlight)
(looking-at "\\([^:]+\\): *\\(.*\\)$"))
- (put-text-property (match-beginning 1) (match-end 1)
+ (gnus-put-text-property (match-beginning 1) (match-end 1)
'face bface)
- (put-text-property (match-beginning 2) (match-end 2)
+ (gnus-put-text-property (match-beginning 2) (match-end 2)
'face eface))))))))
(defun gnus-make-date-line (date type)
(when (<= (gnus-info-level info) foreign-level)
(setq active (gnus-activate-group group 'scan))
(unless (inline (gnus-virtual-group-p group))
- (inline (gnus-close-group group))))
-
+ (inline (gnus-close-group group)))
+ (when (fboundp (intern (concat (symbol-name (car method))
+ "-request-update-info")))
+ (inline (gnus-request-update-info info method))))
;; These groups are native or secondary.
(when (and (<= (gnus-info-level info) level)
(not gnus-read-active-file))
(setq active (gnus-activate-group group 'scan))
(inline (gnus-close-group group))))
+ ;; Get the number of unread articles in the group.
(if active
- (inline (gnus-get-unread-articles-in-group
- info active
- (and method
- (fboundp (intern (concat (symbol-name (car method))
- "-request-update-info"))))))
+ (inline (gnus-get-unread-articles-in-group info active))
;; The group couldn't be reached, so we nix out the number of
;; unread articles and stuff.
(gnus-set-active group nil)
(kill-buffer (current-buffer))
(gnus-message
5 "Saving %s.eld...done" gnus-current-startup-file))
- (gnus-dribble-delete-file)))))
+ (gnus-dribble-delete-file)
+ (gnus-group-set-mode-line)))))
(defun gnus-gnus-to-quick-newsrc-format ()
"Insert Gnus variables such as gnus-newsrc-alist in lisp format."
(setq b (point))
(insert-buffer-substring buffer)
;; Tag the beginning of the article with the ident.
- (put-text-property b (1+ b) 'gnus-backlog ident))))))
+ (gnus-put-text-property b (1+ b) 'gnus-backlog ident))))))
(defun gnus-backlog-remove-oldest-article ()
(save-excursion
;; It was in the backlog.
(save-excursion
(set-buffer (gnus-backlog-buffer))
- (when (setq beg (text-property-any
- (point-min) (point-max) 'gnus-backlog
- ident))
- ;; Find the end (i. e., the beginning of the next article).
- (setq end
- (next-single-property-change
- (1+ beg) 'gnus-backlog (current-buffer) (point-max)))
- (delete-region beg end)
- ;; Return success.
- t))))))
+ (let (buffer-read-only)
+ (when (setq beg (text-property-any
+ (point-min) (point-max) 'gnus-backlog
+ ident))
+ ;; Find the end (i. e., the beginning of the next article).
+ (setq end
+ (next-single-property-change
+ (1+ beg) 'gnus-backlog (current-buffer) (point-max)))
+ (delete-region beg end)
+ ;; Return success.
+ t)))))))
(defun gnus-backlog-request-article (group number buffer)
(when (numberp number)
(defvar message-checksum nil)
(defvar message-send-actions nil
"A list of actions to be performed upon successful sending of a message.")
+(defvar message-exit-actions nil
+ "A list of actions to be performed upon exiting after sending a message.")
+(defvar message-kill-actions nil
+ "A list of actions to be performed before killing a message buffer.")
+(defvar message-postpone-actions nil
+ "A list of actions to be performed after postponing a message.")
;;;###autoload
(defvar message-default-headers nil
(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-dont-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."
(make-local-variable 'message-reply-buffer)
(setq message-reply-buffer nil)
(make-local-variable 'message-send-actions)
+ (make-local-variable 'message-exit-actions)
+ (make-local-variable 'message-kill-actions)
+ (make-local-variable 'message-postpone-actions)
(set-syntax-table message-mode-syntax-table)
(use-local-map message-mode-map)
(setq local-abbrev-table text-mode-abbrev-table)
(defun message-send-and-exit (&optional arg)
"Send message like `message-send', then, if no errors, exit from mail buffer."
(interactive "P")
- (let ((buf (current-buffer)))
+ (let ((buf (current-buffer))
+ (actions message-exit-actions))
(when (and (message-send arg)
(buffer-name buf))
(if message-kill-buffer-on-exit
(kill-buffer buf)
(bury-buffer buf)
(when (eq buf (current-buffer))
- (message-bury buf))))))
+ (message-bury buf)))
+ (message-do-actions actions))))
(defun message-dont-send ()
"Don't send the message you have been editing."
(interactive)
- (message-bury (current-buffer)))
+ (message-bury (current-buffer))
+ (message-do-actions message-postpone-actions))
+
+(defun message-kill-buffer ()
+ "Kill the current buffer."
+ (interactive)
+ (let ((actions message-kill-actions))
+ (kill-buffer (current-buffer))
+ (message-do-actions actions)))
(defun message-bury (buffer)
"Bury this mail buffer."
(unless buffer-file-name
(set-buffer-modified-p nil)
(delete-auto-save-file-if-necessary t))
- ;; Now perform actions on successful sending.
- (let ((actions message-send-actions))
- (while actions
- (condition-case nil
- (apply (caar actions) (cdar actions))
- (error))
- (pop actions)))
+ (message-do-actions message-send-actions)
;; Return success.
t)))
+(defun message-add-action (action &rest types)
+ "Add ACTION to be performed when doing an exit of type TYPES."
+ (let (var)
+ (while types
+ (set (setq var (intern (format "message-%s-actions" (pop types))))
+ (nconc (symbol-value var) (list action))))))
+
+(defun message-do-actions (actions)
+ "Perform all actions in ACTIONS."
+ ;; Now perform actions on successful sending.
+ (while actions
+ (condition-case nil
+ (cond
+ ;; A simple function.
+ ((message-functionp (car actions))
+ (funcall (car actions)))
+ ;; Something to be evaled.
+ (t
+ (eval (car actions))))
+ (error))
+ (pop actions)))
+
(defun message-send-mail (&optional arg)
(require 'mail-utils)
(let ((errbuf (if message-interactive
(message-narrow-to-headers)
(setq resend-to-addresses (mail-fetch-field "resent-to"))
;; Insert some headers.
- (message-generate-headers message-required-mail-headers)
+ (let ((message-deletable-headers
+ (if news nil message-deletable-headers)))
+ (message-generate-headers message-required-mail-headers))
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
(unwind-protect
(method (if (message-functionp message-post-method)
(funcall message-post-method arg)
message-post-method))
- (messbuf (current-buffer)))
+ (messbuf (current-buffer))
+ result)
(save-restriction
(message-narrow-to-headers)
;; Insert some headers.
(require (car method))
(funcall (intern (format "%s-open-server" (car method)))
(cadr method) (cddr method))
- (funcall (intern (format "%s-request-post"
- (car method)))))
+ (setq result
+ (funcall (intern (format "%s-request-post" (car method))))))
(kill-buffer tembuf))
(set-buffer messbuf)
- (push 'news message-sent-message-via))))
+ (if result
+ (push 'news message-sent-message-via)
+ (message "Couldn't send message via news: %s"
+ (nnheader-get-report (car method)))
+ nil))))
;;;
;;; Header generation & syntax checking.
(message-mode))
(defun message-setup (headers &optional replybuffer actions)
- (setq message-send-actions actions)
+ (when actions
+ (setq message-send-actions actions))
(setq message-reply-buffer replybuffer)
(goto-char (point-min))
;; Insert all the headers.
(if (and fetch-old
(not (numberp fetch-old)))
t ; We want all the headers.
- ;; First we find the first wanted line.
- (nnspool-find-nov-line
- (if fetch-old (max 1 (- (car articles) fetch-old))
- (car articles)))
- (delete-region (point-min) (point))
- ;; Then we find the last wanted line.
- (if (nnspool-find-nov-line
- (progn (while (cdr articles) (setq articles (cdr articles)))
- (car articles)))
- (forward-line 1))
- (delete-region (point) (point-max))
- ;; If the buffer is empty, this wasn't very successful.
- (unless (zerop (buffer-size))
- ;; We check what the last article number was. The NOV file
- ;; may be out of sync with the articles in the group.
- (forward-line -1)
- (setq last (read (current-buffer)))
- (if (= last (car articles))
- ;; Yup, it's all there.
- t
- ;; Perhaps not. We try to find the missing articles.
- (while (and arts
- (<= last (car arts)))
- (pop arts))
- ;; The articles in `arts' are missing from the buffer.
- (while arts
- (nnspool-insert-nov-head (pop arts)))
- t)))))))))
+ (condition-case ()
+ (progn
+ ;; First we find the first wanted line.
+ (nnspool-find-nov-line
+ (if fetch-old (max 1 (- (car articles) fetch-old))
+ (car articles)))
+ (delete-region (point-min) (point))
+ ;; Then we find the last wanted line.
+ (if (nnspool-find-nov-line
+ (progn (while (cdr articles)
+ (setq articles (cdr articles)))
+ (car articles)))
+ (forward-line 1))
+ (delete-region (point) (point-max))
+ ;; If the buffer is empty, this wasn't very successful.
+ (unless (zerop (buffer-size))
+ ;; We check what the last article number was.
+ ;; The NOV file may be out of sync with the articles
+ ;; in the group.
+ (forward-line -1)
+ (setq last (read (current-buffer)))
+ (if (= last (car articles))
+ ;; Yup, it's all there.
+ t
+ ;; Perhaps not. We try to find the missing articles.
+ (while (and arts
+ (<= last (car arts)))
+ (pop arts))
+ ;; The articles in `arts' are missing from the buffer.
+ (while arts
+ (nnspool-insert-nov-head (pop arts)))
+ t)))
+ ;; The NOV file was corrupted.
+ (error nil)))))))))
(defun nnspool-insert-nov-head (article)
"Read the head of ARTICLE, convert to NOV headers, and insert."
+Sat May 18 15:05:42 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Message Actions): New.
+ (Sorting): Separated to own node.
+
Thu May 2 16:32:11 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
* gnus.texi: Added message indices.
in @code{gnus-select-group-hook}, which is called when a group is
selected.
-@findex gnus-thread-sort-by-total-score
-@findex gnus-thread-sort-by-date
-@findex gnus-thread-sort-by-score
-@findex gnus-thread-sort-by-subject
-@findex gnus-thread-sort-by-author
-@findex gnus-thread-sort-by-number
-@vindex gnus-thread-sort-functions
-If you are using a threaded summary display, you can sort the threads by
-setting @code{gnus-thread-sort-functions}, which is a list of functions.
-By default, sorting is done on article numbers. Ready-made sorting
-predicate functions include @code{gnus-thread-sort-by-number},
-@code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-subject},
-@code{gnus-thread-sort-by-date}, @code{gnus-thread-sort-by-score}, and
-@code{gnus-thread-sort-by-total-score}.
-
-Each function takes two threads and return non-@code{nil} if the first
-thread should be sorted before the other. Note that sorting really is
-normally done by looking only at the roots of each thread. If you use
-more than one function, the primary sort key should be the last function
-in the list. You should probably always include
-@code{gnus-thread-sort-by-number} in the list of sorting
-functions---preferably first. This will ensure that threads that are
-equal with respect to the other sort criteria will be displayed in
-ascending article order.
-
-If you would like to sort by score, then by subject, and finally by
-number, you could do something like:
-
-@lisp
-(setq gnus-thread-sort-functions
- '(gnus-thread-sort-by-number
- gnus-thread-sort-by-subject
- gnus-thread-sort-by-score))
-@end lisp
-
-The threads that have highest score will be displayed first in the
-summary buffer. When threads have the same score, they will be sorted
-alphabetically. The threads that have the same score and the same
-subject will be sorted by number, which is (normally) the sequence in
-which the articles arrived.
-
-If you want to sort by score and then reverse arrival order, you could
-say something like:
-
-@lisp
-(setq gnus-thread-sort-functions
- '((lambda (t1 t2)
- (not (gnus-thread-sort-by-number t1 t2)))
- gnus-thread-sort-by-score))
-@end lisp
-
-@vindex gnus-thread-score-function
-The function in the @code{gnus-thread-score-function} variable (default
-@code{+}) is used for calculating the total score of a thread. Useful
-functions might be @code{max}, @code{min}, or squared means, or whatever
-tickles your fancy.
-
-@findex gnus-article-sort-functions
-@findex gnus-article-sort-by-date
-@findex gnus-article-sort-by-score
-@findex gnus-article-sort-by-subject
-@findex gnus-article-sort-by-author
-@findex gnus-article-sort-by-number
-If you are using an unthreaded display for some strange reason or other,
-you have to fiddle with the @code{gnus-article-sort-functions} variable.
-It is very similar to the @code{gnus-thread-sort-functions}, except that
-is uses slightly different functions for article comparison. Available
-sorting predicate functions are @code{gnus-article-sort-by-number},
-@code{gnus-article-sort-by-author}, @code{gnus-article-sort-by-subject},
-@code{gnus-article-sort-by-date}, and @code{gnus-article-sort-by-score}.
-
-If you want to sort an unthreaded summary display by subject, you could
-say something like:
-
-@lisp
-(setq gnus-article-sort-functions
- '(gnus-article-sort-by-number
- gnus-article-sort-by-subject))
-@end lisp
-
@node Subscription Commands
@section Subscription Commands
* Marking Articles:: Marking articles as read, expirable, etc.
* Limiting:: You can limit the summary buffer.
* Threading:: How threads are made.
+* Sorting:: How articles and threads are sorted.
* Asynchronous Fetching:: Gnus might be able to pre-fetch articles.
* Article Caching:: You may store articles in a cache.
* Persistent Articles:: Making articles expiry-resistant.
that have subjects that are fuzzily equal will be included.
+@node Sorting
+@section Sorting
+
+@findex gnus-thread-sort-by-total-score
+@findex gnus-thread-sort-by-date
+@findex gnus-thread-sort-by-score
+@findex gnus-thread-sort-by-subject
+@findex gnus-thread-sort-by-author
+@findex gnus-thread-sort-by-number
+@vindex gnus-thread-sort-functions
+If you are using a threaded summary display, you can sort the threads by
+setting @code{gnus-thread-sort-functions}, which is a list of functions.
+By default, sorting is done on article numbers. Ready-made sorting
+predicate functions include @code{gnus-thread-sort-by-number},
+@code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-subject},
+@code{gnus-thread-sort-by-date}, @code{gnus-thread-sort-by-score}, and
+@code{gnus-thread-sort-by-total-score}.
+
+Each function takes two threads and return non-@code{nil} if the first
+thread should be sorted before the other. Note that sorting really is
+normally done by looking only at the roots of each thread. If you use
+more than one function, the primary sort key should be the last function
+in the list. You should probably always include
+@code{gnus-thread-sort-by-number} in the list of sorting
+functions---preferably first. This will ensure that threads that are
+equal with respect to the other sort criteria will be displayed in
+ascending article order.
+
+If you would like to sort by score, then by subject, and finally by
+number, you could do something like:
+
+@lisp
+(setq gnus-thread-sort-functions
+ '(gnus-thread-sort-by-number
+ gnus-thread-sort-by-subject
+ gnus-thread-sort-by-score))
+@end lisp
+
+The threads that have highest score will be displayed first in the
+summary buffer. When threads have the same score, they will be sorted
+alphabetically. The threads that have the same score and the same
+subject will be sorted by number, which is (normally) the sequence in
+which the articles arrived.
+
+If you want to sort by score and then reverse arrival order, you could
+say something like:
+
+@lisp
+(setq gnus-thread-sort-functions
+ '((lambda (t1 t2)
+ (not (gnus-thread-sort-by-number t1 t2)))
+ gnus-thread-sort-by-score))
+@end lisp
+
+@vindex gnus-thread-score-function
+The function in the @code{gnus-thread-score-function} variable (default
+@code{+}) is used for calculating the total score of a thread. Useful
+functions might be @code{max}, @code{min}, or squared means, or whatever
+tickles your fancy.
+
+@findex gnus-article-sort-functions
+@findex gnus-article-sort-by-date
+@findex gnus-article-sort-by-score
+@findex gnus-article-sort-by-subject
+@findex gnus-article-sort-by-author
+@findex gnus-article-sort-by-number
+If you are using an unthreaded display for some strange reason or other,
+you have to fiddle with the @code{gnus-article-sort-functions} variable.
+It is very similar to the @code{gnus-thread-sort-functions}, except that
+is uses slightly different functions for article comparison. Available
+sorting predicate functions are @code{gnus-article-sort-by-number},
+@code{gnus-article-sort-by-author}, @code{gnus-article-sort-by-subject},
+@code{gnus-article-sort-by-date}, and @code{gnus-article-sort-by-score}.
+
+If you want to sort an unthreaded summary display by subject, you could
+say something like:
+
+@lisp
+(setq gnus-article-sort-functions
+ '(gnus-article-sort-by-number
+ gnus-article-sort-by-subject))
+@end lisp
+
+
+
@node Asynchronous Fetching
@section Asynchronous Article Fetching
@cindex asynchronous article fetching
sending it.
@menu
-* New Mail Message::
-* New News Message::
-* Reply::
-* Wide Reply::
-* Followup::
-* Canceling News::
-* Superseding::
-* Forwarding::
-* Resending::
-* Bouncing::
+* 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
@section Message Variables
@menu
-* Message Headers::
-* Mail Headers::
-* Mail Variables::
-* News Headers::
-* News Variables::
-* Various Message Variables::
-* Sending Variables::
+* 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
@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.
projects / gnus / commitdiff