(gnus-article-next-page): Don't go to the next line
[gnus] / lisp / gnus-art.el
index d1aea3f..e33f25c 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."
@@ -243,8 +243,8 @@ regexp.  If it matches, the text in question is not a signature."
   :type 'sexp
   :group 'gnus-article-hiding)
 
-;; Fixme: This isn't the right thing for mixed graphical and
-;; non-graphical frames in a session.
+;; Fixme: This isn't the right thing for mixed graphical and non-graphical
+;; frames in a session.
 (defcustom gnus-article-x-face-command
   (if (featurep 'xemacs)
       (if (or (gnus-image-type-available-p 'xface)
@@ -628,7 +628,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)
 
@@ -662,17 +664,17 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
     ("Subject" nil gnus-header-subject-face)
     ("Newsgroups:.*," nil gnus-header-newsgroups-face)
     ("" gnus-header-name-face gnus-header-content-face))
-  "*Controls highlighting of article header.
+  "*Controls highlighting of article headers.
 
 An alist of the form (HEADER NAME CONTENT).
 
-HEADER is a regular expression which should match the name of an
-header header and NAME and CONTENT are either face names or nil.
+HEADER is a regular expression which should match the name of a
+header and NAME and CONTENT are either face names or nil.
 
 The name of each header field will be displayed using the face
-specified by the first element in the list where HEADER match the
-header name and NAME is non-nil.  Similarly, the content will be
-displayed by the first non-nil matching CONTENT face."
+specified by the first element in the list where HEADER matches
+the header name and NAME is non-nil.  Similarly, the content will
+be displayed by the first non-nil matching CONTENT face."
   :group 'gnus-article-headers
   :group 'gnus-article-highlight
   :type '(repeat (list (regexp :tag "Header")
@@ -1143,7 +1145,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 +1165,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 +1201,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 +1387,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)
@@ -1976,29 +1998,40 @@ unfolded."
 (defun article-display-face ()
   "Display any Face headers in the header."
   (interactive)
-  (gnus-with-article-headers
-    (if (memq 'face gnus-article-wash-types)
-       (gnus-delete-images 'face)
-      (let (face faces)
-       (save-excursion
-         (set-buffer gnus-original-article-buffer)
-         (save-restriction
-           (mail-narrow-to-head)
-           (while (gnus-article-goto-header "Face")
-             (push (mail-header-field-value) faces))))
-       (while (setq face (pop faces))
-         (let ((png (gnus-convert-face-to-png face))
-               image)
-           (when png
-             (setq image (gnus-create-image png 'png t))
-             (gnus-article-goto-header "from")
-             (when (bobp)
-               (insert "From: [no `from' set]\n")
-               (forward-char -17))
-             (gnus-add-wash-type 'face)
-             (gnus-add-image 'face image)
-             (gnus-put-image image))))))
-    ))
+  (let ((wash-face-p buffer-read-only))
+    (gnus-with-article-headers
+      ;; When displaying parts, this function can be called several times on
+      ;; the same article, without any intended toggle semantic (as typing `W
+      ;; D d' would have). So face deletion must occur only when we come from
+      ;; an interactive command, that is when the *Article* buffer is
+      ;; read-only.
+      (if (and wash-face-p (memq 'face gnus-article-wash-types))
+         (gnus-delete-images 'face)
+       (let (face faces)
+         (save-excursion
+           (when (and wash-face-p
+                      (progn
+                        (goto-char (point-min))
+                        (not (re-search-forward "^Face:[\t ]*" nil t)))
+                      (gnus-buffer-live-p gnus-original-article-buffer))
+             (set-buffer gnus-original-article-buffer))
+           (save-restriction
+             (mail-narrow-to-head)
+             (while (gnus-article-goto-header "Face")
+               (push (mail-header-field-value) faces))))
+         (while (setq face (pop faces))
+           (let ((png (gnus-convert-face-to-png face))
+                 image)
+             (when png
+               (setq image (gnus-create-image png 'png t))
+               (gnus-article-goto-header "from")
+               (when (bobp)
+                 (insert "From: [no `from' set]\n")
+                 (forward-char -17))
+               (gnus-add-wash-type 'face)
+               (gnus-add-image 'face image)
+               (gnus-put-image image nil 'face))))))
+      )))
 
 (defun article-display-x-face (&optional force)
   "Look for an X-Face header and display it if present."
@@ -2008,7 +2041,8 @@ unfolded."
       ;; Delete the old process, if any.
       (when (process-status "article-x-face")
        (delete-process "article-x-face"))
-      (if (memq 'xface gnus-article-wash-types)
+      ;; See the comment in `article-display-face'.
+      (if (and wash-face-p (memq 'xface gnus-article-wash-types))
          ;; We have already displayed X-Faces, so we remove them
          ;; instead.
          (gnus-delete-images 'xface)
@@ -2043,23 +2077,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."
@@ -2901,9 +2937,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)
@@ -4303,7 +4342,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))
 
@@ -4850,7 +4890,7 @@ is the string to use when it is inactive.")
   "Delete all images in CATEGORY."
   (let ((entry (assq category gnus-article-image-alist)))
     (dolist (image (cdr entry))
-      (gnus-remove-image image))
+      (gnus-remove-image image category))
     (setq gnus-article-image-alist (delq entry gnus-article-image-alist))
     (gnus-delete-wash-type category)))
 
@@ -4961,7 +5001,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))
@@ -5585,7 +5626,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."
@@ -5606,7 +5648,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."
@@ -5942,7 +5985,7 @@ Calls `describe-variable' or `describe-function'."
   "*Integer that says how many TeX-related buttons Gnus will show.
 The higher the number, the more buttons will appear and the more false
 positives are possible.  Note that you can set this variable local to
-specifific groups.  Setting it higher in TeX groups is probably a good idea.
+specific groups.  Setting it higher in TeX groups is probably a good idea.
 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
 how to set variables in specific groups."
   :group 'gnus-article-buttons
@@ -5953,7 +5996,7 @@ how to set variables in specific groups."
   "*Integer that says how many man-related buttons Gnus will show.
 The higher the number, the more buttons will appear and the more false
 positives are possible.  Note that you can set this variable local to
-specifific groups.  Setting it higher in Unix groups is probably a good idea.
+specific groups.  Setting it higher in Unix groups is probably a good idea.
 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
 how to set variables in specific groups."
   :group 'gnus-article-buttons
@@ -5964,7 +6007,7 @@ how to set variables in specific groups."
   "*Integer that says how many emacs-related buttons Gnus will show.
 The higher the number, the more buttons will appear and the more false
 positives are possible.  Note that you can set this variable local to
-specifific groups.  Setting it higher in Emacs or Gnus related groups is
+specific groups.  Setting it higher in Emacs or Gnus related groups is
 probably a good idea.  See Info node `(gnus)Group Parameters' and the variable
 `gnus-parameters' on how to set variables in specific groups."
   :group 'gnus-article-buttons
@@ -6018,9 +6061,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"
@@ -6077,7 +6126,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
@@ -6090,9 +6139,9 @@ positives are possible."
 
 Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
 REGEXP: is the string (case insensitive) matching text around the button (can
-also be lisp expression evaluating to a string),
+also be Lisp expression evaluating to a string),
 BUTTON: is the number of the regexp grouping actually matching the button,
-FORM: is a lisp expression which must eval to true for the button to
+FORM: is a Lisp expression which must eval to true for the button to
 be added,
 CALLBACK: is the function to call when the user push this button, and each
 PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
@@ -6100,7 +6149,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")
@@ -6109,7 +6158,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)
@@ -6137,7 +6186,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")
@@ -6470,6 +6519,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
@@ -6483,6 +6533,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'.
@@ -6665,7 +6733,7 @@ specified by `gnus-button-alist'."
 
 This variable is a list of FUNCTION or (REGEXP . FUNCTION).  If item
 is FUNCTION, FUNCTION will be apply to all newsgroups.  If item is a
-\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
+\(REGEXP . FUNCTION), FUNCTION will be only apply to the newsgroups
 whose names match REGEXP.
 
 For example: