Synch with Oort Gnus (Translating gnus-ja.texi is incompleted).
[elisp/gnus.git-] / lisp / gnus-art.el
index 855c38b..79aaaae 100644 (file)
     "^X-Received:" "^Content-length:" "X-precedence:"
     "^X-Authenticated-User:" "^X-Comment" "^X-Report:" "^X-Abuse-Info:"
     "^X-HTTP-Proxy:" "^X-Mydeja-Info:" "^X-Copyright" "^X-No-Markup:"
-    "^X-Abuse-Info:")
+    "^X-Abuse-Info:" "^X-From_:" "^X-Accept-Language:" "^Errors-To:"
+    "^X-BeenThere:" "^X-Mailman-Version:" "^List-Help:" "^List-Post:"
+    "^List-Subscribe:" "^List-Id:" "^List-Unsubscribe:" "^List-Archive:"
+     "^X-Content-length:" "^X-Posting-Agent:" "^Original-Received:")
   "*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."
@@ -4073,12 +4076,9 @@ If no internal viewer is available, use an external viewer."
 
 (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
   (let ((gnus-tmp-name
-        (or (mail-content-type-get (mm-handle-type handle)
-                                   'name)
-            (mail-content-type-get (mm-handle-disposition handle)
-                                   'filename)
-            (mail-content-type-get (mm-handle-type handle)
-                                   'url)
+        (or (mail-content-type-get (mm-handle-type handle) 'name)
+            (mail-content-type-get (mm-handle-disposition handle) 'filename)
+            (mail-content-type-get (mm-handle-type handle) 'url)
             ""))
        (gnus-tmp-type (mm-handle-media-type handle))
        (gnus-tmp-description
@@ -4096,8 +4096,8 @@ If no internal viewer is available, use an external viewer."
     (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 (equal gnus-tmp-description "")
+      (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
     (unless (bolp)
       (insert "\n"))
     (setq b (point))
@@ -4466,7 +4466,9 @@ Provided for backwards compatibility."
       ;; save it to file.
       (goto-char (point-max))
       (insert "\n")
-      (write-region-as-binary (point-min) (point-max) file-name 'append)
+      (let ((file-name-coding-system nnmail-pathname-coding-system)
+           (pathname-coding-system nnmail-pathname-coding-system))
+       (write-region-as-binary (point-min) (point-max) file-name 'append))
       t)))
 
 (defun gnus-narrow-to-page (&optional arg)
@@ -4773,8 +4775,10 @@ If given a prefix, show the hidden text instead."
     (gnus-request-group gnus-newsgroup-name t)))
 
 (defun gnus-request-article-this-buffer (article group)
-  "Get an article and insert it into this buffer."
+  "Get an article and insert it into this buffer.
+T-gnus change: Insert an article into `gnus-original-article-buffer'."
   (let (do-update-line sparse-header)
+    ;; The current buffer is `gnus-article-buffer'.
     (prog1
        (save-excursion
          (erase-buffer)
@@ -4829,7 +4833,9 @@ If given a prefix, show the hidden text instead."
                      (when (file-directory-p dir)
                        (setq article 'nneething)
                        (gnus-group-enter-directory dir))))))))
+         (setq gnus-original-article (cons group article))
 
+         (set-buffer gnus-original-article-buffer)
          (cond
           ;; Refuse to select canceled articles.
           ((and (numberp article)
@@ -4897,28 +4903,10 @@ If given a prefix, show the hidden text instead."
       ;; Associate this article with the current summary buffer.
       (setq gnus-article-current-summary gnus-summary-buffer)
 
-      ;; Take the article from the original article buffer
-      ;; and place it in the buffer it's supposed to be in.
-      (when (and (get-buffer gnus-article-buffer)
-                (equal (buffer-name (current-buffer))
-                       (buffer-name (get-buffer gnus-article-buffer))))
-       (save-excursion
-         (if (get-buffer gnus-original-article-buffer)
-             (set-buffer gnus-original-article-buffer)
-           (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
-           (set-buffer-multibyte nil)
-           (buffer-disable-undo)
-           (setq major-mode 'gnus-original-article-mode)
-           (setq buffer-read-only t))
-         (let (buffer-read-only)
-           (erase-buffer)
-           (insert-buffer-substring gnus-article-buffer))
-         (setq gnus-original-article (cons group article)))
-
-       ;; Decode charsets.
-       (run-hooks 'gnus-article-decode-hook)
-       ;; Mark article as decoded or not.
-       (setq gnus-article-decoded-p gnus-article-decode-hook))
+      ;; Decode charsets.
+      (run-hooks 'gnus-article-decode-hook)
+      ;; Mark article as decoded or not.
+      (setq gnus-article-decoded-p gnus-article-decode-hook)
 
       ;; Update sparse articles.
       (when (and do-update-line
@@ -5197,7 +5185,7 @@ after replacing with the original article."
 
 ;;; Internal Variables:
 
-(defcustom gnus-button-url-regexp "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)"
+(defcustom gnus-button-url-regexp "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)"
   "Regular expression that matches URLs."
   :group 'gnus-article-buttons
   :type 'regexp)
@@ -5216,6 +5204,9 @@ after replacing with the original article."
     ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 2)
     ("mailto:\\([-a-zA-Z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1)
     ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1)
+    ;; This is info
+    ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t
+     gnus-button-handle-info 2)
     ;; This is how URLs _should_ be embedded in text...
     ("<URL: *\\([^<>]*\\)>" 0 t gnus-button-embedded-url 1)
     ;; Raw URLs.
@@ -5242,7 +5233,7 @@ variable it the real callback function."
                               (integer :tag "Regexp group")))))
 
 (defcustom gnus-header-button-alist
-  `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>"
+  `(("^\\(References\\|Message-I[Dd]\\):" "<[^<>]+>"
      0 t gnus-button-message-id 0)
     ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1)
     ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
@@ -5631,6 +5622,18 @@ specified by `gnus-button-alist'."
      (group
       (gnus-button-fetch-group url)))))
 
+(defun gnus-button-handle-info (url)
+  "Fetch an info URL."
+  (if (string-match 
+       "^\\([^:/]+\\)?/\\(.*\\)"
+       url)
+      (gnus-info-find-node
+       (concat "(" (or (gnus-url-unhex-string (match-string 1 url))
+                      "Gnus") 
+              ")" 
+              (gnus-url-unhex-string (match-string 2 url))))
+    (error "Can't parse %s" url)))
+
 (defun gnus-button-message-id (message-id)
   "Fetch MESSAGE-ID."
   (save-excursion
@@ -5642,8 +5645,8 @@ specified by `gnus-button-alist'."
   (if (not (string-match "[:/]" address))
       ;; This is just a simple group url.
       (gnus-group-read-ephemeral-group address gnus-select-method)
-    (if (not 
-        (string-match 
+    (if (not
+        (string-match
          "^\\([^:/]+\\)\\(:\\([^/]+\\)\\)?/\\([^/]+\\)\\(/\\([0-9]+\\)\\)?"
          address))
        (error "Can't parse %s" address)
@@ -5687,7 +5690,7 @@ specified by `gnus-button-alist'."
 If optional second argument ALLOW-NEWLINES is non-nil, then allow the
 decoding of carriage returns and line feeds in the string, which is normally
 forbidden in URL encoding."
-  (setq str (or str ""))
+  (setq str (or (nnheader-replace-chars-in-string str ?+ ? ) ""))
   (let ((tmp "")
        (case-fold-search t))
     (while (string-match "%[0-9a-f][0-9a-f]" str)
@@ -6072,21 +6075,25 @@ For example:
 (defun gnus-mime-security-verify-or-decrypt (handle)
   (mm-remove-parts (cdr handle))
   (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region))
-       buffer-read-only)
+       point buffer-read-only)
+    (if region
+       (goto-char (car region)))
+    (save-restriction
+      (narrow-to-region (point) (point))
+      (with-current-buffer (mm-handle-multipart-original-buffer handle)
+       (let* ((mm-verify-option 'known)
+              (mm-decrypt-option 'known)
+              (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
+         (unless (eq nparts (cdr handle))
+           (mm-destroy-parts (cdr handle))
+           (setcdr handle nparts))))
+      (setq point (point))
+      (gnus-mime-display-security handle)
+      (goto-char (point-max)))
     (when region
-      (delete-region (car region) (cdr region))
+      (delete-region (point) (cdr region))
       (set-marker (car region) nil)
-      (set-marker (cdr region) nil)))
-  (with-current-buffer (mm-handle-multipart-original-buffer handle)
-    (let* ((mm-verify-option 'known)
-          (mm-decrypt-option 'known)
-          (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
-      (unless (eq nparts (cdr handle))
-       (mm-destroy-parts (cdr handle))
-       (setcdr handle nparts))))
-  (let ((point (point))
-       buffer-read-only)
-    (gnus-mime-display-security handle)
+      (set-marker (cdr region) nil))
     (goto-char point)))
 
 (defun gnus-mime-security-show-details (handle)
@@ -6102,13 +6109,15 @@ For example:
                         gnus-mime-security-button-line-format)
                (forward-char -1))
              (forward-char)
+             (save-restriction
+               (narrow-to-region (point) (point))
+               (gnus-insert-mime-security-button handle))
              (delete-region (point)
                             (or (text-property-not-all
                                  (point) (point-max)
                                  'gnus-line-format
                                  gnus-mime-security-button-line-format)
-                                (point-max)))
-             (gnus-insert-mime-security-button handle))
+                                (point-max))))
          (if (gnus-buffer-live-p gnus-mime-security-details-buffer)
              (with-current-buffer gnus-mime-security-details-buffer
                (erase-buffer)
@@ -6181,13 +6190,15 @@ For example:
 (defun gnus-mime-display-security (handle)
   (save-restriction
     (narrow-to-region (point) (point))
-    (gnus-insert-mime-security-button handle)
+    (unless (gnus-unbuttonized-mime-type-p (car handle))
+      (gnus-insert-mime-security-button handle))
     (gnus-mime-display-mixed (cdr handle))
     (unless (bolp)
       (insert "\n"))
-    (let ((gnus-mime-security-button-line-format
-          gnus-mime-security-button-end-line-format))
-      (gnus-insert-mime-security-button handle))
+    (unless (gnus-unbuttonized-mime-type-p (car handle))
+      (let ((gnus-mime-security-button-line-format
+            gnus-mime-security-button-end-line-format))
+       (gnus-insert-mime-security-button handle)))
     (mm-set-handle-multipart-parameter
      handle 'gnus-region
      (cons (set-marker (make-marker) (point-min))