Commit cf5a5c38 authored by Miles Bader's avatar Miles Bader
Browse files

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
parent 60b8fb50
......@@ -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.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment