+Fri Dec 4 04:09:15 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.63 is released.
+
+1998-12-04 04:59:20 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mml.el (mml-base-boundary): Shorten.
+
+ * message.el (message-insert-mime-part): Use default.
+
+ * gnus-art.el (gnus-insert-mime-button): Bind gnus-tmp-type-long.
+
+1998-12-03 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * gnus-art.el (gnus-mime-display-alternative): Use (*) for radio
+ buttons, not [*].
+
+1998-12-04 Hrvoje Niksic <hniksic@srce.hr>
+
+ * gnus-art.el (gnus-insert-mime-button): Do proper help-echo.
+
+1998-12-04 04:48:37 Hrvoje Niksic <hniksic@srce.hr>
+
+ * gnus-art.el (gnus-insert-mime-button): Fix.
+
+1998-12-03 Hrvoje Niksic <hniksic@srce.hr>
+
+ * message.el (message-insert-mime-part): Nicify prompts.
+ (message-insert-mime-part): Really delete duplicates.
+ (message-insert-mime-part): Check against common errors.
+ (message-insert-mime-part): Fix docstring.
+
+1998-12-04 04:41:58 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-mime-internalize-part): Bugged out.
+
+1998-12-03 Hrvoje Niksic <hniksic@srce.hr>
+
+ * gnus-art.el (gnus-mime-button-line-format): Nicify.
+ (gnus-insert-mime-button): Modify accordingly.
+
+1998-12-04 01:50:53 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-art.el (gnus-display-mime): Set window point.
+
+ * mm-decode.el (mm-display-external): Only decode when not
+ saving.
+ (mm-alternative-precedence): Prefer multiparts.
+ (mm-inline-media-tests): Inline multiparts.
+
+ * gnus-picon.el (gnus-picons-next-job-internal): Do bar if asked.
+ Ignore errors when requiring url.
+
+ * mml.el (mml-quote-region): New command.
+
+ * message.el (message-cite-original): Use it.
+ (message-cite-original-without-signature): Ditto.
+
Thu Dec 3 12:53:58 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.62 is released.
* mm-encode.el (mm-content-transfer-encoding-defaults): Default
application/emacs-lisp to 8bit.
+1998-12-03 Dale Hagglund <rdh@best.com>
+
+ * mm-decode.el (mm-quote-arg): Add quoting of '()', '<>', and '|'.
+
Wed Dec 2 20:24:27 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.61 is released.
;;; Gnus MIME viewing functions
;;;
-(defvar gnus-mime-button-line-format "%{%([%p. %t%d%n]%)%}%e\n"
+(defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n"
"The following specs can be used:
%t The MIME type
+%T MIME type, along with additional info
%n The `name' parameter
%d The description, if any
%l The length of the encoded part
-%p The part identifier
+%p The part identifier number
%e Dots if the part isn't displayed")
(defvar gnus-mime-button-line-format-alist
'((?t gnus-tmp-type ?s)
+ (?T gnus-tmp-type-long ?s)
(?n gnus-tmp-name ?s)
(?d gnus-tmp-description ?s)
(?p gnus-tmp-id ?s)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(url-standalone-mode (not gnus-plugged))
- (mm-user-display-methods '(".*"))
+ (mm-user-display-methods '((".*" . inline)))
+ (mm-all-images-fit t)
(rfc2047-default-charset gnus-newsgroup-default-charset)
(mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced))
(if (mm-handle-undisplayer handle)
(goto-char point))))
(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
- (let ((gnus-tmp-name (mail-content-type-get (mm-handle-type handle) 'name))
- (filename (mail-content-type-get (mm-handle-disposition handle)
- 'filename))
+ (let ((gnus-tmp-name
+ (or (mail-content-type-get (mm-handle-type handle)
+ 'name)
+ (mail-content-type-get (mm-handle-disposition handle)
+ 'filename)
+ ""))
(gnus-tmp-type (car (mm-handle-type handle)))
- (gnus-tmp-description (mm-handle-description handle))
+ (gnus-tmp-description (or (mm-handle-description handle)
+ ""))
(gnus-tmp-dots
(if (if displayed (car displayed)
(mm-handle-displayed-p handle))
"" "..."))
- (gnus-tmp-length (save-excursion
- (set-buffer (mm-handle-buffer handle))
+ (gnus-tmp-length (with-current-buffer (mm-handle-buffer handle)
(buffer-size)))
- b e)
- (setq gnus-tmp-name (or gnus-tmp-name filename))
- (setq gnus-tmp-name
- (if gnus-tmp-name
- (concat " (" gnus-tmp-name ")")
- ""))
- (setq gnus-tmp-description
- (if gnus-tmp-description
- (concat " (" gnus-tmp-description ")")
- ""))
+ gnus-tmp-type-long b e)
+ (setq gnus-tmp-type-long (concat gnus-tmp-type
+ (and (not (equal gnus-tmp-name ""))
+ (concat "; " gnus-tmp-name))))
+ (or (equal gnus-tmp-description "")
+ (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
(unless (bolp)
(insert "\n"))
(setq b (point))
article-type annotation
gnus-data ,handle))
(setq e (point))
- (widget-convert-button 'link b e :action 'gnus-widget-press-button
- :button-keymap gnus-mime-button-map)))
+ (widget-convert-button 'link b e
+ :mime-handle handle
+ :action 'gnus-widget-press-button
+ :button-keymap gnus-mime-button-map
+ :help-echo
+ (lambda (widget)
+ ;; Needed to properly clear the message
+ ;; due to a bug in wid-edit
+ (setq help-echo-owns-message t)
+ (format
+ "Click to %s the MIME part; %s for more options"
+ (if (mm-handle-displayed-p
+ (widget-get widget :mime-handle))
+ "hide" "show")
+ (if gnus-xemacs "button3" "mouse-3"))))))
(defun gnus-widget-press-button (elems el)
(goto-char (widget-get elems :from))
"Insert MIME buttons in the buffer."
(save-excursion
(save-selected-window
- (let ((window (get-buffer-window gnus-article-buffer)))
+ (let ((window (get-buffer-window gnus-article-buffer))
+ (point (point)))
(when window
- (select-window window)))
+ (select-window window)
+ ;; We have to do this since selecting the window
+ ;; may change the point. So we set the window point.
+ (set-window-point window point)))
(let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect)))
handle name type b e display)
(unless ihandles
(gnus-add-text-properties
(setq from (point))
(progn
- (insert (format "[%c] %-18s"
+ (insert (format "(%c) %-18s"
(if (equal handle preferred) ?* ? )
(if (stringp (car handle))
(car handle)
;;; Query a remote DB. This requires some stuff from w3 !
-(require 'url)
-(require 'w3-forms)
+(eval-and-compile
+ (ignore-errors
+ (require 'url)
+ (require 'w3-forms)))
(defun gnus-picons-url-retrieve (url fn arg)
(let ((old-asynch (default-value 'url-be-asynchronous))
;;; Main jobs dispatcher function
(defun gnus-picons-next-job-internal ()
- (if (setq gnus-picons-job-already-running (pop gnus-picons-jobs-alist))
- (let* ((job gnus-picons-job-already-running)
- (sym-ann (pop job))
- (tag (pop job)))
- (if tag
- (cond ((stringp tag);; (SYM-ANN "..." RIGHT-P)
- (gnus-picons-network-display-internal sym-ann nil tag
- (pop job)))
- ((and (eq 'bar tag)
- gnus-picons-display-article-move-p)
- (gnus-picons-network-display-internal
- sym-ann
- (let ((gnus-picons-file-suffixes '("xbm")))
- (gnus-picons-try-face
- gnus-xmas-glyph-directory "bar."))
- nil (pop job)))
- ((eq 'search tag);; (SYM-ANN 'search USER ADDRS DBS RIGHT-P)
- (gnus-picons-network-search
- (pop job) (pop job) (pop job) sym-ann (pop job)))
- ((eq 'picon tag);; (SYM-ANN 'picon URL PART RIGHT-P)
- (gnus-picons-network-display
- (pop job) (pop job) sym-ann (pop job)))
- (t (setq gnus-picons-job-already-running nil)
- (error "Unknown picon job tag %s" tag)))))))
+ (when (setq gnus-picons-job-already-running (pop gnus-picons-jobs-alist))
+ (let* ((job gnus-picons-job-already-running)
+ (sym-ann (pop job))
+ (tag (pop job)))
+ (when tag
+ (cond
+ ((stringp tag);; (SYM-ANN "..." RIGHT-P)
+ (gnus-picons-network-display-internal
+ sym-ann nil tag (pop job)))
+ ((eq 'bar tag)
+ (gnus-picons-network-display-internal
+ sym-ann
+ (let ((gnus-picons-file-suffixes '("xbm")))
+ (gnus-picons-try-face
+ gnus-xmas-glyph-directory "bar."))
+ nil (pop job)))
+ ((eq 'search tag);; (SYM-ANN 'search USER ADDRS DBS RIGHT-P)
+ (gnus-picons-network-search
+ (pop job) (pop job) (pop job) sym-ann (pop job)))
+ ((eq 'picon tag);; (SYM-ANN 'picon URL PART RIGHT-P)
+ (gnus-picons-network-display
+ (pop job) (pop job) sym-ann (pop job)))
+ (t
+ (setq gnus-picons-job-already-running nil)
+ (error "Unknown picon job tag %s" tag)))))))
(defun gnus-picons-next-job ()
"Start processing the job queue if it is not in progress."
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.62"
+(defconst gnus-version-number "0.63"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
(define-key message-mode-map "\C-c\C-a" 'message-insert-mime-part)
(define-key message-mode-map "\C-c\C-m\C-a" 'message-insert-mime-part)
(define-key message-mode-map "\C-c\C-m\C-e" 'message-mime-insert-external)
-
+ (define-key message-mode-map "\C-c\C-m\C-q" 'mml-quote-region)
+
(define-key message-mode-map "\t" 'message-tab))
(easy-menu-define
(if (listp message-indent-citation-function)
message-indent-citation-function
(list message-indent-citation-function)))))
- (goto-char start)
- ;; Quote parts.
- (while (re-search-forward "<#/?!*\\(multipart\\|part\\|external\\)" end t)
- (goto-char (match-beginning 1))
- (insert "!"))
+ (mml-quote-region start end)
(goto-char end)
(when (re-search-backward "^-- $" start t)
;; Also peel off any blank lines before the signature.
(if (listp message-indent-citation-function)
message-indent-citation-function
(list message-indent-citation-function)))))
- (goto-char start)
- ;; Quote parts.
- (while (re-search-forward
- "<#/?!*\\(multipart\\|part\\|external\\)" end t)
- (goto-char (match-beginning 1))
- (insert "!"))
+ (mml-quote-region start end)
(goto-char start)
(while functions
(funcall (pop functions)))
;;; MIME functions
;;;
+
+;; I really think this function should be renamed. It is only useful
+;; for inserting file attachments.
+
(defun message-insert-mime-part (file type description)
- "Insert a multipart/alternative part into the buffer."
+ "Attach a file to the outgoing MIME message.
+The file is not inserted or encoded until you send the message with
+`\\[message-send-and-exit]' or `\\[message-send]'.
+
+FILE is the name of the file to attach. TYPE is its content-type, a
+string of the form \"type/subtype\". DESCRIPTION is a one-line
+description of the attachment."
(interactive
- (let* ((file (read-file-name "Insert file: " nil nil t))
- (type (mm-default-file-encoding file)))
- (list file
- (completing-read
- (format "MIME type for %s: " file)
- (delete-duplicates
- (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions))
- nil nil type)
- (read-string "Description: "))))
- (insert (format "<#part type=%s filename=\"%s\"%s><#/part>\n"
- type file
- (if (zerop (length description))
- ""
- (format " description=%s"
- (prin1-to-string description))))))
+ (let* ((file (read-file-name "Attach file: " nil nil t))
+ (type (completing-read
+ (format "Content type (default %s): "
+ (or (mm-default-file-encoding file)
+ ;; Perhaps here we should check
+ ;; what the file looks like, and
+ ;; offer text/plain if it looks
+ ;; like text/plain.
+ "application/octet-stream"))
+ (delete-duplicates
+ (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions)
+ :test 'equal)))
+ (description (read-string "One line description: ")))
+ (list file type description)))
+ (when (string-match "\\`[ \t]*\\'" description)
+ (setq description nil))
+ (when (string-match "\\`[ \t]*\\'" type)
+ (setq type (mm-default-file-encoding file))) nil
+ ;; Prevent some common errors. This is inspired by similar code in
+ ;; VM.
+ (when (file-directory-p file)
+ (error "%s is a directory, cannot attach" file))
+ (unless (file-exists-p file)
+ (error "No such file: %s" file))
+ (unless (file-readable-p file)
+ (error "Permission denied: %s" file))
+ (insert (format "<#part type=%s filename=%s%s><#/part>\n"
+ type (prin1-to-string file)
+ (if description
+ (format " description=%s" (prin1-to-string description))
+ ""))))
(defun message-mime-insert-external (file type)
"Insert a message/external-body part into the buffer."
(device-sound-enabled-p)))
("audio/au" mm-inline-audio
(and (or (featurep 'nas-sound) (featurep 'native-sound))
- (device-sound-enabled-p))))
+ (device-sound-enabled-p)))
+ ("multipart/alternative" ignore t)
+ ("multipart/mixed" ignore t)
+ ("multipart/related" ignore t))
"Alist of media types/test that say whether the media types can be displayed inline.")
(defvar mm-user-display-methods
"List of MIME type regexps that will be displayed externally automatically.")
(defvar mm-alternative-precedence
- '("image/jpeg" "image/gif" "text/html" "text/enriched"
+ '("multipart/related" "multipart/mixed" "multipart/alternative"
+ "image/jpeg" "image/gif" "text/html" "text/enriched"
"text/richtext" "text/plain")
"List that describes the precedence of alternative parts.")
(defun mm-display-external (handle method)
"Display HANDLE using METHOD."
(mm-with-unibyte-buffer
- (insert-buffer-substring (mm-handle-buffer handle))
- (mm-decode-content-transfer-encoding
- (mm-handle-encoding handle) (car (mm-handle-type handle)))
(if (functionp method)
(let ((cur (current-buffer)))
(if (eq method 'mailcap-save-binary-file)
(progn
(set-buffer (generate-new-buffer "*mm*"))
(setq method nil))
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-decode-content-transfer-encoding
+ (mm-handle-encoding handle) (car (mm-handle-type handle)))
(let ((win (get-buffer-window cur t)))
(when win
(select-window win)))
(funcall method)
(mm-save-part handle))
(mm-handle-set-undisplayer handle mm))))
+ ;; The function is a string to be executed.
+ (insert-buffer-substring (mm-handle-buffer handle))
+ (mm-decode-content-transfer-encoding
+ (mm-handle-encoding handle) (car (mm-handle-type handle)))
(let* ((dir (make-temp-name (expand-file-name "emm." mm-tmp-directory)))
(filename (mail-content-type-get
(mm-handle-disposition handle) 'filename))
"Return a version of ARG that is safe to evaluate in a shell."
(let ((pos 0) new-pos accum)
;; *** bug: we don't handle newline characters properly
- (while (setq new-pos (string-match "[;!`\"$\\& \t{} ]" arg pos))
+ (while (setq new-pos (string-match "[;!`\"$\\& \t{} |()<>]" arg pos))
(push (substring arg pos new-pos) accum)
(push "\\" accum)
(push (list (aref arg new-pos)) accum)
(buffer-substring-no-properties beg (goto-char (point-max))))))
(defvar mml-boundary nil)
-(defvar mml-base-boundary "=-=-=")
+(defvar mml-base-boundary "-=-=")
(defvar mml-multipart-number 0)
(defun mml-generate-mime ()
(substring path (1+ (match-end 2))))
path))
+(defun mml-quote-region (beg end)
+ "Quote the MML tags in the region."
+ (interactive "r")
+ (save-excursion
+ (goto-char beg)
+ ;; Quote parts.
+ (while (re-search-forward
+ "<#/?!*\\(multipart\\|part\\|external\\)" end t)
+ (goto-char (match-beginning 1))
+ (insert "!"))))
+
(provide 'mml)
;;; mml.el ends here
\input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Pterodactyl Gnus 0.62 Manual
+@settitle Pterodactyl Gnus 0.63 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Gnus 0.62 Manual
+@title Pterodactyl Gnus 0.63 Manual
@author by Lars Magne Ingebrigtsen
@page
spool or your mbox file. All at the same time, if you want to push your
luck.
-This manual corresponds to Pterodactyl Gnus 0.62.
+This manual corresponds to Pterodactyl Gnus 0.63.
@end ifinfo
\input texinfo @c -*-texinfo-*-
@setfilename message
-@settitle Pterodactyl Message 0.62 Manual
+@settitle Pterodactyl Message 0.63 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Message 0.62 Manual
+@title Pterodactyl Message 0.63 Manual
@author by Lars Magne Ingebrigtsen
@page
* Key Index:: List of Message mode keys.
@end menu
-This manual corresponds to Pterodactyl Message 0.62. Message is
+This manual corresponds to Pterodactyl Message 0.63. Message is
distributed with the Gnus distribution bearing the same version number
as this manual.
projects / gnus / commitdiff