+Wed Nov 18 02:22:23 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.49 is released.
+
+1998-11-18 00:37:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mm-view.el (mm-inline-text): Require w3-vars.
+
+ * gnus-setup.el (gnus-use-tm): Removed.
+
+ * gnus-art.el (gnus-article-goto-part): Don't beep.
+ (gnus-article-view-part): Check return value.
+ (gnus-mime-display-alternative): Don't display when there is
+ nothing to display.
+
+ * mml.el (mml-generate-mime-1): Don't use a unibyte buffer.
+ (mml-generate-mime-1): Use unibyte for binaries.
+
+ * gnus-art.el (gnus-display-mime): Call
+ gnus-article-mime-part-function.
+ (gnus-mime-part-function): New function.
+ (gnus-article-mime-part-function): New function.
+
+ * mml.el (mml-generate-mime-1): Don't insert so many newlines.
+
+1998-11-16 06:44:19 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mml.el (mml-generate-mime-1): Do it in unibyte buffers.
+
+ * message.el (message-font-lock-keywords): Highlight MML.
+ (message-mml-face): New font.
+
+Mon Nov 16 23:34:12 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-display-mime): Clean up even when no handles.
+ (gnus-mm-display-part): Do not select-window if the article window
+ is not found.
+
+Mon Nov 16 02:26:40 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-sum.el (gnus-summary-move-article): Use no-encode for B m.
+
Mon Nov 16 02:00:05 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.48 is released.
(integer :tag "Less")
(sexp :tag "Predicate")))
+(defcustom gnus-article-mime-part-function nil
+ "Function called with a MIME handle as the argument."
+ :group 'gnus-article
+ :type 'function)
+
;;; Internal variables
(defvar gnus-treatment-function-alist
(when (> n (length gnus-article-mime-handle-alist))
(error "No such part"))
(let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
- (gnus-article-goto-part n)
- (if (equal (car handle) "multipart/alternative")
- (gnus-article-press-button)
- (when (eq (gnus-mm-display-part handle) 'internal)
- (gnus-set-window-start))))))
+ (when (gnus-article-goto-part n)
+ (if (equal (car handle) "multipart/alternative")
+ (gnus-article-press-button)
+ (when (eq (gnus-mm-display-part handle) 'internal)
+ (gnus-set-window-start)))))))
(defun gnus-mm-display-part (handle)
"Display HANDLE and fix MIME button."
(let ((window (selected-window)))
(save-excursion
(unwind-protect
- (progn
- (select-window (get-buffer-window (current-buffer) t))
+ (let ((win (get-buffer-window (current-buffer) t)))
+ (if win
+ (select-window win))
(goto-char point)
(forward-line)
(mm-display-part handle))
(defun gnus-article-goto-part (n)
"Go to MIME part N."
- (goto-char (text-property-any (point-min) (point-max) 'gnus-part n)))
+ (let ((point (text-property-any (point-min) (point-max) 'gnus-part n)))
+ (when point
+ (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))
"Insert MIME buttons in the buffer."
(let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect)))
handle name type b e display)
- (when handles
+ (unless ihandles
+ ;; Top-level call; we clean up.
+ (mm-destroy-parts gnus-article-mime-handles)
+ (setq gnus-article-mime-handles handles
+ gnus-article-mime-handle-alist nil)
+ ;; We allow users to glean info from the handles.
+ (when gnus-article-mime-part-function
+ (gnus-mime-part-function handles)))
+ (when (and handles
+ (or (not (stringp (car handles)))
+ (cdr handles)))
(unless ihandles
- ;; Top-level call; we clean up.
- (mm-destroy-parts gnus-article-mime-handles)
- (setq gnus-article-mime-handles handles
- gnus-article-mime-handle-alist nil)
+ ;; Clean up for mime parts.
(goto-char (point-min))
(search-forward "\n\n" nil t)
(delete-region (point) (point-max)))
(gnus-mime-display-mixed (cdr handles)))
(gnus-mime-display-single handles)))))
+(defun gnus-mime-part-function (handles)
+ (if (stringp (car handles))
+ (mapcar 'gnus-mime-part-function (cdr handles))
+ (funcall gnus-article-mime-part-function handles)))
+
(defun gnus-mime-display-mixed (handles)
(let (handle)
(while (setq handle (pop handles))
(goto-char (point-max))))))))
(defun gnus-mime-display-alternative (handles &optional preferred ibegend id)
- (let* ((preferred (mm-preferred-alternative handles preferred))
+ (let* ((preferred (or preferred (mm-preferred-alternative handles)))
(ihandles handles)
(point (point))
handle buffer-read-only from props begend not-pref)
- (save-restriction
- (when ibegend
- (narrow-to-region (car ibegend) (cdr ibegend))
- (delete-region (point-min) (point-max))
- (mm-remove-parts handles))
- (setq begend (list (point-marker)))
- ;; Do the toggle.
- (unless (setq not-pref (cadr (member preferred ihandles)))
- (setq not-pref (car ihandles)))
- (gnus-add-text-properties
- (setq from (point))
- (progn
- (insert (format "%d. " id))
- (point))
- `(gnus-callback
- (lambda (handles)
- (gnus-mime-display-alternative
- ',ihandles ,(if (stringp (car not-pref))
- (car not-pref)
- (car (mm-handle-type not-pref)))
- ',begend ,id))
- local-map ,gnus-mime-button-map
- ,gnus-mouse-face-prop ,gnus-article-mouse-face
- face ,gnus-article-button-face
- keymap ,gnus-mime-button-map
- gnus-part ,id
- gnus-data ,handle))
- (widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button
- :button-keymap gnus-widget-button-keymap)
- ;; Do the handles
- (while (setq handle (pop handles))
+ (when preferred
+ (save-restriction
+ (when ibegend
+ (narrow-to-region (car ibegend) (cdr ibegend))
+ (delete-region (point-min) (point-max))
+ (mm-remove-parts handles))
+ (setq begend (list (point-marker)))
+ ;; Do the toggle.
+ (unless (setq not-pref (cadr (member preferred ihandles)))
+ (setq not-pref (car ihandles)))
(gnus-add-text-properties
(setq from (point))
(progn
- (insert (format "[%c] %-18s"
- (if (equal handle preferred) ?* ? )
- (if (stringp (car handle))
- (car handle)
- (car (mm-handle-type handle)))))
+ (insert (format "%d. " id))
(point))
`(gnus-callback
(lambda (handles)
(gnus-mime-display-alternative
- ',ihandles ,(if (stringp (car handle))
- (car handle)
- (car (mm-handle-type handle)))
+ ',ihandles ',not-pref
',begend ,id))
local-map ,gnus-mime-button-map
,gnus-mouse-face-prop ,gnus-article-mouse-face
(widget-convert-button 'link from (point)
:action 'gnus-widget-press-button
:button-keymap gnus-widget-button-keymap)
- (insert " "))
- (insert "\n\n")
- (when preferred
- (if (stringp (car preferred))
- (gnus-display-mime preferred)
- (mm-display-part preferred)
- (goto-char (point-max))
- (setcdr begend (point-marker)))))
- (when ibegend
- (goto-char point))))
+ ;; Do the handles
+ (while (setq handle (pop handles))
+ (gnus-add-text-properties
+ (setq from (point))
+ (progn
+ (insert (format "[%c] %-18s"
+ (if (equal handle preferred) ?* ? )
+ (if (stringp (car handle))
+ (car handle)
+ (car (mm-handle-type handle)))))
+ (point))
+ `(gnus-callback
+ (lambda (handles)
+ (gnus-mime-display-alternative
+ ',ihandles ',handle
+ ',begend ,id))
+ local-map ,gnus-mime-button-map
+ ,gnus-mouse-face-prop ,gnus-article-mouse-face
+ face ,gnus-article-button-face
+ keymap ,gnus-mime-button-map
+ gnus-part ,id
+ gnus-data ,handle))
+ (widget-convert-button 'link from (point)
+ :action 'gnus-widget-press-button
+ :button-keymap gnus-widget-button-keymap)
+ (insert " "))
+ (insert "\n\n")
+ (when preferred
+ (if (stringp (car preferred))
+ (gnus-display-mime preferred)
+ (mm-display-part preferred)
+ (goto-char (point-max))
+ (setcdr begend (point-marker)))))
+ (when ibegend
+ (goto-char point)))))
(defun gnus-article-wash-status ()
"Return a string which display status of article washing."
"site-lisp/bbdb-1.51/")
"Directory where Big Brother Database is found.")
-(defvar gnus-use-tm running-xemacs
- "Set this if you want MIME support for Gnus")
(defvar gnus-use-mhe nil
"Set this if you want to use MH-E for mail reading")
(defvar gnus-use-rmail nil
;;; We can't do this until we know where Gnus is.
(require 'message)
-;;; Tools for MIME by
-;;; UMEDA Masanobu <umerin@mse.kyutech.ac.jp>
-;;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-
-(when gnus-use-tm
- (when (and (not gnus-use-installed-tm)
- (null (member gnus-tm-lisp-directory load-path)))
- (setq load-path (cons gnus-tm-lisp-directory load-path)))
- ;; tm may or may not be dumped with XEmacs. In Sunpro it is, otherwise
- ;; it isn't.
- (unless (featurep 'mime-setup)
- (load "mime-setup")))
-
;;; Mailcrypt by
;;; Jin Choi <jin@atype.com>
;;; Patrick LoPresti <patl@lcs.mit.edu>
gnus-newsgroup-name)) ; Server
(list 'gnus-request-accept-article
to-newsgroup (list 'quote select-method)
- (not articles)) ; Accept form
+ (not articles) t) ; Accept form
(not articles))) ; Only save nov last time
;; Copy the article.
((eq action 'copy)
(defconst gnus-product-name "T-gnus"
"Product name of this version of gnus.")
-(defconst gnus-version-number "6.10.034"
+(defconst gnus-version-number "6.10.035"
"Version number for this version of gnus.")
-(defconst gnus-original-version-number "0.48"
+(defconst gnus-original-version-number "0.49"
"Version number for this version of Gnus.")
(defconst gnus-original-product-name "Pterodactyl Gnus"
"Face used for displaying cited text names."
:group 'message-faces)
+(defface message-mml-face
+ '((((class color)
+ (background dark))
+ (:foreground "ForestGreen"))
+ (((class color)
+ (background light))
+ (:foreground "ForestGreen"))
+ (t
+ (:bold t)))
+ "Face used for displaying MML."
+ :group 'message-faces)
+
(defvar message-font-lock-keywords
(let* ((cite-prefix "A-Za-z")
(cite-suffix (concat cite-prefix "0-9_.@-"))
(,(concat "^[ \t]*"
"\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
"[:>|}].*")
- (0 'message-cited-text-face))))
+ (0 'message-cited-text-face))
+ ("<#/?\\(multi\\)part.*>"
+ (0 'message-mml-face))))
"Additional expressions to highlight in Message mode.")
;; XEmacs does it like this. For Emacs, we have to set the
(delete-region beg (point))
(insert "Mime-Version: 1.0\n")
(search-forward "\n\n")
+ (forward-char -1)
(insert line)
(when (save-excursion
(re-search-backward "^Content-Type: multipart/" nil t))
(insert "This is a MIME multipart message. If you are reading\n")
- (insert "this, you shouldn't.\n\n"))))))
+ (insert "this, you shouldn't.\n"))))))
(defvar message-save-buffer " *encoding")
(defun message-save-drafts ()
(car (mm-handle-type handle)))
(require 'url)
(save-window-excursion
+ (require 'w3-vars)
(let ((w3-strict-width width))
(w3-region (point-min) (point-max)))
(setq text (buffer-string))))))
(defun mml-read-part ()
"Return the buffer up till the next part, multipart or closing part or multipart."
(let ((beg (point)))
+ ;; If the tag ended at the end of the line, we go to the next line.
+ (when (looking-at "[ \t]*\n")
+ (forward-line 1))
(if (re-search-forward "<#/?\\(multi\\)?part." nil t)
(prog1
(buffer-substring beg (match-beginning 0))
- (unless (equal (match-string 0) "<#/part>")
- (goto-char (match-beginning 0))))
+ (if (not (equal (match-string 0) "<#/part>"))
+ (goto-char (match-beginning 0))
+ (when (looking-at "[ \t]*\n")
+ (forward-line 1))))
(buffer-substring beg (goto-char (point-max))))))
(defvar mml-boundary nil)
((eq (car cont) 'part)
(let (coded encoding charset filename type)
(setq type (or (cdr (assq 'type cont)) "text/plain"))
- (with-temp-buffer
- (if (setq filename (cdr (assq 'filename cont)))
- (insert-file-contents-literally filename)
- (save-restriction
- (narrow-to-region (point) (point))
- (insert (cdr (assq 'contents cont)))
- (goto-char (point-min))
- (while (re-search-forward "<#!+\\(part\\|multipart\\)" nil t)
- (delete-region (+ (match-beginning 0) 2)
- (+ (match-beginning 0) 3)))))
- (if (equal (car (split-string type "/")) "text")
+ (if (equal (car (split-string type "/")) "text")
+ (with-temp-buffer
+ (if (setq filename (cdr (assq 'filename cont)))
+ (insert-file-contents-literally filename)
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert (cdr (assq 'contents cont)))
+ ;; Remove quotes from quoted tags.
+ (goto-char (point-min))
+ (while (re-search-forward "<#!+\\(part\\|multipart\\)" nil t)
+ (delete-region (+ (match-beginning 0) 2)
+ (+ (match-beginning 0) 3)))))
(setq charset (mm-encode-body)
encoding (mm-body-encoding))
- (setq encoding (mm-encode-buffer type)))
- (setq coded (buffer-string)))
+ (setq coded (buffer-string)))
+ (mm-with-unibyte-buffer
+ (if (setq filename (cdr (assq 'filename cont)))
+ (insert-file-contents-literally filename)
+ (insert (cdr (assq 'contents cont))))
+ (setq coded (buffer-string))))
(when (or charset
(not (equal type "text/plain")))
- (insert "Content-Type: " type))
- (when charset
- (insert (format "; charset=\"%s\"" charset)))
- (insert "\n")
+ (insert "Content-Type: " type)
+ (when charset
+ (insert (format "; charset=\"%s\"" charset)))
+ (insert "\n"))
(unless (eq encoding '7bit)
(insert (format "Content-Transfer-Encoding: %s\n" encoding)))
(insert "\n")
(insert "\n")
(setq cont (cddr cont))
(while cont
+ (unless (bolp)
+ (insert "\n"))
(insert "--" mml-boundary "\n")
(mml-generate-mime-1 (pop cont)))
+ (unless (bolp)
+ (insert "\n"))
(insert "--" mml-boundary "--\n")))
(t
(error "Invalid element: %S" cont))))
projects / elisp / gnus.git- / commitdiff