mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-25 10:47:00 +00:00
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-93
Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 30-34) - Merge from emacs--devo--0 - Update from CVS
This commit is contained in:
Miles Bader
parent
60b8fb50ee
commit
cf5a5c38c6
@ -7,6 +7,39 @@
|
||||
|
||||
* gnus-cus.el: Revert 2005-10-17 change.
|
||||
|
||||
2006-02-16 Katsumi Yamaoka <yamaoka@jpl.org>
|
||||
|
||||
* gnus-art.el (article-strip-banner): Use
|
||||
gnus-extract-address-components instead of
|
||||
mail-header-parse-addresses to make it work with non-ASCII text.
|
||||
|
||||
* rfc2231.el (rfc2231-parse-string): Attempt to parse parameter
|
||||
values which are surrounded with \"...\"; make it never cause a
|
||||
Lisp error; give up parsing of parameters if it failed in
|
||||
extracting type.
|
||||
|
||||
2006-02-15 Katsumi Yamaoka <yamaoka@jpl.org>
|
||||
|
||||
* mm-util.el (mm-make-temp-file): Import the Emacs 22 version of
|
||||
make-temp-file; make it work with Emacs 20 and XEmacs as well.
|
||||
|
||||
* mm-decode.el (mm-display-external): Use the 3rd arg of
|
||||
mm-make-temp-file.
|
||||
(mm-create-image-xemacs): Ditto.
|
||||
|
||||
2006-02-14 Katsumi Yamaoka <yamaoka@jpl.org>
|
||||
|
||||
* gnus-draft.el (gnus-draft-send): Replace message-narrow-to-head
|
||||
with message-narrow-to-headers.
|
||||
(gnus-draft-setup): Narrow to header to run message-fetch-field.
|
||||
(gnus-draft-check-draft-articles): New function.
|
||||
(gnus-draft-edit-message, gnus-draft-send-message): Use it.
|
||||
|
||||
2006-02-13 Katsumi Yamaoka <yamaoka@jpl.org>
|
||||
|
||||
* nnoo.el (nnoo-declare): Don't generate duplicate entries when
|
||||
re-loading nn* modules.
|
||||
|
||||
2006-02-10 Reiner Steib <Reiner.Steib@gmx.de>
|
||||
|
||||
* gnus.el: Remove bogus comment.
|
||||
|
||||
@ -2608,6 +2608,9 @@ always hide."
|
||||
(article-really-strip-banner
|
||||
(gnus-parameter-banner gnus-newsgroup-name)))
|
||||
(when gnus-article-address-banner-alist
|
||||
;; Note that the From header is decoded here, so it is
|
||||
;; required that the *-extract-address-components function
|
||||
;; supports non-ASCII text.
|
||||
(article-really-strip-banner
|
||||
(let ((from (save-restriction
|
||||
(widen)
|
||||
@ -2615,7 +2618,8 @@ always hide."
|
||||
(mail-fetch-field "from"))))
|
||||
(when (and from
|
||||
(setq from
|
||||
(caar (mail-header-parse-addresses from))))
|
||||
(cadr (funcall gnus-extract-address-components
|
||||
from))))
|
||||
(catch 'found
|
||||
(dolist (pair gnus-article-address-banner-alist)
|
||||
(when (string-match (car pair) from)
|
||||
|
||||
@ -98,6 +98,7 @@
|
||||
(interactive)
|
||||
(let ((article (gnus-summary-article-number))
|
||||
(group gnus-newsgroup-name))
|
||||
(gnus-draft-check-draft-articles (list article))
|
||||
(gnus-summary-mark-as-read article gnus-canceled-mark)
|
||||
(gnus-draft-setup article group t)
|
||||
(set-buffer-modified-p t)
|
||||
@ -122,6 +123,7 @@
|
||||
(let* ((articles (gnus-summary-work-articles n))
|
||||
(total (length articles))
|
||||
article)
|
||||
(gnus-draft-check-draft-articles articles)
|
||||
(while (setq article (pop articles))
|
||||
(gnus-summary-remove-process-mark article)
|
||||
(unless (memq article gnus-newsgroup-unsendable)
|
||||
@ -152,7 +154,7 @@
|
||||
;; We read the meta-information that says how and where
|
||||
;; this message is to be sent.
|
||||
(save-restriction
|
||||
(message-narrow-to-head)
|
||||
(message-narrow-to-headers)
|
||||
(when (re-search-forward
|
||||
(concat "^" (regexp-quote gnus-agent-target-move-group-header)
|
||||
":") nil t)
|
||||
@ -258,9 +260,12 @@
|
||||
(goto-char (point-min))
|
||||
(search-forward "\n\n")
|
||||
(forward-char -1)
|
||||
(save-restriction
|
||||
(narrow-to-region (point-min) (point))
|
||||
(setq ga
|
||||
(message-fetch-field gnus-draft-meta-information-header)))
|
||||
(insert mail-header-separator)
|
||||
(forward-line 1)
|
||||
(setq ga (message-fetch-field gnus-draft-meta-information-header))
|
||||
(message-set-auto-save-file-name))))
|
||||
(gnus-backlog-remove-article group narticle)
|
||||
(when (and ga
|
||||
@ -285,6 +290,32 @@
|
||||
"Say whether ARTICLE is sendable."
|
||||
(not (memq article gnus-newsgroup-unsendable)))
|
||||
|
||||
(defun gnus-draft-check-draft-articles (articles)
|
||||
"Check whether the draft articles ARTICLES are under edit."
|
||||
(when (equal gnus-newsgroup-name "nndraft:drafts")
|
||||
(let ((buffers (buffer-list))
|
||||
file buffs buff)
|
||||
(save-current-buffer
|
||||
(while (and articles
|
||||
(not buff))
|
||||
(setq file (nndraft-article-filename (pop articles))
|
||||
buffs buffers)
|
||||
(while buffs
|
||||
(set-buffer (setq buff (pop buffs)))
|
||||
(if (and buffer-file-name
|
||||
(string-equal (file-truename buffer-file-name)
|
||||
(file-truename file))
|
||||
(buffer-modified-p))
|
||||
(setq buffs nil)
|
||||
(setq buff nil)))))
|
||||
(when buff
|
||||
(let* ((window (get-buffer-window buff t))
|
||||
(frame (and window (window-frame window))))
|
||||
(if frame
|
||||
(gnus-select-frame-set-input-focus frame)
|
||||
(pop-to-buffer buff t)))
|
||||
(error "The draft %s is under edit" file)))))
|
||||
|
||||
(provide 'gnus-draft)
|
||||
|
||||
;;; arch-tag: 3d92af58-8c97-4a5c-9db4-a98e85198022
|
||||
|
||||
@ -769,19 +769,18 @@ external if displayed external."
|
||||
(gnus-map-function mm-file-name-rewrite-functions
|
||||
(file-name-nondirectory filename))
|
||||
dir))
|
||||
(setq file (mm-make-temp-file (expand-file-name "mm." dir)))
|
||||
(let ((newname
|
||||
;; Use nametemplate (defined in RFC1524) if it is
|
||||
;; specified in mailcap.
|
||||
(if (assoc "nametemplate" mime-info)
|
||||
(format (cdr (assoc "nametemplate" mime-info)) file)
|
||||
;; Add a suffix according to `mailcap-mime-extensions'.
|
||||
(concat file (car (rassoc (mm-handle-media-type handle)
|
||||
mailcap-mime-extensions))))))
|
||||
(unless (string-equal file newname)
|
||||
(when (file-exists-p file)
|
||||
(rename-file file newname))
|
||||
(setq file newname))))
|
||||
;; Use nametemplate (defined in RFC1524) if it is specified
|
||||
;; in mailcap.
|
||||
(let ((suffix (cdr (assoc "nametemplate" mime-info))))
|
||||
(if (and suffix
|
||||
(string-match "\\`%s\\(\\..+\\)\\'" suffix))
|
||||
(setq suffix (match-string 1 suffix))
|
||||
;; Otherwise, use a suffix according to
|
||||
;; `mailcap-mime-extensions'.
|
||||
(setq suffix (car (rassoc (mm-handle-media-type handle)
|
||||
mailcap-mime-extensions))))
|
||||
(setq file (mm-make-temp-file (expand-file-name "mm." dir)
|
||||
nil suffix))))
|
||||
(let ((coding-system-for-write mm-binary-coding-system))
|
||||
(write-region (point-min) (point-max) file nil 'nomesg))
|
||||
(message "Viewing with %s" method)
|
||||
@ -1312,8 +1311,8 @@ be determined."
|
||||
;; out to a file, and then create a file
|
||||
;; specifier.
|
||||
(let ((file (mm-make-temp-file
|
||||
(expand-file-name "emm.xbm"
|
||||
mm-tmp-directory))))
|
||||
(expand-file-name "emm" mm-tmp-directory)
|
||||
nil ".xbm")))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(write-region (point-min) (point-max) file)
|
||||
|
||||
@ -99,16 +99,6 @@
|
||||
(lambda (ch) (mm-string-as-multibyte (char-to-string ch)))
|
||||
string "")))
|
||||
(multibyte-string-p . ignore)
|
||||
;; It is not a MIME function, but some MIME functions use it.
|
||||
(make-temp-file . (lambda (prefix &optional dir-flag)
|
||||
(let ((file (expand-file-name
|
||||
(make-temp-name prefix)
|
||||
(if (fboundp 'temp-directory)
|
||||
(temp-directory)
|
||||
temporary-file-directory))))
|
||||
(if dir-flag
|
||||
(make-directory file))
|
||||
file)))
|
||||
(insert-byte . insert-char)
|
||||
(multibyte-char-to-unibyte . identity))))
|
||||
|
||||
@ -971,6 +961,77 @@ If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
|
||||
inhibit-file-name-handlers)))
|
||||
(write-region start end filename append visit lockname)))
|
||||
|
||||
;; It is not a MIME function, but some MIME functions use it.
|
||||
(if (and (fboundp 'make-temp-file)
|
||||
(ignore-errors
|
||||
(let ((def (symbol-function 'make-temp-file)))
|
||||
(and (byte-code-function-p def)
|
||||
(setq def (if (fboundp 'compiled-function-arglist)
|
||||
;; XEmacs
|
||||
(eval (list 'compiled-function-arglist def))
|
||||
(aref def 0)))
|
||||
(>= (length def) 4)
|
||||
(eq (nth 3 def) 'suffix)))))
|
||||
(defalias 'mm-make-temp-file 'make-temp-file)
|
||||
;; Stolen (and modified for Emacs 20 and XEmacs) from Emacs 22.
|
||||
(defun mm-make-temp-file (prefix &optional dir-flag suffix)
|
||||
"Create a temporary file.
|
||||
The returned file name (created by appending some random characters at the end
|
||||
of PREFIX, and expanding against `temporary-file-directory' if necessary),
|
||||
is guaranteed to point to a newly created empty file.
|
||||
You can then use `write-region' to write new data into the file.
|
||||
|
||||
If DIR-FLAG is non-nil, create a new empty directory instead of a file.
|
||||
|
||||
If SUFFIX is non-nil, add that at the end of the file name."
|
||||
(let ((umask (default-file-modes))
|
||||
file)
|
||||
(unwind-protect
|
||||
(progn
|
||||
;; Create temp files with strict access rights. It's easy to
|
||||
;; loosen them later, whereas it's impossible to close the
|
||||
;; time-window of loose permissions otherwise.
|
||||
(set-default-file-modes 448)
|
||||
(while (condition-case err
|
||||
(progn
|
||||
(setq file
|
||||
(make-temp-name
|
||||
(expand-file-name
|
||||
prefix
|
||||
(if (fboundp 'temp-directory)
|
||||
;; XEmacs
|
||||
(temp-directory)
|
||||
temporary-file-directory))))
|
||||
(if suffix
|
||||
(setq file (concat file suffix)))
|
||||
(if dir-flag
|
||||
(make-directory file)
|
||||
(if (or (featurep 'xemacs)
|
||||
(= emacs-major-version 20))
|
||||
;; NOTE: This is unsafe if Emacs 20
|
||||
;; users and XEmacs users don't use
|
||||
;; a secure temp directory.
|
||||
(if (file-exists-p file)
|
||||
(signal 'file-already-exists
|
||||
(list "File exists" file))
|
||||
(write-region "" nil file nil 'silent))
|
||||
(write-region "" nil file nil 'silent
|
||||
nil 'excl)))
|
||||
nil)
|
||||
(file-already-exists t)
|
||||
;; The Emacs 20 and XEmacs versions of
|
||||
;; `make-directory' issue `file-error'.
|
||||
(file-error (or (and (or (featurep 'xemacs)
|
||||
(= emacs-major-version 20))
|
||||
(file-exists-p file))
|
||||
(signal (car err) (cdr err)))))
|
||||
;; the file was somehow created by someone else between
|
||||
;; `make-temp-name' and `write-region', let's try again.
|
||||
nil)
|
||||
file)
|
||||
;; Reset the umask.
|
||||
(set-default-file-modes umask)))))
|
||||
|
||||
(defun mm-image-load-path (&optional package)
|
||||
(let (dir result)
|
||||
(dolist (path load-path (nreverse result))
|
||||
|
||||
@ -61,12 +61,16 @@
|
||||
|
||||
(defmacro nnoo-declare (backend &rest parents)
|
||||
`(eval-and-compile
|
||||
(push (list ',backend
|
||||
(mapcar (lambda (p) (list p)) ',parents)
|
||||
nil nil)
|
||||
nnoo-definition-alist)
|
||||
(push (list ',backend "*internal-non-initialized-backend*")
|
||||
nnoo-state-alist)))
|
||||
(if (assq ',backend nnoo-definition-alist)
|
||||
(setcar (cdr (assq ',backend nnoo-definition-alist))
|
||||
(mapcar 'list ',parents))
|
||||
(push (list ',backend
|
||||
(mapcar 'list ',parents)
|
||||
nil nil)
|
||||
nnoo-definition-alist))
|
||||
(unless (assq ',backend nnoo-state-alist)
|
||||
(push (list ',backend "*internal-non-initialized-backend*")
|
||||
nnoo-state-alist))))
|
||||
(put 'nnoo-declare 'lisp-indent-function 1)
|
||||
|
||||
(defun nnoo-parents (backend)
|
||||
|
||||
@ -47,15 +47,45 @@ The list will be on the form
|
||||
`(name (attribute . value) (attribute . value)...)'.
|
||||
|
||||
If the optional SIGNAL-ERROR is non-nil, signal an error when this
|
||||
function fails in parsing of parameters."
|
||||
function fails in parsing of parameters. Otherwise, this function
|
||||
must never cause a Lisp error."
|
||||
(with-temp-buffer
|
||||
(let ((ttoken (ietf-drums-token-to-list ietf-drums-text-token))
|
||||
(stoken (ietf-drums-token-to-list ietf-drums-tspecials))
|
||||
(ntoken (ietf-drums-token-to-list "0-9"))
|
||||
c type attribute encoded number prev-attribute vals
|
||||
prev-encoded parameters value)
|
||||
(ietf-drums-init (mail-header-remove-whitespace
|
||||
(mail-header-remove-comments string)))
|
||||
(ietf-drums-init
|
||||
(condition-case nil
|
||||
(mail-header-remove-whitespace
|
||||
(mail-header-remove-comments string))
|
||||
;; The most likely cause of an error is unbalanced parentheses
|
||||
;; or double-quotes. If all parentheses and double-quotes are
|
||||
;; quoted meaninglessly with backslashes, removing them might
|
||||
;; make it parseable. Let's try...
|
||||
(error
|
||||
(let (mod)
|
||||
(when (and (string-match "\\\\\"" string)
|
||||
(not (string-match "\\`\"\\|[^\\]\"" string)))
|
||||
(setq string (mm-replace-in-string string "\\\\\"" "\"")
|
||||
mod t))
|
||||
(when (and (string-match "\\\\(" string)
|
||||
(string-match "\\\\)" string)
|
||||
(not (string-match "\\`(\\|[^\\][()]" string)))
|
||||
(setq string (mm-replace-in-string string "\\\\\\([()]\\)" "\\1")
|
||||
mod t))
|
||||
(or (and mod
|
||||
(ignore-errors
|
||||
(mail-header-remove-whitespace
|
||||
(mail-header-remove-comments string))))
|
||||
;; Finally, attempt to extract only type.
|
||||
(if (string-match
|
||||
(concat "\\`[\t\n ]*\\([^" ietf-drums-tspecials "\t\n ]+"
|
||||
"\\(/[^" ietf-drums-tspecials
|
||||
"\t\n ]+\\)?\\)\\([\t\n ;]\\|\\'\\)")
|
||||
string)
|
||||
(match-string 1 string)
|
||||
""))))))
|
||||
(let ((table (copy-syntax-table ietf-drums-syntax-table)))
|
||||
(modify-syntax-entry ?\' "w" table)
|
||||
(modify-syntax-entry ?* " " table)
|
||||
@ -67,9 +97,12 @@ function fails in parsing of parameters."
|
||||
(set-syntax-table table))
|
||||
(setq c (char-after))
|
||||
(when (and (memq c ttoken)
|
||||
(not (memq c stoken)))
|
||||
(setq type (downcase (buffer-substring
|
||||
(point) (progn (forward-sexp 1) (point)))))
|
||||
(not (memq c stoken))
|
||||
(setq type (ignore-errors
|
||||
(downcase
|
||||
(buffer-substring (point) (progn
|
||||
(forward-sexp 1)
|
||||
(point)))))))
|
||||
;; Do the params
|
||||
(condition-case err
|
||||
(progn
|
||||
@ -180,8 +213,7 @@ function fails in parsing of parameters."
|
||||
;;(message "%s" (error-message-string err))
|
||||
)))
|
||||
|
||||
(when type
|
||||
`(,type ,@(nreverse parameters)))))))
|
||||
(cons type (nreverse parameters))))))
|
||||
|
||||
(defun rfc2231-decode-encoded-string (string)
|
||||
"Decode an RFC2231-encoded string.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user