Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

*** empty log message ***

  • Loading branch information...
commit 94e34eb81c895070829a9cddf3f0e2cbd2d530a8 1 parent 3a11258
@larsmagne larsmagne authored
View
42 lisp/ChangeLog
@@ -1,3 +1,45 @@
+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.
View
145 lisp/gnus-art.el
@@ -582,6 +582,11 @@ displayed by the first non-nil matching CONTENT face."
(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
@@ -2317,11 +2322,11 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(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."
@@ -2335,8 +2340,9 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(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))
@@ -2345,7 +2351,9 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(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))
@@ -2391,12 +2399,19 @@ If ALL-HEADERS is non-nil, no headers are hidden."
"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)))
@@ -2408,6 +2423,11 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(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))
@@ -2453,57 +2473,29 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(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
@@ -2514,16 +2506,41 @@ If ALL-HEADERS is non-nil, no headers are hidden."
(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."
View
15 lisp/gnus-setup.el
@@ -65,8 +65,6 @@
"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
@@ -89,19 +87,6 @@
;;; 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>
View
2  lisp/gnus-sum.el
@@ -7072,7 +7072,7 @@ and `request-accept' functions."
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)
View
2  lisp/gnus.el
@@ -254,7 +254,7 @@ is restarted, and sometimes reloaded."
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.48"
+(defconst gnus-version-number "0.49"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
View
19 lisp/message.el
@@ -789,6 +789,18 @@ Defaults to `text-mode-abbrev-table'.")
"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_.@-"))
@@ -819,7 +831,9 @@ Defaults to `text-mode-abbrev-table'.")
(,(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
@@ -4116,11 +4130,12 @@ regexp varstr."
(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"))))))
(run-hooks 'message-load-hook)
View
1  lisp/mm-view.el
@@ -84,6 +84,7 @@
(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))))))
View
52 lisp/mml.el
@@ -84,11 +84,16 @@
(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)
@@ -110,27 +115,32 @@
((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")
@@ -143,8 +153,12 @@
(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))))
View
4 texi/ChangeLog
@@ -1,3 +1,7 @@
+1998-11-18 00:52:46 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (MIME Commands): Addition.
+
1998-11-07 17:18:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (Gnus Reference Guide): Renamed.
View
27 texi/gnus.texi
@@ -1,7 +1,7 @@
\input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Pterodactyl Gnus 0.48 Manual
+@settitle Pterodactyl Gnus 0.49 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions.
@tex
@titlepage
-@title Pterodactyl Gnus 0.48 Manual
+@title Pterodactyl Gnus 0.49 Manual
@author by Lars Magne Ingebrigtsen
@page
@@ -354,7 +354,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local
spool or your mbox file. All at the same time, if you want to push your
luck.
-This manual corresponds to Pterodactyl Gnus 0.48.
+This manual corresponds to Pterodactyl Gnus 0.49.
@end ifinfo
@@ -6935,6 +6935,27 @@ To have all Vcards be ignored, you'd say something like this:
'("text/x-vcard"))
@end lisp
+@item gnus-article-mime-part-function
+@vindex gnus-article-mime-part-function
+For each @sc{mime} part, this function will be called with the @sc{mime}
+handle as the parameter. The function is meant to be used to allow
+users to gather information from the article (e. g., add Vcard info to
+the bbdb database) or to do actions based on parts (e. g., automatically
+save all jpegs into some directory).
+
+Here's an example function the does the latter:
+
+@lisp
+(defun my-save-all-jpeg-parts (handle)
+ (when (equal (car (mm-handle-type handle)) "image/jpeg")
+ (with-temp-buffer
+ (insert (mm-get-part handle))
+ (write-region (point-min) (point-max)
+ (read-file-name "Save jpeg to: ")))))
+(setq gnus-article-mime-part-function
+ 'my-save-all-jpeg-parts)
+@end lisp
+
@end table
View
6 texi/message.texi
@@ -1,7 +1,7 @@
\input texinfo @c -*-texinfo-*-
@setfilename message
-@settitle Pterodactyl Message 0.48 Manual
+@settitle Pterodactyl Message 0.49 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions.
@tex
@titlepage
-@title Pterodactyl Message 0.48 Manual
+@title Pterodactyl Message 0.49 Manual
@author by Lars Magne Ingebrigtsen
@page
@@ -83,7 +83,7 @@ Message mode buffers.
* Key Index:: List of Message mode keys.
@end menu
-This manual corresponds to Pterodactyl Message 0.48. Message is
+This manual corresponds to Pterodactyl Message 0.49. Message is
distributed with the Gnus distribution bearing the same version number
as this manual.
Please sign in to comment.
Something went wrong with that request. Please try again.