diff options
Diffstat (limited to 'lisp/gnus')
| -rw-r--r-- | lisp/gnus/ChangeLog | 66 | ||||
| -rw-r--r-- | lisp/gnus/gnus-art.el | 60 | ||||
| -rw-r--r-- | lisp/gnus/gnus-uu.el | 8 | ||||
| -rw-r--r-- | lisp/gnus/message.el | 18 | ||||
| -rw-r--r-- | lisp/gnus/mm-bodies.el | 5 | ||||
| -rw-r--r-- | lisp/gnus/mm-decode.el | 31 | ||||
| -rw-r--r-- | lisp/gnus/mml.el | 54 | ||||
| -rw-r--r-- | lisp/gnus/sieve-manage.el | 12 |
8 files changed, 193 insertions, 61 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 7bc733ad90f..9f5ee5e1e33 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,8 +1,74 @@ +2005-08-05 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-bodies.el (mm-encode-body): Use coding system rather than + charset to encode text. + + * mm-util.el (mm-find-mime-charset-region): Attempt to reduce the + number of charsets if utf-8 is available (XEmacs). + +2005-08-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-art.el (article-unsplit-urls): Don't anchor urls to the + start of the lines. + (gnus-picon-databases): Add /usr/share/picons. + +2005-08-04 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-art.el (gnus-button-valid-localpart-regexp): New variable + taken from `gnus-button-mid-or-mail-regexp'. + (gnus-button-mid-or-mail-regexp, gnus-button-alist): Use it. + (gnus-button-alist): Improve regexp for domain part of the MIDs + for news:localpart@domain buttons. + (gnus-button-ctan-directory-regexp): Update. + + * message.el (message-kill-buffer): Raise the current frame. + (message-bury): Use `window-dedicated-p'. + +2005-08-02 Katsumi Yamaoka <yamaoka@jpl.org> + + * sieve-manage.el (sieve-manage-interactive-login): Use + make-local-variable rather than make-variable-buffer-local. + (sieve-manage-open): Ditto. + (sieve-manage-authenticate): Ditto. + + * mml.el (mml-generate-mime-1): Make the content type default to + text/plain if the filename is not specified. + +2005-08-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-uu.el (gnus-uu-save-article): Use insert-buffer-substring + instead of insert-buffer. + + * message.el (message-yank-original): Ditto; set the mark at the + end of the yanked message. + +2005-07-29 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-next-page-1): Reduce the number of + lines to scroll rather than to stop it. + + * mml.el (mml-generate-default-type): Add doc string. + (mml-generate-mime-1): Use mm-default-file-encoding or make it + default to application/octet-stream when determining the content + type if it is not specified for the part or the mml contents; add + a comment about mml-generate-default-type. + +2005-07-29 Reiner Steib <Reiner.Steib@gmx.de> + + * mml.el (mml-generate-mime-1): Use mm-default-file-encoding or + make it default to application/octet-stream when determining the + content type if it is not specified for the external contents. + 2005-07-28 Katsumi Yamaoka <yamaoka@jpl.org> * rfc2231.el (rfc2231-parse-string): Take care that not only a segmented parameter but also other parameters might be there. +2005-07-27 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-decode.el (mm-display-external): Delete temp file, directory + and buffer immediately if the external process is exited. + 2005-07-26 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-art.el (gnus-article-next-page-1): Don't scroll if there're diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index f7e3420e922..0d8116b00b9 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -842,7 +842,8 @@ be controlled by `gnus-treat-body-boundary'." :type '(choice (item :tag "None" :value nil) string)) -(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces") +(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces" + "/usr/share/picons") "Defines the location of the faces database. For information on obtaining this database of pretty pictures, please see http://www.cs.indiana.edu/picons/ftp/index.html" @@ -2428,7 +2429,7 @@ If READ-CHARSET, ask for a coding system." (let ((inhibit-read-only t)) (goto-char (point-min)) (while (re-search-forward - "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) + "\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) (replace-match "\\1\\3" t))) (when (interactive-p) (gnus-treat-article nil)))) @@ -5197,17 +5198,23 @@ specifies." 1 0))))))) (defun gnus-article-next-page-1 (lines) - (unless (and (not (featurep 'xemacs)) - (> (symbol-value 'scroll-margin) 0) - (<= (count-lines (window-start) (point-max)) - (symbol-value 'scroll-margin))) - (condition-case () - (let ((scroll-in-place nil)) - (scroll-up lines)) - (end-of-buffer - ;; Long lines may cause an end-of-buffer error. - (goto-char (point-max)))) - (gnus-article-beginning-of-window))) + (when (and (not (featurep 'xemacs)) + (numberp lines) + (> lines 0) + (numberp (symbol-value 'scroll-margin)) + (> (symbol-value 'scroll-margin) 0)) + ;; Protect against the bug that Emacs 21.x hangs up when scrolling up for + ;; too many number of lines if `scroll-margin' is set as two or greater. + (setq lines (min lines + (max 0 (- (count-lines (window-start) (point-max)) + (symbol-value 'scroll-margin)))))) + (condition-case () + (let ((scroll-in-place nil)) + (scroll-up lines)) + (end-of-buffer + ;; Long lines may cause an end-of-buffer error. + (goto-char (point-max)))) + (gnus-article-beginning-of-window)) (defun gnus-article-prev-page (&optional lines) "Show previous page of current article. @@ -5880,6 +5887,14 @@ groups." :group 'gnus-article-buttons :type 'regexp) +;; Regexp suggested by Felix Wiemann in <87oeuomcz9.fsf@news2.ososo.de> +(defcustom gnus-button-valid-localpart-regexp + "[a-z0-9$%(*-=?[_][^<>\")!;:,{}\n\t ]*" + "Regular expression that matches a localpart of mail addresses or MIDs." + :version "22.1" + :group 'gnus-article-buttons + :type 'regexp) + (defcustom gnus-button-man-handler 'manual-entry "Function to use for displaying man pages. The function must take at least one argument with a string naming the @@ -5919,12 +5934,11 @@ The function must take one argument, the string naming the URL." (regexp :tag "Other"))) (defcustom gnus-button-ctan-directory-regexp - (concat - "\\("; Cannot use `\(?: ... \)' (compatibility with Emacs 20). - "biblio\\|digests\\|dviware\\|fonts\\|graphics\\|help\\|" - "indexing\\|info\\|language\\|macros\\|support\\|systems\\|" - "tds\\|tools\\|usergrps\\|web\\|nonfree\\|obsolete" - "\\)") + (regexp-opt + (list "archive-tools" "biblio" "bibliography" "digests" "documentation" + "dviware" "fonts" "graphics" "help" "indexing" "info" "language" + "languages" "macros" "nonfree" "obsolete" "support" "systems" + "tds" "tools" "usergrps" "web") t) "Regular expression for ctan directories. It should match all directories in the top level of `gnus-ctan-url'." :version "22.1" @@ -5932,8 +5946,7 @@ It should match all directories in the top level of `gnus-ctan-url'." :type 'regexp) (defcustom gnus-button-mid-or-mail-regexp - (concat "\\b\\(<?[a-z0-9$%(*-=?[_][^<>\")!;:,{}\n\t ]*@" - ;; Felix Wiemann in <87oeuomcz9.fsf@news2.ososo.de> + (concat "\\b\\(<?" gnus-button-valid-localpart-regexp "@" gnus-button-valid-fqdn-regexp ">?\\)\\b") "Regular expression that matches a message ID or a mail address." @@ -6248,8 +6261,9 @@ positives are possible." (defcustom gnus-button-alist '(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 (>= gnus-button-message-level 0) gnus-button-handle-news 3) - ("\\b\\(nntp\\|news\\):\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t - gnus-button-handle-news 2) + ((concat "\\b\\(nntp\\|news\\):\\(" + gnus-button-valid-localpart-regexp "@[a-z0-9.-]+[a-z]\\)") + 0 t gnus-button-handle-news 2) ("\\(\\b<\\(url:[>\n\t ]*\\)?\\(nntp\\|news\\):[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 (>= gnus-button-message-level 0) gnus-button-fetch-group 5) ("\\b\\(nntp\\|news\\):\\(//\\)?\\([^'\">\n\t ]+\\)" diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 5bdd17f84c1..4a7d5fec422 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -917,16 +917,16 @@ When called interactively, prompt for REGEXP." (if (and message-forward-as-mime gnus-uu-digest-buffer) (with-current-buffer gnus-uu-digest-buffer (erase-buffer) - (insert-buffer "*gnus-uu-pre*") + (insert-buffer-substring "*gnus-uu-pre*") (goto-char (point-max)) - (insert-buffer "*gnus-uu-body*")) + (insert-buffer-substring "*gnus-uu-body*")) (save-excursion (set-buffer "*gnus-uu-pre*") (insert (format "\n\n%s\n\n" (make-string 70 ?-))) (if gnus-uu-digest-buffer (with-current-buffer gnus-uu-digest-buffer (erase-buffer) - (insert-buffer "*gnus-uu-pre*")) + (insert-buffer-substring "*gnus-uu-pre*")) (let ((coding-system-for-write mm-text-coding-system)) (gnus-write-buffer gnus-uu-saved-article-name)))) (save-excursion @@ -939,7 +939,7 @@ When called interactively, prompt for REGEXP." (if gnus-uu-digest-buffer (with-current-buffer gnus-uu-digest-buffer (goto-char (point-max)) - (insert-buffer "*gnus-uu-body*")) + (insert-buffer-substring "*gnus-uu-body*")) (let ((coding-system-for-write mm-text-coding-system) (file-name-coding-system nnmail-pathname-coding-system)) (write-region diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 931ac30e8a6..62266580a20 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -3206,7 +3206,9 @@ prefix, and don't delete any headers." (when (and message-reply-buffer message-cite-function) (delete-windows-on message-reply-buffer t) - (insert-buffer message-reply-buffer) + (push-mark (save-excursion + (insert-buffer-substring message-reply-buffer) + (point))) (unless arg (funcall message-cite-function)) (message-exchange-point-and-mark) @@ -3416,8 +3418,15 @@ Instead, just auto-save the buffer and then bury it." (file-exists-p auto-save-file-name)) (and file-name (file-exists-p file-name))) - (yes-or-no-p (format "Remove the backup file%s? " - (if modified " too" "")))) + (progn + ;; If the message buffer has lived in a dedicated window, + ;; `kill-buffer' has killed the frame. Thus the + ;; `yes-or-no-p' may show up in a lowered frame. Make sure + ;; that the user can see the question by raising the + ;; current frame: + (raise-frame) + (yes-or-no-p (format "Remove the backup file%s? " + (if modified " too" ""))))) (ignore-errors (delete-file auto-save-file-name)) (let ((message-draft-article draft-article)) @@ -3428,8 +3437,7 @@ Instead, just auto-save the buffer and then bury it." "Bury this mail BUFFER." (let ((newbuf (other-buffer buffer))) (bury-buffer buffer) - (if (and (fboundp 'frame-parameters) - (cdr (assq 'dedicated (frame-parameters))) + (if (and (window-dedicated-p (selected-window)) (not (null (delq (selected-frame) (visible-frame-list))))) (delete-frame (selected-frame)) (switch-to-buffer newbuf)))) diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index 3e9766c3d41..b4debfe718f 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -1,6 +1,6 @@ ;;; mm-bodies.el --- Functions for decoding MIME things -;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2004 +;; Copyright (C) 1998, 1999, 2000, 2001, 2003, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -95,7 +95,8 @@ If no encoding was done, nil is returned." (save-excursion (if charset (progn - (mm-encode-coding-region (point-min) (point-max) charset) + (mm-encode-coding-region (point-min) (point-max) + (mm-charset-to-coding-system charset)) charset) (goto-char (point-min)) (let ((charsets (mm-find-mime-charset-region (point-min) (point-max)))) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 601843dcf55..c65d5f80ba4 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -817,11 +817,32 @@ external if displayed external." (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) + (progn + (start-process "*display*" + (setq buffer + (generate-new-buffer " *mm*")) + shell-file-name + shell-command-switch command) + (set-process-sentinel + (get-buffer-process buffer) + `(lambda (process state) + (when (eq 'exit (process-status process)) + ;; Don't use `ignore-errors'. + (condition-case nil + (delete-file ,file) + (error)) + (condition-case nil + (delete-directory ,(file-name-directory file)) + (error)) + (condition-case nil + (kill-buffer ,buffer) + (error)) + (condition-case nil + ,(macroexpand (list 'mm-handle-set-undisplayer + (list 'quote handle) + nil)) + (error)) + (message "Displaying %s...done" ,command))))) (mm-handle-set-external-undisplayer handle (cons file buffer))) (message "Displaying %s..." command)) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index a44a4560cf8..6fd4aeb40b1 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -123,7 +123,13 @@ unknown encoding; `use-ascii': always use ASCII for those characters with unknown encoding; `multipart': always send messages with more than one charsets.") -(defvar mml-generate-default-type "text/plain") +(defvar mml-generate-default-type "text/plain" + "Content type by which the Content-Type header can be omitted. +The Content-Type header will not be put in the MIME part if the type +equals the value and there's no parameter (e.g. charset, format, etc.) +and `mml-insert-mime-headers-always' is nil. The value will be bound +to \"message/rfc822\" when encoding an article to be forwarded as a MIME +part. This is for the internal use, you should never modify the value.") (defvar mml-buffer-list nil) @@ -399,9 +405,14 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (mml-tweak-part cont) (cond ((or (eq (car cont) 'part) (eq (car cont) 'mml)) - (let ((raw (cdr (assq 'raw cont))) - coded encoding charset filename type flowed) - (setq type (or (cdr (assq 'type cont)) "text/plain")) + (let* ((raw (cdr (assq 'raw cont))) + (filename (cdr (assq 'filename cont))) + (type (or (cdr (assq 'type cont)) + (if filename + (or (mm-default-file-encoding filename) + "application/octet-stream") + "text/plain"))) + coded encoding charset flowed) (if (and (not raw) (member (car (split-string type "/")) '("text" "message"))) (progn @@ -413,7 +424,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (cond ((cdr (assq 'buffer cont)) (insert-buffer-substring (cdr (assq 'buffer cont)))) - ((and (setq filename (cdr (assq 'filename cont))) + ((and filename (not (equal (cdr (assq 'nofile cont)) "yes"))) (let ((coding-system-for-read charset)) (mm-insert-file-contents filename))) @@ -433,6 +444,10 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (cond ((eq (car cont) 'mml) (let ((mml-boundary (mml-compute-boundary cont)) + ;; It is necessary for the case where this + ;; function is called recursively since + ;; `m-g-d-t' will be bound to "message/rfc822" + ;; when encoding an article to be forwarded. (mml-generate-default-type "text/plain")) (mml-to-mime)) (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b"))) @@ -474,7 +489,7 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (insert (with-current-buffer (cdr (assq 'buffer cont)) (mm-with-unibyte-current-buffer (buffer-string))))) - ((and (setq filename (cdr (assq 'filename cont))) + ((and filename (not (equal (cdr (assq 'nofile cont)) "yes"))) (let ((coding-system-for-read mm-binary-coding-system)) (mm-insert-file-contents filename nil nil nil nil t))) @@ -515,15 +530,21 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." "access-type=url")) (when parameters (mml-insert-parameter-string - cont '(expiration size permission)))) - (insert "\n\n") - (insert "Content-Type: " (cdr (assq 'type cont)) "\n") - (insert "Content-ID: " (message-make-message-id) "\n") - (insert "Content-Transfer-Encoding: " - (or (cdr (assq 'encoding cont)) "binary")) - (insert "\n\n") - (insert (or (cdr (assq 'contents cont)))) - (insert "\n")) + cont '(expiration size permission))) + (insert "\n\n") + (insert "Content-Type: " + (or (cdr (assq 'type cont)) + (if name + (or (mm-default-file-encoding name) + "application/octet-stream") + "text/plain")) + "\n") + (insert "Content-ID: " (message-make-message-id) "\n") + (insert "Content-Transfer-Encoding: " + (or (cdr (assq 'encoding cont)) "binary")) + (insert "\n\n") + (insert (or (cdr (assq 'contents cont)))) + (insert "\n"))) ((eq (car cont) 'multipart) (let* ((type (or (cdr (assq 'type cont)) "mixed")) (mml-generate-default-type (if (equal type "digest") @@ -559,7 +580,8 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (message-options-set 'message-sender sender)) (if (setq recipients (cdr (assq 'recipients cont))) (message-options-set 'message-recipients recipients)) - (let ((style (mml-signencrypt-style (first (or sign-item encrypt-item))))) + (let ((style (mml-signencrypt-style + (first (or sign-item encrypt-item))))) ;; check if: we're both signing & encrypting, both methods ;; are the same (why would they be different?!), and that ;; the signencrypt style allows for combined operation. diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el index 2afa49c79a7..5c0712420a0 100644 --- a/lisp/gnus/sieve-manage.el +++ b/lisp/gnus/sieve-manage.el @@ -1,5 +1,5 @@ ;;; sieve-manage.el --- Implementation of the managesive protocol in elisp -;; Copyright (C) 2001, 2003 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2003, 2005 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon@josefsson.org> @@ -184,8 +184,8 @@ LOGINFUNC is passed a username and a password, it should return t if it where sucessful authenticating itself to the server, nil otherwise. Returns t if login was successful, nil otherwise." (with-current-buffer buffer - (make-variable-buffer-local 'sieve-manage-username) - (make-variable-buffer-local 'sieve-manage-password) + (make-local-variable 'sieve-manage-username) + (make-local-variable 'sieve-manage-password) (let (user passwd ret reason) ;; (condition-case () (while (or (not user) (not passwd)) @@ -370,7 +370,7 @@ Optional variable BUFFER is buffer (buffer, or string naming buffer) to work in." (setq buffer (or buffer (format " *sieve* %s:%d" server (or port 2000)))) (with-current-buffer (get-buffer-create buffer) - (mapcar 'make-variable-buffer-local sieve-manage-local-variables) + (mapcar 'make-local-variable sieve-manage-local-variables) (sieve-manage-disable-multibyte) (buffer-disable-undo) (setq sieve-manage-server (or server sieve-manage-server)) @@ -458,8 +458,8 @@ password is remembered in the buffer." (with-current-buffer (or buffer (current-buffer)) (if (not (eq sieve-manage-state 'nonauth)) (eq sieve-manage-state 'auth) - (make-variable-buffer-local 'sieve-manage-username) - (make-variable-buffer-local 'sieve-manage-password) + (make-local-variable 'sieve-manage-username) + (make-local-variable 'sieve-manage-password) (if user (setq sieve-manage-username user)) (if passwd (setq sieve-manage-password passwd)) (if (funcall (nth 2 (assq sieve-manage-auth |