2006-04-23 Andreas Seltenreich <andreas+ding@gate450.dyndns.org> (tiny change)
[gnus] / lisp / gnus-art.el
index 7e0cd68..661c327 100644 (file)
@@ -54,6 +54,7 @@
 (autoload 'parse-time-string "parse-time" nil nil)
 (autoload 'ansi-color-apply-on-region "ansi-color")
 (autoload 'mm-url-insert-file-contents-external "mm-url")
+(autoload 'mm-extern-cache-contents "mm-extern")
 
 (defgroup gnus-article nil
   "Article display."
      "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway"
      "X-Local-Origin" "X-Local-Destination" "X-UserInfo1"
      "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications"
-     "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer"))
+     "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer"
+     "Envelope-To" "X-Spam-Score" "System-Type" "X-Injected-Via-Gmane"
+     "X-Gmane-NNTP-Posting-Host" "Jabber-ID" "Archived-At"
+     "Envelope-Sender" "Envelope-Recipients"))
   "*All headers that start with this regexp will be hidden.
 This variable can also be a list of regexps of headers to be ignored.
 If `gnus-visible-headers' is non-nil, this variable will be ignored."
@@ -790,6 +794,31 @@ be displayed by the first non-nil matching CONTENT face."
                               (item :tag "skip" nil)
                               (face :value default)))))
 
+(defcustom gnus-face-properties-alist (if (featurep 'xemacs)
+                                         '((xface . (:face gnus-x-face)))
+                                       '((pbm . (:face gnus-x-face))
+                                         (png . nil)))
+  "Alist of image types and properties applied to Face and X-Face images.
+Here are examples:
+
+;; Specify the altitude of Face images in the From header.
+\(setq gnus-face-properties-alist
+      '((pbm . (:face gnus-x-face :ascent 80))
+       (png . (:ascent 80))))
+
+;; Show Face images as pressed buttons.
+\(setq gnus-face-properties-alist
+      '((pbm . (:face gnus-x-face :relief -2))
+       (png . (:relief -2))))
+
+See the manual for the valid properties for various image types.
+Currently, `pbm' is used for X-Face images and `png' is used for Face
+images in Emacs.  Only the `:face' property is effective on the `xface'
+image type in XEmacs if it is built with the libcompface library."
+  :version "23.0" ;; No Gnus
+  :group 'gnus-article-headers
+  :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
+
 (defcustom gnus-article-decode-hook
   '(article-decode-charset article-decode-encoded-words
                           article-decode-group-name article-decode-idna-rhs)
@@ -841,7 +870,8 @@ This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
   :group 'gnus-article-mime
   :type '(repeat regexp))
 
-(defcustom gnus-buttonized-mime-types nil
+(defcustom gnus-buttonized-mime-types (unless (eq mm-verify-option 'never)
+                                       '("multipart/signed"))
   "List of MIME types that should be given buttons when rendered inline.
 If set, this variable overrides `gnus-unbuttonized-mime-types'.
 To see e.g. security buttons you could set this to
@@ -983,7 +1013,8 @@ parts.  When nil, redisplay article."
   '(choice (const :tag "Off" nil)
           (const :tag "Header" head)))
 
-(defvar gnus-article-treat-types '("text/plain")
+(defvar gnus-article-treat-types '("text/plain" "text/x-verbatim"
+                                  "text/x-patch")
   "Parts to treat.")
 
 (defvar gnus-inhibit-treatment nil
@@ -1571,8 +1602,8 @@ This requires GNU Libidn, and by default only enabled if it is found."
     (gnus-treat-overstrike gnus-article-treat-overstrike)
     (gnus-treat-ansi-sequences gnus-article-treat-ansi-sequences)
     (gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
-    (gnus-treat-fold-headers gnus-article-treat-fold-headers)
     (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
+    (gnus-treat-fold-headers gnus-article-treat-fold-headers)
     (gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
     (gnus-treat-display-smileys gnus-treat-smiley)
     (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
@@ -2617,6 +2648,7 @@ exit from the summary buffer.  If it is the symbol `file', query
 on each file, if it is `ask' ask once when exiting from the
 summary buffer."
   :group 'gnus-article
+  :version "23.0" ;; No Gnus
   :type '(choice (const :tag "Don't delete" nil)
                 (const :tag "Don't ask" t)
                 (const :tag "Ask" ask)
@@ -3945,6 +3977,7 @@ commands:
   (make-local-variable 'gnus-article-ignored-charsets)
   ;; Prevent recent Emacsen from displaying non-break space as "\ ".
   (set (make-local-variable 'nobreak-char-display) nil)
+  (setq cursor-in-non-selected-windows nil)
   (gnus-set-default-directory)
   (buffer-disable-undo)
   (setq buffer-read-only t
@@ -4361,6 +4394,9 @@ The current article has a complicated MIME structure, giving up..."))
        (insert "Content-Type: " (mm-handle-media-type data))
        (mml-insert-parameter-string (cdr (mm-handle-type data))
                                     '(charset))
+       ;; Add a filename for the sake of saving the part again.
+       (mml-insert-parameter
+        (mail-header-encode-parameter "name" (file-name-nondirectory file)))
        (insert "\n")
        (insert "Content-ID: " (message-make-message-id) "\n")
        (insert "Content-Transfer-Encoding: binary\n")
@@ -4477,6 +4513,10 @@ Deleting parts may malfunction or destroy the article; continue? "))
   (gnus-article-check-buffer)
   (let ((handle (get-text-property (point) 'gnus-data)))
     (when handle
+      (when (equal (mm-handle-media-type handle) "message/external-body")
+       (unless (mm-handle-cache handle)
+         (mm-extern-cache-contents handle))
+       (setq handle (mm-handle-cache handle)))
       (setq handle
            (mm-make-handle (mm-handle-buffer handle)
                            (cons mime-type (cdr (mm-handle-type handle)))
@@ -4499,7 +4539,7 @@ are decompressed."
   (unless handle
     (setq handle (get-text-property (point) 'gnus-data)))
   (when handle
-    (let ((filename (or (mail-content-type-get (mm-handle-disposition handle)
+    (let ((filename (or (mail-content-type-get (mm-handle-type handle)
                                               'name)
                        (mail-content-type-get (mm-handle-disposition handle)
                                               'filename)))
@@ -4593,7 +4633,7 @@ Compressed files like .gz and .bz2 are decompressed."
          (mm-insert-part handle)
          (setq contents
                (or (mm-decompress-buffer
-                    (or (mail-content-type-get (mm-handle-disposition handle)
+                    (or (mail-content-type-get (mm-handle-type handle)
                                                'name)
                         (mail-content-type-get (mm-handle-disposition handle)
                                                'filename))
@@ -4635,19 +4675,29 @@ Compressed files like .gz and .bz2 are decompressed."
 specified charset."
   (interactive (list nil current-prefix-arg))
   (gnus-article-check-buffer)
-  (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
-        contents charset
-        (b (point))
-        (inhibit-read-only t))
+  (let ((handle (or handle (get-text-property (point) 'gnus-data)))
+       (fun (get-text-property (point) 'gnus-callback))
+       (gnus-newsgroup-ignored-charsets 'gnus-all)
+       gnus-newsgroup-charset type charset)
     (when handle
       (if (mm-handle-undisplayer handle)
          (mm-remove-part handle))
-      (let ((gnus-newsgroup-charset
-            (or (cdr (assq arg
-                           gnus-summary-show-article-charset-alist))
-                (mm-read-coding-system "Charset: ")))
-         (gnus-newsgroup-ignored-charsets 'gnus-all))
-       (gnus-article-press-button)))))
+      (when fun
+       (setq gnus-newsgroup-charset
+             (or (cdr (assq arg gnus-summary-show-article-charset-alist))
+                 (mm-read-coding-system "Charset: ")))
+       ;; Strip the charset parameter from `handle'.
+       (setq type (mm-handle-type
+                   (if (equal (mm-handle-media-type handle)
+                              "message/external-body")
+                       (progn
+                         (unless (mm-handle-cache handle)
+                           (mm-extern-cache-contents handle))
+                         (mm-handle-cache handle))
+                     handle))
+             charset (assq 'charset (cdr type)))
+       (delq charset type)
+       (funcall fun handle)))))
 
 (defun gnus-mime-view-part-externally (&optional handle)
   "View the MIME part under point with an external viewer."
@@ -4809,6 +4859,12 @@ N is the numerical prefix."
   (interactive "p")
   (gnus-article-part-wrapper n 'gnus-mime-delete-part t))
 
+(defun gnus-article-view-part-as-type (n)
+  "Choose a MIME media type, and view part N as such.
+N is the numerical prefix."
+  (interactive "p")
+  (gnus-article-part-wrapper n 'gnus-mime-view-part-as-type t))
+
 (defun gnus-article-mime-match-handle-first (condition)
   (if condition
       (let (n)
@@ -6195,7 +6251,7 @@ groups."
 
 ;; Regexp suggested by Felix Wiemann in <87oeuomcz9.fsf@news2.ososo.de>
 (defcustom gnus-button-valid-localpart-regexp
-  "[a-z0-9$%(*-=?[_][^<>\")!;:,{}\n\t ]*"
+  "[a-z0-9$%(*-=?[_][^<>\")!;:,{}\n\t @]*"
   "Regular expression that matches a localpart of mail addresses or MIDs."
   :version "22.1"
   :group 'gnus-article-buttons
@@ -6676,6 +6732,13 @@ positives are possible."
     ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7)
     ("\\b\\(\\(?:[a-z][-+_.:a-z0-9]+([1-9][X1a-z]*)\\)\\|\\b\\(?:X([1-9])\\)\\)\\W"
      0 (>= gnus-button-man-level 5) gnus-button-handle-man 1)
+    ;; Recognizing patches to .el files.  This is somewhat obscure,
+    ;; but considering the percentage of Gnus users who hack Emacs
+    ;; Lisp files...
+    ("^--- \\([^ .]+\\.el\\).*\n.*\n@@ -?\\([0-9]+\\)" 1
+     (>= gnus-button-message-level 4) gnus-button-patch 1 2)
+    ("^\\*\\*\\* \\([^ .]+\\.el\\).*\n.*\n\\*+\n\\*\\*\\* \\([0-9]+\\)" 1
+     (>= gnus-button-message-level 4) gnus-button-patch 1 2)
     ;; MID or mail: To avoid too many false positives we don't try to catch
     ;; all kind of allowed MIDs or mail addresses.  Domain part must contain
     ;; at least one dot.  TLD must contain two or three chars or be a know TLD
@@ -7041,6 +7104,15 @@ specified by `gnus-button-alist'."
      (group
       (gnus-button-fetch-group url)))))
 
+(defun gnus-button-patch (library line)
+  "Visit an Emacs Lisp library LIBRARY on line LINE."
+  (interactive)
+  (let ((file (locate-library (file-name-nondirectory library))))
+    (unless file
+      (error "Couldn't find library %s" library))
+    (find-file file)
+    (goto-line (string-to-number line))))
+
 (defun gnus-button-handle-man (url)
   "Fetch a man page."
   (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)