* nnmail.el (nnmail-cache-insert): make sure that the
[gnus] / lisp / gnus-art.el
index 0db2743..656b7a1 100644 (file)
      "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-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer"))
   "*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."
@@ -396,7 +396,9 @@ and the latter avoids underlining any whitespace at all."
 Example: (_/*word*/_)."
   :group 'gnus-article-emphasis)
 
-(defface gnus-emphasis-strikethru '((t (:strikethru t)))
+(defface gnus-emphasis-strikethru (if (featurep 'xemacs)
+                                     '((t (:strikethru t)))
+                                   '((t (:strike-through t))))
   "Face used for displaying strike-through text (-word-)."
   :group 'gnus-article-emphasis)
 
@@ -628,7 +630,9 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
      (:foreground "MidnightBlue" :italic t))
     (t
      (:italic t)))
-  "Face used for displaying newsgroups headers."
+  "Face used for displaying newsgroups headers.
+In the default setup this face is only used for crossposted
+articles."
   :group 'gnus-article-headers
   :group 'gnus-article-highlight)
 
@@ -660,7 +664,7 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
 (defcustom gnus-header-face-alist
   '(("From" nil gnus-header-from-face)
     ("Subject" nil gnus-header-subject-face)
-    ("Newsgroups" nil gnus-header-newsgroups-face)
+    ("Newsgroups:.*," nil gnus-header-newsgroups-face)
     ("" gnus-header-name-face gnus-header-content-face))
   "*Controls highlighting of article headers.
 
@@ -1143,7 +1147,10 @@ See Info node `(gnus)Customizing Articles' for details."
   :type gnus-article-treat-custom)
 (put 'gnus-treat-overstrike 'highlight t)
 
-(defcustom gnus-treat-display-xface
+(make-obsolete-variable 'gnus-treat-display-xface
+                       'gnus-treat-display-x-face)
+
+(defcustom gnus-treat-display-x-face
   (and (not noninteractive)
        (or (and (fboundp 'image-type-available-p)
                (image-type-available-p 'xbm)
@@ -1160,8 +1167,25 @@ See Info node `(gnus)Customizing Articles' and Info node
   :version "21.1"
   :link '(custom-manual "(gnus)Customizing Articles")
   :link '(custom-manual "(gnus)X-Face")
-  :type gnus-article-treat-head-custom)
-(put 'gnus-treat-display-xface 'highlight t)
+  :type gnus-article-treat-head-custom
+  :set (lambda (symbol value)
+        (set-default
+         symbol
+         (cond ((or (boundp symbol) (get symbol 'saved-value))
+                value)
+               ((boundp 'gnus-treat-display-xface)
+                (message "\
+** gnus-treat-display-xface is an obsolete variable;\
+ use gnus-treat-display-x-face instead")
+                (default-value 'gnus-treat-display-xface))
+               ((get 'gnus-treat-display-xface 'saved-value)
+                (message "\
+** gnus-treat-display-xface is an obsolete variable;\
+ use gnus-treat-display-x-face instead")
+                (eval (car (get 'gnus-treat-display-xface 'saved-value))))
+               (t
+                value)))))
+(put 'gnus-treat-display-x-face 'highlight t)
 
 (defcustom gnus-treat-display-face
   (and (not noninteractive)
@@ -1179,7 +1203,7 @@ See Info node `(gnus)Customizing Articles' and Info node
   :link '(custom-manual "(gnus)Customizing Articles")
   :link '(custom-manual "(gnus)X-Face")
   :type gnus-article-treat-head-custom)
-(put 'gnus-treat-display-xface 'highlight t)
+(put 'gnus-treat-display-face 'highlight t)
 
 (defcustom gnus-treat-display-smileys
   (if (or (and (featurep 'xemacs)
@@ -1365,7 +1389,7 @@ This requires GNU Libidn, and by default only enabled if it is found."
     (gnus-treat-date-original gnus-article-date-original)
     (gnus-treat-date-user-defined gnus-article-date-user)
     (gnus-treat-date-iso8601 gnus-article-date-iso8601)
-    (gnus-treat-display-xface gnus-article-display-x-face)
+    (gnus-treat-display-x-face gnus-article-display-x-face)
     (gnus-treat-display-face gnus-article-display-face)
     (gnus-treat-hide-headers gnus-article-maybe-hide-headers)
     (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
@@ -1764,14 +1788,15 @@ always hide."
          (forward-line 1))))))
 
 (defun article-treat-dumbquotes ()
-  "Translate M****s*** sm*rtq**t*s into proper text.
+  "Translate M****s*** sm*rtq**t*s and other symbols into proper text.
 Note that this function guesses whether a character is a sm*rtq**t* or
 not, so it should only be used interactively.
 
-Sm*rtq**t*s are M****s***'s unilateral extension to the character map
-in an attempt to provide more quoting characters.  If you see
-something like \\222 or \\264 where you're expecting some kind of
-apostrophe or quotation mark, then try this wash."
+Sm*rtq**t*s are M****s***'s unilateral extension to the
+iso-8859-1 character map in an attempt to provide more quoting
+characters.  If you see something like \\222 or \\264 where
+you're expecting some kind of apostrophe or quotation mark, then
+try this wash."
   (interactive)
   (article-translate-strings gnus-article-dumbquotes-map))
 
@@ -2055,23 +2080,25 @@ unfolded."
                               (not (string-match gnus-article-x-face-too-ugly
                                                  from)))))
            ;; We display the face.
-           (if (symbolp gnus-article-x-face-command)
-               ;; The command is a lisp function, so we call it.
-               (if (functionp gnus-article-x-face-command)
-                   (funcall gnus-article-x-face-command face)
-                 (error "%s is not a function" gnus-article-x-face-command))
-             ;; The command is a string, so we interpret the command
-             ;; as a, well, command, and fork it off.
-             (let ((process-connection-type nil))
-               (process-kill-without-query
-                (start-process
-                 "article-x-face" nil shell-file-name shell-command-switch
-                 gnus-article-x-face-command))
-               (with-temp-buffer
-                 (insert face)
-                 (process-send-region "article-x-face"
-                                      (point-min) (point-max)))
-               (process-send-eof "article-x-face")))))))))
+           (cond ((stringp gnus-article-x-face-command)
+                  ;; The command is a string, so we interpret the command
+                  ;; as a, well, command, and fork it off.
+                  (let ((process-connection-type nil))
+                    (process-kill-without-query
+                     (start-process
+                      "article-x-face" nil shell-file-name
+                      shell-command-switch gnus-article-x-face-command))
+                    (with-temp-buffer
+                      (insert face)
+                      (process-send-region "article-x-face"
+                                           (point-min) (point-max)))
+                    (process-send-eof "article-x-face")))
+                 ((functionp gnus-article-x-face-command)
+                  ;; The command is a lisp function, so we call it.
+                  (funcall gnus-article-x-face-command face))
+                 (t
+                  (error "%s is not a function"
+                         gnus-article-x-face-command)))))))))
 
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
@@ -2913,9 +2940,12 @@ function and want to see what the date was before converting."
         (lambda (w)
           (set-buffer (window-buffer w))
           (when (eq major-mode 'gnus-article-mode)
-            (goto-char (point-min))
-            (when (re-search-forward "^X-Sent:" nil t)
-              (article-date-lapsed t))))
+            (let ((mark (point-marker)))
+              (goto-char (point-min))
+              (when (re-search-forward "^X-Sent:" nil t)
+                (article-date-lapsed t))
+              (goto-char (marker-position mark))
+              (move-marker mark nil))))
         nil 'visible)))))
 
 (defun gnus-start-date-timer (&optional n)
@@ -3574,7 +3604,7 @@ commands:
       (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)))
   (gnus-update-format-specifications nil 'article-mode)
   (set (make-local-variable 'page-delimiter) gnus-page-delimiter)
-  (make-local-variable 'gnus-page-broken)
+  (set (make-local-variable 'gnus-page-broken) nil)
   (make-local-variable 'gnus-button-marker-list)
   (make-local-variable 'gnus-article-current-summary)
   (make-local-variable 'gnus-article-mime-handles)
@@ -3758,10 +3788,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
              (gnus-article-prepare-display)
              ;; Do page break.
              (goto-char (point-min))
-             (setq gnus-page-broken
-                   (when gnus-break-pages
-                     (gnus-narrow-to-page)
-                     t)))
+             (when gnus-break-pages
+               (gnus-narrow-to-page)))
            (let ((gnus-article-mime-handle-alist-1
                   gnus-article-mime-handle-alist))
              (gnus-set-mode-line 'article))
@@ -3990,8 +4018,6 @@ Replace it with some information about the removed part."
          (erase-buffer)
          (insert
           (concat
-           "<#part type=text/plain nofile=yes disposition=attachment"
-           " description=\"Deleted attachment (" bsize " Byte)\">"
            ",----\n"
            "| The following attachment has been deleted:\n"
            "|\n"
@@ -3999,10 +4025,12 @@ Replace it with some information about the removed part."
            "| Filename:       " filename "\n"
            "| Size (encoded): " bsize " Byte\n"
            "| Description:    " description "\n"
-           "`----\n"
-           "<#/part>"))
+           "`----\n"))
          (setcdr data
-                 (cdr (mm-make-handle nil `("text/plain"))))))
+                 (cdr (mm-make-handle
+                       nil `("text/plain") nil nil
+                       (list "attachment")
+                       (format "Deleted attachment (%s bytes)" bsize))))))
       (set-buffer gnus-summary-buffer)
       ;; FIXME: maybe some of the following code (borrowed from
       ;; `gnus-mime-save-part-and-strip') isn't necessary?
@@ -4315,7 +4343,8 @@ If no internal viewer is available, use an external viewer."
   (gnus-article-part-wrapper n 'gnus-mime-copy-part))
 
 (defun gnus-article-view-part-as-charset (n)
-  "Copy MIME part N, which is the numerical prefix."
+  "View MIME part N using a specified charset.
+N is the numerical prefix."
   (interactive "p")
   (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
 
@@ -4906,27 +4935,32 @@ If given a numerical ARG, move forward ARG pages."
       (let ((buffer-read-only nil))
        (gnus-remove-text-with-property 'gnus-prev)
        (gnus-remove-text-with-property 'gnus-next)))
-    (when
+    (if
        (cond ((< arg 0)
               (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
              ((> arg 0)
               (re-search-forward page-delimiter nil 'move arg)))
-      (goto-char (match-end 0)))
-    (narrow-to-region
-     (point)
-     (if (re-search-forward page-delimiter nil 'move)
-        (match-beginning 0)
-       (point)))
-    (when (and (gnus-visual-p 'page-marker)
-              (not (= (point-min) 1)))
+       (goto-char (match-end 0))
       (save-excursion
        (goto-char (point-min))
-       (gnus-insert-prev-page-button)))
-    (when (and (gnus-visual-p 'page-marker)
-              (< (+ (point-max) 2) (buffer-size)))
-      (save-excursion
-       (goto-char (point-max))
-       (gnus-insert-next-page-button)))))
+       (setq gnus-page-broken
+             (and (re-search-forward page-delimiter nil t) t))))
+    (when gnus-page-broken
+      (narrow-to-region
+       (point)
+       (if (re-search-forward page-delimiter nil 'move)
+          (match-beginning 0)
+        (point)))
+      (when (and (gnus-visual-p 'page-marker)
+                (not (= (point-min) 1)))
+       (save-excursion
+         (goto-char (point-min))
+         (gnus-insert-prev-page-button)))
+      (when (and (gnus-visual-p 'page-marker)
+                (< (+ (point-max) 2) (buffer-size)))
+       (save-excursion
+         (goto-char (point-max))
+         (gnus-insert-next-page-button))))))
 
 ;; Article mode commands
 
@@ -4939,7 +4973,7 @@ If given a numerical ARG, move forward ARG pages."
 
 
 (defun gnus-article-goto-prev-page ()
-  "Show the next page of the article."
+  "Show the previous page of the article."
   (interactive)
   (if (bobp)
       (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
@@ -4973,7 +5007,8 @@ Argument LINES specifies lines to be scrolled up."
       (if (or (not gnus-page-broken)
              (save-excursion
                (save-restriction
-                 (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
+                 (widen)
+                 (eobp)))) ;Real end-of-buffer?
          (progn
            (when gnus-article-over-scroll
              (gnus-article-next-page-1 lines))
@@ -5597,7 +5632,8 @@ groups."
     (set-window-configuration winconf)
     (set-buffer buf)
     (set-window-start (get-buffer-window buf) start)
-    (set-window-point (get-buffer-window buf) (point))))
+    (set-window-point (get-buffer-window buf) (point)))
+  (gnus-summary-show-article))
 
 (defun gnus-article-edit-exit ()
   "Exit the article editing without updating."
@@ -5618,7 +5654,8 @@ groups."
        (save-current-buffer
          (set-buffer curbuf)
          (set-window-start (get-buffer-window (current-buffer)) window-start)
-         (goto-char p))))))
+         (goto-char p))))
+    (gnus-summary-show-article)))
 
 (defun gnus-article-edit-full-stops ()
   "Interactively repair spacing at end of sentences."
@@ -6012,7 +6049,7 @@ positives are possible."
      2 (>= gnus-button-message-level 0) gnus-button-message-id 3)
     ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 2)
-    ("mailto:\\([-a-z.@_+0-9%=?]+\\)"
+    ("mailto:\\([-a-z.@_+0-9%=?&]+\\)"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
     ("\\bmailto:\\([^ \n\t]+\\)"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
@@ -6030,9 +6067,15 @@ positives are possible."
       gnus-button-ctan-directory-regexp
       "/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)")
      1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1)
-    ;; This is info
-    ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)"
-     0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2)
+    ;; This is info (home-grown style) <info://foo/bar+baz>
+    ("\\binfo://\\([^'\">\n\t ]+\\)"
+     0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1)
+    ;; Info GNOME style <info:foo#bar_baz>
+    ("\\binfo:\\([^('\n\t\r \"><][^'\n\t\r \"><]*\\)"
+     0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-gnome 1)
+    ;; Info KDE style <info:(foo)bar baz>
+    ("<\\(info:\\(([^)]+)[^>\n\r]*\\)\\)>"
+     1 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-kde 2)
     ("\\((Info-goto-node\\|(info\\)[ \t\n]*\\(\"[^\"]*\"\\))" 0
      (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2)
     ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET"
@@ -6089,7 +6132,7 @@ positives are possible."
      gnus-button-handle-man 1)
     ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm),
     ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7)
-    ("\\b\\([a-z][-_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W\\|\\b\\(X\\)([1-9])\\W"
+    ("\\b\\([a-z][-+_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W\\|\\b\\(X\\)([1-9])\\W"
      0 (>= gnus-button-man-level 5) gnus-button-handle-man 1)
     ;; 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
@@ -6112,7 +6155,7 @@ PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
 CALLBACK can also be a variable, in that case the value of that
 variable it the real callback function."
   :group 'gnus-article-buttons
-  :type '(repeat (list (choice regexp variable)
+  :type '(repeat (list (choice regexp variable sexp)
                       (integer :tag "Button")
                       (sexp :tag "Form")
                       (function :tag "Callback")
@@ -6121,7 +6164,7 @@ variable it the real callback function."
                               (integer :tag "Regexp group")))))
 
 (defcustom gnus-header-button-alist
-  '(("^\\(References\\|Message-I[Dd]\\):" "<[^<>]+>"
+  '(("^\\(References\\|Message-I[Dd]\\|^In-Reply-To\\):" "<[^<>]+>"
      0 (>= gnus-button-message-level 0) gnus-button-message-id 0)
     ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$"
      1 (>= gnus-button-message-level 0) gnus-button-reply 1)
@@ -6133,7 +6176,7 @@ variable it the real callback function."
      0 (>= gnus-button-browse-level 0) browse-url 0)
     ("^[^:]+:" gnus-button-url-regexp
      0 (>= gnus-button-browse-level 0) browse-url 0)
-    ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?]+\\)"
+    ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&]+\\)"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
     ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)"
      1 (>= gnus-button-message-level 0) gnus-button-message-id 4))
@@ -6149,7 +6192,7 @@ HEADER is a regexp to match a header.  For a fuller explanation, see
   :group 'gnus-article-buttons
   :group 'gnus-article-headers
   :type '(repeat (list (regexp :tag "Header")
-                      regexp
+                      (choice regexp variable)
                       (integer :tag "Button")
                       (sexp :tag "Form")
                       (function :tag "Callback")
@@ -6482,6 +6525,7 @@ specified by `gnus-button-alist'."
 
 (defun gnus-button-handle-info-url (url)
   "Fetch an info URL."
+  (setq url (mm-subst-char-in-string ?+ ?\  url))
   (cond
    ((string-match "^\\([^:/]+\\)?/\\(.*\\)" url)
     (gnus-info-find-node
@@ -6495,6 +6539,24 @@ specified by `gnus-button-alist'."
     (gnus-info-find-node url))
    (t (error "Can't parse %s" url))))
 
+(defun gnus-button-handle-info-url-gnome (url)
+  "Fetch GNOME style info URL."
+  (setq url (mm-subst-char-in-string ?_ ?\  url))
+  (if (string-match "\\([^#]+\\)#?\\(.*\\)" url)
+      (gnus-info-find-node
+       (concat "("
+              (gnus-url-unhex-string 
+                (match-string 1 url))
+              ")"
+              (or (gnus-url-unhex-string 
+                   (match-string 2 url))
+                  "Top")))
+    (error "Can't parse %s" url)))
+
+(defun gnus-button-handle-info-url-kde (url)
+  "Fetch KDE style info URL."
+  (gnus-info-find-node (gnus-url-unhex-string url)))
+
 (defun gnus-button-handle-info-keystrokes (url)
   "Call `info' when pushing the corresponding URL button."
   ;; For links like `C-h i d m gnus RET', `C-h i d m CC Mode RET'.
@@ -6551,12 +6613,14 @@ specified by `gnus-button-alist'."
   (when (string-match "mailto:/*\\(.*\\)" url)
     (setq url (substring url (match-beginning 1) nil)))
   (let (to args subject func)
-    (if (string-match (regexp-quote "?") url)
-       (setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0)))
-             args (gnus-url-parse-query-string
-                   (substring url (match-end 0) nil) t))
-      (setq to (gnus-url-unhex-string url)))
-    (setq args (cons (list "to" to) args)
+    (setq args (gnus-url-parse-query-string
+               (if (string-match "^\\?" url)
+                   (substring url 1)
+                 (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url)
+                     (concat "to=" (match-string 1 url) "&"
+                             (match-string 2 url))
+                   (concat "to=" url)))
+               t)
          subject (cdr-safe (assoc "subject" args)))
     (gnus-msg-mail)
     (while args
@@ -6564,7 +6628,9 @@ specified by `gnus-button-alist'."
       (if (fboundp func)
          (funcall func)
        (message-position-on-field (caar args)))
-      (insert (mapconcat 'identity (cdar args) ", "))
+      (insert (gnus-replace-in-string
+              (mapconcat 'identity (reverse (cdar args)) ", ")
+              "\r\n" "\n" t))
       (setq args (cdr args)))
     (if subject
        (message-goto-body)