Importing Pterodactyl Gnus v0.49.
authoryamaoka <yamaoka>
Wed, 18 Nov 1998 01:36:12 +0000 (01:36 +0000)
committeryamaoka <yamaoka>
Wed, 18 Nov 1998 01:36:12 +0000 (01:36 +0000)
lisp/ChangeLog
lisp/gnus-art.el
lisp/gnus-setup.el
lisp/gnus-sum.el
lisp/gnus.el
lisp/message.el
lisp/mm-view.el
lisp/mml.el
texi/ChangeLog
texi/gnus.texi
texi/message.texi

index 7eaac25..b969ad0 100644 (file)
@@ -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.
index d1d466b..18a19a5 100644 (file)
@@ -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."
index ae9909b..29c2a31 100644 (file)
@@ -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
 ;;; 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>
index 8485f0e..89b3940 100644 (file)
@@ -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)
index dc02ea8..3ad4925 100644 (file)
@@ -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)
index 0c9a0f8..f4555b5 100644 (file)
@@ -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)
 
index 706a2a2..bea8c6f 100644 (file)
@@ -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))))))
index 5f4d8e3..fab6be2 100644 (file)
 (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))))
index ac7acc7..bdd0655 100644 (file)
@@ -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.
index f6d8bfd..5134631 100644 (file)
@@ -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
 
 
index 25d797f..6493963 100644 (file)
@@ -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.