+2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * dns.el (query-dns): Protect against errors.
+
+ * gnus-msg.el (gnus-article-yanked-articles): New variable.
+ (gnus-inews-add-send-actions): Mark all answered messages as
+ answered.
+
+2002-08-10 Jari Aalto <jari.aalto@poboxes.com>
+
+ * nnmail.el (nnmail-split-it): Added tracing to
+ `:' split rule
+
+2002-08-13 Hrvoje Niksic <hniksic@xemacs.org>
+
+ * mm-decode.el (mm-mailcap-command): Remove the quotes around '%s'
+ and "%s" so we don't overquote them.
+
+2002-08-13 Hrvoje Niksic <hniksic@xemacs.org>
+
+ * (mm-display-external): Display the actual command that has been
+ executed in the echo area.
+
2002-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * gnus-topic.el (gnus-topic-display-missing-topic): Bind entry.
+
+ * message.el (message-with-reply-buffer): New macro.
+ (message-fetch-reply-field): Use it.
+ (message-insert-wide-reply): New command and keystroke.
+ (message-carefully-insert-headers): New function.
+ (message-insert-to): Use new function.
+
+ * gnus-topic.el (gnus-topic-display-missing-topic): New function.
+ (gnus-topic-goto-missing-group): Use it.
+
+ * message.el (message-required-news-headers): Removed Lines.
+ (message-reply): Don't insert References first.
+ (message-followup): Ditto.
+ (message-make-references): New function.
+ (message-followup): Set message-reply-headers before generating
+ the buffer stuff.
+
+2002-12-29 Jesper Harder <harder@ifa.au.dk>
+
+ * mml.el (mml-generate-mime-1): Reverse the order of
+ encoding/flowing.
+
+2002-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * nnmail.el (nnmail-expiry-target-group): Mark articles as read
+ after moving them.
+
* gnus-sum.el (gnus-summary-dummy-line-format): Update format to
fit with newer standard format.
(gnus-summary-make-false-root-always): New variable.
(unless dns-servers
(error "No DNS server configuration found")))
(mm-with-unibyte-buffer
- (let ((process (dns-make-network-process (car dns-servers)))
+ (let ((process (condition-case ()
+ (dns-make-network-process (car dns-servers))
+ (error
+ (message "dns: Got an error while trying to talk to %s"
+ (car dns-servers))
+ nil)))
(tcp-p (and (not (fboundp 'make-network-process))
(not (featurep 'xemacs))))
(step 100)
(times (* dns-timeout 1000))
(id (random 65000)))
- (process-send-string
- process
- (dns-write `((id ,id)
- (opcode query)
- (queries ((,name (type ,type))))
- (recursion-desired-p t))
- tcp-p))
- (while (and (zerop (buffer-size))
- (> times 0))
- (accept-process-output process 0 step)
- (decf times step))
- (ignore-errors
- (delete-process process))
- (when tcp-p
- (goto-char (point-min))
- (delete-region (point) (+ (point) 2)))
- (unless (zerop (buffer-size))
- (let ((result (dns-read (buffer-string))))
- (if fullp
- result
- (let ((answer (car (dns-get 'answers result))))
- (when (eq type (dns-get 'type answer))
- (dns-get 'data answer)))))))))
+ (when process
+ (process-send-string
+ process
+ (dns-write `((id ,id)
+ (opcode query)
+ (queries ((,name (type ,type))))
+ (recursion-desired-p t))
+ tcp-p))
+ (while (and (zerop (buffer-size))
+ (> times 0))
+ (accept-process-output process 0 step)
+ (decf times step))
+ (ignore-errors
+ (delete-process process))
+ (when tcp-p
+ (goto-char (point-min))
+ (delete-region (point) (+ (point) 2)))
+ (unless (zerop (buffer-size))
+ (let ((result (dns-read (buffer-string))))
+ (if fullp
+ result
+ (let ((answer (car (dns-get 'answers result))))
+ (when (eq type (dns-get 'type answer))
+ (dns-get 'data answer))))))))))
(provide 'dns)
(defvar gnus-inhibit-posting-styles nil
"Inhibit the use of posting styles.")
+(defvar gnus-article-yanked-articles nil)
(defvar gnus-message-buffer "*Mail Gnus*")
(defvar gnus-article-copy nil)
(defvar gnus-check-before-posting nil)
(let ((winconf (make-symbol "gnus-setup-message-winconf"))
(buffer (make-symbol "gnus-setup-message-buffer"))
(article (make-symbol "gnus-setup-message-article"))
+ (yanked (make-symbol "gnus-setup-yanked-articles"))
(group (make-symbol "gnus-setup-message-group")))
`(let ((,winconf (current-window-configuration))
(,buffer (buffer-name (current-buffer)))
(,article gnus-article-reply)
+ (,yanked gnus-article-yanked-articles)
(,group gnus-newsgroup-name)
(message-header-setup-hook
(copy-sequence message-header-setup-hook))
(unwind-protect
(progn
,@forms)
- (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config)
+ (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
+ ,yanked)
(gnus-inews-insert-draft-meta-information ,group ,article)
(setq gnus-message-buffer (current-buffer))
(set (make-local-variable 'gnus-message-group-art)
(symbol-value (car elem))))
(throw 'found (cons (cadr elem) (caddr elem)))))))))
-(defun gnus-inews-add-send-actions (winconf buffer article &optional config)
+(defun gnus-inews-add-send-actions (winconf buffer article
+ &optional config yanked)
(make-local-hook 'message-sent-hook)
(add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
'gnus-inews-do-gcc) nil t)
(set-buffer ,buffer)
,(when article
(if (eq config 'forward)
- `(gnus-summary-mark-article-as-forwarded ',article)
- `(gnus-summary-mark-article-as-replied ',article)))))
+ `(gnus-summary-mark-article-as-forwarded ',yanked)
+ `(gnus-summary-mark-article-as-replied ',yanked)))))
'send))
(put 'gnus-setup-message 'lisp-indent-function 1)
(when article-buffer
(gnus-copy-article-buffer))
(let ((gnus-article-reply (and article-buffer (gnus-summary-article-number)))
+ (gnus-article-yanked-articles yank)
(add-to-list gnus-add-to-list))
(gnus-setup-message (cond (yank 'reply-yank)
(article-buffer 'reply)
(caar yank)
(car yank)))
(gnus-article-reply (or article (gnus-summary-article-number)))
+ (gnus-article-yanked-articles yank)
(headers ""))
;; Stripping headers should be specified with mail-yank-ignored-headers.
(when yank
from the original Gnus."
(interactive "P")
(if (null (cdr (gnus-summary-work-articles nil)))
- (gnus-setup-message 'forward
- (gnus-summary-select-article)
- (let ((charset default-mime-charset))
+ (let* ((gnus-article-reply (gnus-summary-article-number))
+ (gnus-article-yanked-articles (list (list gnus-article-reply)))
+ charset
+ (message-included-forward-headers
+ (if full-headers "" message-included-forward-headers)))
+ (gnus-setup-message 'forward
+ (gnus-summary-select-article)
+ (setq charset default-mime-charset)
(set-buffer gnus-original-article-buffer)
(make-local-variable 'default-mime-charset)
- (setq default-mime-charset charset))
- (let ((message-included-forward-headers
- (if full-headers "" message-included-forward-headers)))
+ (setq default-mime-charset charset)
(message-forward post)))
(gnus-summary-digest-mail-forward nil post)))
;; All score code written by Per Abrahamsen <abraham@iesd.auc.dk>.
-;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-score-set-mark-below (score)
"Automatically mark articles with score below SCORE as read."
(interactive
to-group (cdar marks) (list to-article) info)))
(setq marks (cdr marks)))
- (gnus-request-set-mark to-group (list (list (list to-article)
- 'add
- to-marks))))
+ (gnus-request-set-mark
+ to-group (list (list (list to-article) 'add to-marks))))
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
(unfound t)
entry)
;; Try to jump to a visible group.
- (while (and g (not (gnus-group-goto-group (car g) t)))
+ (while (and g
+ (not (gnus-group-goto-group (car g) t)))
(pop g))
;; It wasn't visible, so we try to see where to insert it.
(when (not g)
(when (and unfound
topic
(not (gnus-topic-goto-missing-topic topic)))
- (let* ((top (gnus-topic-find-topology topic))
- (children (cddr top))
- (type (cadr top))
- (unread 0)
- (entries (gnus-topic-find-groups
- (car type) (car gnus-group-list-mode)
- (cdr gnus-group-list-mode))))
- (while children
- (incf unread (gnus-topic-unread (caar (pop children)))))
- (while (setq entry (pop entries))
- (when (numberp (car entry))
- (incf unread (car entry))))
- (gnus-topic-insert-topic-line
- topic t t (car (gnus-topic-find-topology topic)) nil unread))))))
+ (gnus-topic-display-missing-topic topic)))))
+
+(defun gnus-topic-display-missing-topic (topic)
+ "Insert topic lines recursively for missing topics."
+ (let ((parent (gnus-topic-find-topology
+ (gnus-topic-parent-topic topic))))
+ (when (and parent
+ (not (gnus-topic-goto-missing-topic (caadr parent))))
+ (gnus-topic-display-missing-topic (caadr parent))))
+ (gnus-topic-goto-missing-topic topic)
+ (let* ((top (gnus-topic-find-topology topic))
+ (children (cddr top))
+ (type (cadr top))
+ (unread 0)
+ (entries (gnus-topic-find-groups
+ (car type) (car gnus-group-list-mode)
+ (cdr gnus-group-list-mode)))
+ entry)
+ (while children
+ (incf unread (gnus-topic-unread (caar (pop children)))))
+ (while (setq entry (pop entries))
+ (when (numberp (car entry))
+ (incf unread (car entry))))
+ (gnus-topic-insert-topic-line
+ topic t t (car (gnus-topic-find-topology topic)) nil unread)))
(defun gnus-topic-goto-missing-topic (topic)
(if (gnus-topic-goto-topic topic)
(defcustom message-required-news-headers
'(From Newsgroups Subject Date Message-ID
- (optional . Organization) Lines
+ (optional . Organization)
+ (optional . References)
(optional . User-Agent))
"*Headers to be generated or prompted for when posting an article.
RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
(defcustom message-required-mail-headers
'(From Subject Date (optional . In-Reply-To) Message-ID
- (optional . User-Agent))
+ (optional . User-Agent)
+ (optional . References))
"*Headers to be generated or prompted for when mailing a message.
It is recommended that From, Date, To, Subject and Message-ID be
included. Organization and User-Agent are optional."
(insert (car headers) ?\n)))))
(setq headers (cdr headers))))
+(defmacro message-with-reply-buffer (&rest forms)
+ "Evaluate FORMS in the reply buffer, if it exists."
+ `(let ((buffer (message-eval-parameter message-reply-buffer)))
+ (when (and buffer
+ (buffer-name buffer))
+ (save-excursion
+ (set-buffer buffer)
+ ,@forms))))
+
+(put 'message-with-reply-buffer 'lisp-indent-function 0)
+(put 'message-with-reply-buffer 'edebug-form-spec '(body))
(defun message-fetch-reply-field (header)
"Fetch field HEADER from the message we're replying to."
- (let ((buffer (message-eval-parameter message-reply-buffer)))
- (when (and buffer
- (buffer-name buffer))
- (save-excursion
- (set-buffer buffer)
- (message-fetch-field header)))))
+ (message-with-reply-buffer
+ (message-fetch-field header)))
(defun message-set-work-buffer ()
(if (get-buffer " *message work*")
(define-key message-mode-map "\C-c\C-fc" 'message-goto-mail-copies-to)
(define-key message-mode-map "\C-c\C-t" 'message-insert-to)
+ (define-key message-mode-map "\C-c\C-p" 'message-insert-wide-reply)
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
(define-key message-mode-map "\C-c\C-l" 'message-to-list-only)
(or (equal (downcase co) "never")
(equal (downcase co) "nobody")))
(error "The user has requested not to have copies sent via mail")))
- (when (and (message-position-on-field "To")
- (mail-fetch-field "to")
- (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
- (insert ", "))
- (insert (or (message-fetch-reply-field "mail-reply-to")
- (message-fetch-reply-field "reply-to")
- (message-fetch-reply-field "from") "")))
+ (message-carefully-insert-headers
+ (list (cons 'To
+ (or (message-fetch-reply-field "mail-reply-to")
+ (message-fetch-reply-field "reply-to")
+ (message-fetch-reply-field "from")
+ "")))))
+
+(defun message-insert-wide-reply ()
+ "Insert To and Cc headers as if you were doing a wide reply."
+ (interactive)
+ (let ((headers (message-with-reply-buffer
+ (message-get-reply-headers t))))
+ (message-carefully-insert-headers headers)))
+
+(defun message-carefully-insert-headers (headers)
+ (dolist (header headers)
+ (let ((header-name (symbol-name (car header))))
+ (when (and (message-position-on-field header-name)
+ (mail-fetch-field header-name)
+ (not (string-match "\\` *\\'"
+ (mail-fetch-field header-name))))
+ (insert ", "))
+ (insert (cdr header)))))
(defun message-widen-reply ()
"Widen the reply to include maximum recipients."
(message-goto-body)
(int-to-string (count-lines (point) (point-max))))))
+(defun message-make-references ()
+ "Return the References header for this message."
+ (when message-reply-headers
+ (let ((message-id (mail-header-message-id message-reply-headers))
+ (references (mail-header-references message-reply-headers))
+ new-references)
+ (if (or references message-id)
+ (concat (or references "") (and references " ")
+ (or message-id ""))
+ nil))))
+
(defun message-make-in-reply-to ()
"Return the In-Reply-To header for this message."
(when message-reply-headers
(Subject nil)
(Newsgroups nil)
(In-Reply-To (message-make-in-reply-to))
+ (References (message-make-references))
(To nil)
(Distribution (message-make-distribution))
(Lines (message-make-lines))
(message-setup
`((Subject . ,subject)
- ,@follow-to
- ,@(if (or references message-id)
- `((References . ,(concat (or references "") (and references " ")
- (or message-id ""))))
- nil))
+ ,@follow-to)
cur)))
;;;###autoload
(message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
+ (setq message-reply-headers
+ (make-full-mail-header-from-decoded-header
+ 0 subject from date message-id references 0 0 ""))
+
(message-setup
`((Subject . ,subject)
,@follow-to
,@(and mct (list (cons 'Cc mct)))
,@(and distribution (list (cons 'Distribution distribution)))
- ,@(if (or references message-id)
- `((References . ,(concat (or references "") (and references " ")
- (or message-id ""))))))
- cur)
-
- (setq message-reply-headers
- (make-full-mail-header-from-decoded-header
- 0 subject from date message-id references 0 0 ""))))
+ cur)))
;;;###autoload
(defun message-cancel-news (&optional arg)
(message "Viewing with %s" method)
(cond
(needsterm
- (unwind-protect
- (if window-system
- (start-process "*display*" nil
- mm-external-terminal-program
- "-e" shell-file-name
- shell-command-switch
- (mm-mailcap-command
- method file (mm-handle-type handle)))
- (require 'term)
- (require 'gnus-win)
- (set-buffer
- (setq buffer
- (make-term "display"
- shell-file-name
- nil
- shell-command-switch
- (mm-mailcap-command
- method file
- (mm-handle-type handle)))))
- (term-mode)
- (term-char-mode)
- (set-process-sentinel
- (get-buffer-process buffer)
- `(lambda (process state)
- (if (eq 'exit (process-status process))
- (gnus-configure-windows
- ',gnus-current-window-configuration))))
- (gnus-configure-windows 'display-term))
- (mm-handle-set-external-undisplayer handle (cons file buffer)))
- (message "Displaying %s..." (format method file))
+ (let ((command (mm-mailcap-command
+ method file (mm-handle-type handle))))
+ (unwind-protect
+ (if window-system
+ (start-process "*display*" nil
+ mm-external-terminal-program
+ "-e" shell-file-name
+ shell-command-switch command)
+ (require 'term)
+ (require 'gnus-win)
+ (set-buffer
+ (setq buffer
+ (make-term "display"
+ shell-file-name
+ nil
+ shell-command-switch command)))
+ (term-mode)
+ (term-char-mode)
+ (set-process-sentinel
+ (get-buffer-process buffer)
+ `(lambda (process state)
+ (if (eq 'exit (process-status process))
+ (gnus-configure-windows
+ ',gnus-current-window-configuration))))
+ (gnus-configure-windows 'display-term))
+ (mm-handle-set-external-undisplayer handle (cons file buffer)))
+ (message "Displaying %s..." command))
'external)
(copiousoutput
(with-current-buffer outbuf
(ignore-errors (kill-buffer buffer))))))
'inline)
(t
- (unwind-protect
- (start-process "*display*"
- (setq buffer
- (generate-new-buffer " *mm*"))
- shell-file-name
- shell-command-switch
- (mm-mailcap-command
- method file (mm-handle-type handle)))
- (mm-handle-set-external-undisplayer
- handle (cons file buffer)))
- (message "Displaying %s..." (format method file))
+ (let ((command (mm-mailcap-command
+ method file (mm-handle-type handle))))
+ (unwind-protect
+ (start-process "*display*"
+ (setq buffer
+ (generate-new-buffer " *mm*"))
+ shell-file-name
+ shell-command-switch command)
+ (mm-handle-set-external-undisplayer
+ handle (cons file buffer)))
+ (message "Displaying %s..." command))
'external)))))))
(defun mm-mailcap-command (method file type-list)
(beg 0)
(uses-stdin t)
out sub total)
- (while (string-match "%{\\([^}]+\\)}\\|'%s'\\|%s\\|%t\\|%%" method beg)
+ (while (string-match "%{\\([^}]+\\)}\\|'%s'\\|\"%s\"\\|%s\\|%t\\|%%"
+ method beg)
(push (substring method beg (match-beginning 0)) out)
(setq beg (match-end 0)
total (match-string 0 method)
(cond
((string= total "%%")
(push "%" out))
- ((or (string= total "%s") (string= total "'%s'"))
+ ((or (string= total "%s")
+ ;; We do our own quoting.
+ (string= total "'%s'")
+ (string= total "\"%s\""))
(setq uses-stdin nil)
(push (mm-quote-arg
(gnus-map-function mm-path-name-rewrite-functions file)) out))
;; ignore 0x1b, it is part of iso-2022-jp
(setq encoding (mm-body-7-or-8))))
(t
+ ;; Only perform format=flowed filling on text/plain
+ ;; parts where there either isn't a format parameter
+ ;; in the mml tag or it says "flowed" and there
+ ;; actually are hard newlines in the text.
+ (let (use-hard-newlines)
+ (when (and (string= type "text/plain")
+ (or (null (assq 'format cont))
+ (string= (cdr (assq 'format cont))
+ "flowed"))
+ (setq use-hard-newlines
+ (text-property-any
+ (point-min) (point-max) 'hard 't)))
+ (fill-flowed-encode)
+ ;; Indicate that `mml-insert-mime-headers' should
+ ;; insert a "; format=flowed" string unless the
+ ;; user has already specified it.
+ (setq flowed (null (assq 'format cont)))))
(setq charset (mm-encode-body charset))
(setq encoding (mm-body-encoding
charset (cdr (assq 'encoding cont))))))
- ;; Only perform format=flowed filling on text/plain
- ;; parts where there either isn't a format parameter
- ;; in the mml tag or it says "flowed" and there
- ;; actually are hard newlines in the text.
- (let (use-hard-newlines)
- (when (and (string= type "text/plain")
- (or (null (assq 'format cont))
- (string= (cdr (assq 'format cont))
- "flowed"))
- (setq use-hard-newlines
- (text-property-any
- (point-min) (point-max) 'hard 't)))
- (fill-flowed-encode)
- ;; Indicate that `mml-insert-mime-headers' should
- ;; insert a "; format=flowed" string unless the
- ;; user has already specified it.
- (setq flowed (null (assq 'format cont)))))
(setq coded (buffer-string)))
(mml-insert-mime-headers cont type charset encoding flowed)
(insert "\n")
;; Builtin : operation.
((eq (car split) ':)
+ (when nnmail-split-tracing
+ (push split nnmail-split-trace))
(nnmail-split-it (save-excursion (eval (cdr split)))))
;; Builtin ! operation.
(when (nnheader-functionp target)
(setq target (funcall target group)))
(unless (eq target 'delete)
- (gnus-request-accept-article target nil nil t))))
+ (let ((group-art (gnus-request-accept-article target nil nil t)))
+ (when (consp group-art)
+ (gnus-group-mark-article-read target (cdr group-art)))))))
(defun nnmail-fancy-expiry-target (group)
"Returns a target expiry group determined by `nnmail-fancy-expiry-targets'."
* gnus.texi (Loose Threads): add
gnus-summary-make-false-root-always.
+ (Finding the Parent): Change name of nnweb server.
2002-12-22 Jesper Harder <harder@ifa.au.dk>
@lisp
(setq gnus-refer-article-method
'(current
- (nnweb "refer" (nnweb-type google))))
+ (nnweb "google" (nnweb-type google))))
@end lisp
\e$B$[$H$s$I$N%a!<%k%P%C%/%(%s%I$O\e(B @code{Message-ID} \e$B$G$N<hF@$,2DG=$G$9$,!"\e(B
@lisp
(setq gnus-refer-article-method
'(current
- (nnweb "refer" (nnweb-type google))))
+ (nnweb "google" (nnweb-type google))))
@end lisp
Most of the mail back ends support fetching by @code{Message-ID}, but
projects / elisp / gnus.git- / commitdiff