* gnus.el (gnus-other-frame-function): New user option.
[gnus] / lisp / gnus-art.el
index c2f967e..48d684f 100644 (file)
@@ -242,6 +242,7 @@ asynchronously.      The compressed face will be piped to this command."
                 (function-item gnus-display-x-face-in-from)
                 function)
   :version "21.1"
+  :group 'gnus-picon
   :group 'gnus-article-washing)
 
 (defcustom gnus-article-x-face-too-ugly nil
@@ -295,6 +296,8 @@ directly.")
            (format format (car spec) (cadr spec))
            2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
         types)
+       ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)"
+        2 3 gnus-emphasis-strikethru)
        ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
         2 3 gnus-emphasis-underline)))
   "*Alist that says how to fontify certain phrases.
@@ -350,7 +353,11 @@ and the latter avoids underlining any whitespace at all."
 (defface gnus-emphasis-underline-bold-italic
   '((t (:bold t :italic t :underline t)))
   "Face used for displaying underlined bold italic emphasized text.
-Esample: (_/*word*/_)."
+Example: (_/*word*/_)."
+  :group 'gnus-article-emphasis)
+
+(defface gnus-emphasis-strikethru '((t (:strikethru t)))
+  "Face used for displaying strike-through text (-word-)."
   :group 'gnus-article-emphasis)
 
 (defface gnus-emphasis-highlight-words
@@ -705,10 +712,13 @@ be controlled by `gnus-treat-body-boundary'."
                 string))
 
 (defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces")
-  "*Defines the location of the faces database.
+  "Defines the location of the faces database.
 For information on obtaining this database of pretty pictures, please
 see http://www.cs.indiana.edu/picons/ftp/index.html"
-  :type 'directory
+  :type '(repeat directory)
+  :link '(url-link :tag "download" 
+                  "http://www.cs.indiana.edu/picons/ftp/index.html")
+  :link '(custom-manual "(gnus)Picons")
   :group 'gnus-picon)
 
 (defun gnus-picons-installed-p ()
@@ -767,28 +777,13 @@ used."
     ("toggle display" . gnus-article-press-button)
     ("toggle display" . gnus-article-view-part-as-charset)
     ("view as type" . gnus-mime-view-part-as-type)
-    ("internalize type" . gnus-mime-internalize-part)
-    ("externalize type" . gnus-mime-externalize-part))
+    ("view internally" . gnus-mime-view-part-internally)
+    ("view externally" . gnus-mime-view-part-externally))
   "An alist of actions that run on the MIME attachment."
   :group 'gnus-article-mime
   :type '(repeat (cons (string :tag "name")
                       (function))))
 
-(defcustom gnus-mime-action-alist
-  '(("save to file" . gnus-mime-save-part)
-    ("display as text" . gnus-mime-inline-part)
-    ("view the part" . gnus-mime-view-part)
-    ("pipe to command" . gnus-mime-pipe-part)
-    ("toggle display" . gnus-article-press-button)
-    ("view as type" . gnus-mime-view-part-as-type)
-    ("internalize type" . gnus-mime-internalize-part)
-    ("externalize type" . gnus-mime-externalize-part))
-  "An alist of actions that run on the MIME attachment."
-  :version "21.1"
-  :group 'gnus-article-mime
-  :type '(repeat (cons (string :tag "name")
-                      (function))))
-
 ;;;
 ;;; The treatment variables
 ;;;
@@ -1121,6 +1116,9 @@ Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Picons' for details."
   :group 'gnus-article-treat
+  :group 'gnus-picon
+  :link '(info-link "(gnus)Customizing Articles")
+  :link '(info-link "(gnus)Picons")
   :type gnus-article-treat-head-custom)
 (put 'gnus-treat-from-picon 'highlight t)
 
@@ -1133,6 +1131,9 @@ Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Picons' for details."
   :group 'gnus-article-treat
+  :group 'gnus-picon
+  :link '(info-link "(gnus)Customizing Articles")
+  :link '(info-link "(gnus)Picons")
   :type gnus-article-treat-head-custom)
 (put 'gnus-treat-mail-picon 'highlight t)
 
@@ -1145,6 +1146,9 @@ Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Picons' for details."
   :group 'gnus-article-treat
+  :group 'gnus-picon
+  :link '(info-link "(gnus)Customizing Articles")
+  :link '(info-link "(gnus)Picons")
   :type gnus-article-treat-head-custom)
 (put 'gnus-treat-newsgroups-picon 'highlight t)
 
@@ -1284,8 +1288,8 @@ It is a string, such as \"PGP\". If nil, ask user."
   (let ((table (copy-syntax-table text-mode-syntax-table)))
     ;; This causes the citation match run O(2^n).
     ;; (modify-syntax-entry ?- "w" table)
-    (modify-syntax-entry ?> ")" table)
-    (modify-syntax-entry ?< "(" table)
+    (modify-syntax-entry ?> ")<" table)
+    (modify-syntax-entry ?< "(>" table)
     table)
   "Syntax table used in article mode buffers.
 Initialized from `text-mode-syntax-table.")
@@ -1849,13 +1853,14 @@ unfolded."
                      (if (match-beginning 2)
                          (progn
                            (setq grey t)
-                           (push (cons (string-to-number (match-string 2))
+                           (push (cons (- (string-to-number (match-string 2)))
                                        (mail-header-field-value))
                                  x-faces))
                        (push (cons 0 (mail-header-field-value)) x-faces)))
                    (dolist (x-face (prog1
-                                       (nreverse (sort x-faces
-                                                       'car-less-than-car))
+                                       (if grey
+                                           (sort x-faces 'car-less-than-car)
+                                         (nreverse x-faces))
                                      (setq x-faces nil)))
                      (push (cdr x-face) x-faces)))
                (while (gnus-article-goto-header "X-Face")
@@ -2082,8 +2087,11 @@ If READ-CHARSET, ask for a coding system."
     (let ((buffer-read-only nil))
       (goto-char (point-min))
       (while (re-search-forward
-             "^\\(\\(https?\\|ftp\\)://\\S-+\\)\n\\(\\S-+\\)" nil t)
-       (replace-match "\\1\\3" t)))))
+             "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
+       (replace-match "\\1\\3" t)))
+    (when (and gnus-display-mime-function (interactive-p))
+      (funcall gnus-display-mime-function))))
+
 
 (defun article-wash-html (&optional read-charset)
   "Format an html article.
@@ -2125,10 +2133,9 @@ If READ-CHARSET, ask for a coding system."
   (mm-setup-w3)
   (let ((w3-strict-width (window-width))
        (url-standalone-mode t)
-       (url-gateway-unplugged t)
-       (w3-honor-stylesheets nil)
-       (w3-delay-image-loads t))
-    (condition-case var
+       (url-gateway-unplugged t)
+       (w3-honor-stylesheets nil))
+    (condition-case ()
        (w3-region (point-min) (point-max))
       (error))))
 
@@ -2587,11 +2594,14 @@ should replace the \"Date:\" one, or should be added below it."
                             date)))
         ;; Let the user define the format.
         ((eq type 'user)
-         (if (gnus-functionp gnus-article-time-format)
-             (funcall gnus-article-time-format time)
-           (concat
-            "Date: "
-            (format-time-string gnus-article-time-format time))))
+         (let ((format (or (condition-case nil
+                               (with-current-buffer gnus-summary-buffer
+                                 gnus-article-time-format)
+                             (error nil))
+                           gnus-article-time-format)))
+           (if (gnus-functionp format)
+               (funcall format time)
+             (concat "Date: " (format-time-string format time)))))
         ;; ISO 8601.
         ((eq type 'iso8601)
          (let ((tz (car (current-time-zone time))))
@@ -2666,7 +2676,7 @@ should replace the \"Date:\" one, or should be added below it."
             ":"
             (format "%02d" (nth 1 dtime)))))))
        (error
-        (format "Date: %s (from Oort)" date))))
+        (format "Date: %s (from Gnus)" date))))
 
 (defun article-date-local (&optional highlight)
   "Convert the current article date to the local timezone."
@@ -3233,7 +3243,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is
      article-strip-trailing-space
      article-strip-blank-lines
      article-strip-all-blank-lines
-     article-replace-with-quoted-text
      article-date-local
      article-date-english
      article-date-iso8601
@@ -3534,6 +3543,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
                   gnus-article-mime-handle-alist))
              (gnus-set-mode-line 'article))
            (article-goto-body)
+           (unless (bobp)
+             (forward-line -1))
            (set-window-point (get-buffer-window (current-buffer)) (point))
            (gnus-configure-windows 'article)
            t))))))
@@ -3592,8 +3603,8 @@ General format specifiers can also be used.  See
     (gnus-mime-save-part-and-strip "\C-o" "Save and Strip")
     (gnus-mime-copy-part "c" "View As Text, In Other Buffer")
     (gnus-mime-inline-part "i" "View As Text, In This Buffer")
-    (gnus-mime-internalize-part "E" "View Internally")
-    (gnus-mime-externalize-part "e" "View Externally")
+    (gnus-mime-view-part-internally "E" "View Internally")
+    (gnus-mime-view-part-externally "e" "View Externally")
     (gnus-mime-print-part "p" "Print")
     (gnus-mime-pipe-part "|" "Pipe To Command...")
     (gnus-mime-action-on-part "." "Take action on the part")))
@@ -3805,7 +3816,7 @@ General format specifiers can also be used.  See
   (gnus-article-check-buffer)
   (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
         (contents (and handle (mm-get-part handle)))
-        (file (make-temp-name (expand-file-name "mm." mm-tmp-directory)))
+        (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory)))
         (printer (mailcap-mime-info (mm-handle-type handle) "print")))
     (when contents
        (if printer
@@ -3878,7 +3889,7 @@ specified charset."
          (gnus-newsgroup-ignored-charsets 'gnus-all))
        (gnus-article-press-button)))))
 
-(defun gnus-mime-externalize-part (&optional handle)
+(defun gnus-mime-view-part-externally (&optional handle)
   "View the MIME part under point with an external viewer."
   (interactive)
   (gnus-article-check-buffer)
@@ -3894,7 +3905,7 @@ specified charset."
          (mm-remove-part handle)
        (mm-display-part handle)))))
 
-(defun gnus-mime-internalize-part (&optional handle)
+(defun gnus-mime-view-part-internally (&optional handle)
   "View the MIME part under point with an internal viewer.
 If no internal viewer is available, use an external viewer."
   (interactive)
@@ -3954,10 +3965,10 @@ If no internal viewer is available, use an external viewer."
   (interactive "p")
   (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
 
-(defun gnus-article-externalize-part (n)
+(defun gnus-article-view-part-externally (n)
   "View MIME part N externally, which is the numerical prefix."
   (interactive "p")
-  (gnus-article-part-wrapper n 'gnus-mime-externalize-part))
+  (gnus-article-part-wrapper n 'gnus-mime-view-part-externally))
 
 (defun gnus-article-inline-part (n)
   "Inline MIME part N, which is the numerical prefix."
@@ -4136,7 +4147,7 @@ If no internal viewer is available, use an external viewer."
          ;; may change the point.  So we set the window point.
          (set-window-point window point)))
       (let* ((handles (or ihandles (mm-dissect-buffer
-                                   gnus-article-no-strict-mime)
+                                   nil gnus-article-loose-mime)
                          (mm-uu-dissect)))
             buffer-read-only handle name type b e display)
        (when (and (not ihandles)
@@ -4940,6 +4951,8 @@ If given a prefix, show the hidden text instead."
            (let ((gnus-override-method gnus-override-method)
                  (methods (and (stringp article)
                                gnus-refer-article-method))
+                 (backend (car (gnus-find-method-for-group
+                                gnus-newsgroup-name)))
                  result
                  (buffer-read-only nil))
              (if (or (not (listp methods))
@@ -4958,7 +4971,8 @@ If given a prefix, show the hidden text instead."
                (gnus-kill-all-overlays)
                (let ((gnus-newsgroup-name group))
                  (gnus-check-group-server))
-               (when (gnus-request-article article group (current-buffer))
+               (cond
+                ((gnus-request-article article group (current-buffer))
                  (when (numberp article)
                    (gnus-async-prefetch-next group article
                                              gnus-summary-buffer)
@@ -4966,10 +4980,13 @@ If given a prefix, show the hidden text instead."
                      (gnus-backlog-enter-article
                       group article (current-buffer))))
                  (setq result 'article))
-               (if (not result)
-                   (if methods
-                       (setq gnus-override-method (pop methods))
-                     (setq result 'done))))
+                (methods
+                 (setq gnus-override-method (pop methods)))
+                ((not (string-match "^400 "
+                                    (nnheader-get-report backend)))
+                 ;; If we get 400 server disconnect, reconnect and
+                 ;; retry; otherwise, assume the article has expired.
+                 (setq result 'done))))
              (and (eq result 'article) 'article)))
           ;; It was a pseudo.
           (t article)))
@@ -5142,6 +5159,7 @@ groups."
        (start (window-start))
        (p (point))
        (winconf gnus-prev-winconf))
+    (widen) ;; Widen it in case that users narrowed the buffer.
     (funcall func arg)
     (set-buffer buf)
     ;; The cache and backlog have to be flushed somewhat.
@@ -5202,13 +5220,16 @@ groups."
 
 ;;; Internal Variables:
 
-(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\\)\\)"
+(defcustom gnus-button-url-regexp 
+  (if (string-match "[[:digit:]]" "1") ;; support POSIX?
+      "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,[:word:]]+[-a-zA-Z0-9_=#$@~`%&*+|\\/[:word:]]\\)"
+    "\\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)
 
 (defcustom gnus-button-alist
-  `(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>"
+  '(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>"
      0 t gnus-button-handle-news 3)
     ("\\b\\(nntp\\|news\\):\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t
      gnus-button-handle-news 2)
@@ -5227,11 +5248,12 @@ groups."
     ;; This is how URLs _should_ be embedded in text...
     ("<URL: *\\([^<>]*\\)>" 1 t gnus-button-embedded-url 1)
     ;; Raw URLs.
-    (,gnus-button-url-regexp 0 t browse-url 0))
+    (gnus-button-url-regexp 0 t browse-url 0))
   "*Alist of regexps matching buttons in article bodies.
 
 Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
-REGEXP: is the string matching text around the button,
+REGEXP: is the string matching text around the button (can 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
 be added,
@@ -5241,7 +5263,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 regexp
+  :type '(repeat (list (choice regexp variable)
                       (integer :tag "Button")
                       (sexp :tag "Form")
                       (function :tag "Callback")
@@ -5250,14 +5272,14 @@ 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<>,()\"]+"
      0 t gnus-button-mailto 0)
-    ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t browse-url 0)
-    ("^Subject:" ,gnus-button-url-regexp 0 t browse-url 0)
-    ("^[^:]+:" ,gnus-button-url-regexp 0 t browse-url 0)
+    ("^X-[Uu][Rr][Ll]:" gnus-button-url-regexp 0 t browse-url 0)
+    ("^Subject:" gnus-button-url-regexp 0 t browse-url 0)
+    ("^[^:]+:" gnus-button-url-regexp 0 t browse-url 0)
     ("^[^:]+:" "\\bmailto:\\([-a-zA-Z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1)
     ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
      gnus-button-message-id 3))
@@ -5428,7 +5450,7 @@ specified by `gnus-button-alist'."
       (article-goto-body)
       (setq beg (point))
       (while (setq entry (pop alist))
-       (setq regexp (car entry))
+       (setq regexp (eval (car entry)))
        (goto-char beg)
        (while (re-search-forward regexp nil t)
          (let* ((start (and entry (match-beginning (nth 1 entry))))
@@ -5470,7 +5492,7 @@ specified by `gnus-button-alist'."
                               (match-beginning 0))
                          (point-max)))
            (goto-char beg)
-           (while (re-search-forward (nth 1 entry) end t)
+           (while (re-search-forward (eval (nth 1 entry)) end t)
              ;; Each match within a header.
              (let* ((entry (cdr entry))
                     (start (match-beginning (nth 1 entry)))
@@ -5533,7 +5555,7 @@ specified by `gnus-button-alist'."
        (entry nil))
     (while alist
       (setq entry (pop alist))
-      (if (looking-at (car entry))
+      (if (looking-at (eval (car entry)))
          (setq alist nil)
        (setq entry nil)))
     entry))
@@ -5781,11 +5803,11 @@ 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 thes newsgroups
 whose names match REGEXP.
 
 For example:
-((\"chinese\" . gnus-decode-encoded-word-region-by-guess)
+\((\"chinese\" . gnus-decode-encoded-word-region-by-guess)
  mail-decode-encoded-word-region
  (\"chinese\" . rfc1843-decode-region))
 ")