* 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.
(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)
(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)
(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)
(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)
;; 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)
(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
"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
(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)
;; 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)
(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))))
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))
(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)
`(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)
(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
;;(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.
projects / emacs.git / commitdiff