* gnus-art.el (gnus-article-reply-with-original): Fix
[gnus] / lisp / gnus-art.el
index c06f65c..6f236f3 100644 (file)
@@ -279,6 +279,26 @@ regular expression to match the banner in `gnus-article-banner-alist'.
 A string is used as a regular expression to match the banner
 directly.")
 
+(defcustom gnus-article-address-banner-alist nil
+  "Alist of mail addresses and banners.
+Each element has the form (ADDRESS . BANNER), where ADDRESS is a regexp
+to match a mail address in the From: header, BANNER is one of a symbol
+`signature', an item in `gnus-article-banner-alist', a regexp and nil.
+If ADDRESS matches author's mail address, it will remove things like
+advertisements.  For example:
+
+\((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
+"
+  :type '(repeat
+         (cons
+          (regexp :tag "Address")
+          (choice :tag "Banner" :value nil
+                  (const :tag "Remove signature" signature)
+                  (symbol :tag "Item in `gnus-article-banner-alist'" none)
+                  regexp
+                  (const :tag "None" nil))))
+  :group 'gnus-article-washing)
+
 (defcustom gnus-emphasis-alist
   (let ((format
         "\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)")
@@ -296,6 +316,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.
@@ -351,7 +373,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
@@ -669,6 +695,7 @@ displayed by the first non-nil matching CONTENT face."
     ("\225" "*")
     ("\226" "-")
     ("\227" "--")
+    ("\230" "-")                       ; This might not be correct.
     ("\231" "(TM)")
     ("\233" ">")
     ("\234" "oe")
@@ -1754,7 +1781,7 @@ unfolded."
                    (setq str (concat str gnus-body-boundary-delimiter)))
                  (substring str 0 (1- (window-width))))
                "\n")
-       (gnus-add-text-properties start (point) '(gnus-decoration 'header))))))
+       (gnus-put-text-property start (point) 'gnus-decoration 'header)))))
 
 (defun article-fill-long-lines ()
   "Fill lines that are wider than the window width."
@@ -1768,9 +1795,10 @@ unfolded."
          (while (not (eobp))
            (end-of-line)
            (when (>= (current-column) (min fill-column width))
-             (narrow-to-region (point) (gnus-point-at-bol))
-             (fill-paragraph nil)
-             (goto-char (point-max))
+             (narrow-to-region (min (1+ (point)) (point-max)) (gnus-point-at-bol))
+              (let ((goback (point-marker)))
+                (fill-paragraph nil)
+                (goto-char (marker-position goback)))
              (widen))
            (forward-line 1)))))))
 
@@ -2082,7 +2110,10 @@ If READ-CHARSET, ask for a coding system."
       (goto-char (point-min))
       (while (re-search-forward
              "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
-       (replace-match "\\1\\3" 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.
@@ -2242,6 +2273,18 @@ always hide."
            (banner (gnus-parameter-banner gnus-newsgroup-name))
            (gnus-signature-limit nil)
            buffer-read-only beg end)
+       (when (and gnus-article-address-banner-alist
+                  (not banner))
+         (setq banner
+               (let ((from (save-restriction
+                             (widen)
+                             (article-narrow-to-head)
+                             (caar (mail-header-parse-addresses
+                                    (mail-fetch-field "from"))))))
+                 (catch 'found
+                   (dolist (pair gnus-article-address-banner-alist)
+                     (when (string-match (car pair) from)
+                       (throw 'found (cdr pair))))))))
        (when banner
          (article-goto-body)
          (cond
@@ -2585,11 +2628,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))))
@@ -2664,7 +2710,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."
@@ -3231,7 +3277,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
@@ -4785,31 +4830,34 @@ the entire article will be yanked."
   (interactive "P")
   (let ((article (cdr gnus-article-current)) cont)
     (if (not (mark t))
-       (gnus-summary-reply (list (list article)) wide)
+       (with-current-buffer gnus-summary-buffer
+         (gnus-summary-reply (list (list article)) wide))
       (setq cont (buffer-substring (point) (mark t)))
       ;; Deactivate active regions.
       (when (and (boundp 'transient-mark-mode)
                 transient-mark-mode)
        (setq mark-active nil))
-      (gnus-summary-reply
-       (list (list article cont)) wide))))
+      (with-current-buffer gnus-summary-buffer
+       (gnus-summary-reply
+        (list (list article cont)) wide)))))
 
 (defun gnus-article-followup-with-original ()
   "Compose a followup to the current article.
 The text in the region will be yanked.  If the region isn't active,
 the entire article will be yanked."
   (interactive)
-  (let ((article (cdr gnus-article-current))
-       cont)
-    (if (not (mark t))
-       (gnus-summary-followup (list (list article)))
-      (setq cont (buffer-substring (point) (mark t)))
-      ;; Deactivate active regions.
-      (when (and (boundp 'transient-mark-mode)
-                transient-mark-mode)
-       (setq mark-active nil))
-      (gnus-summary-followup
-       (list (list article cont))))))
+  (let ((article (cdr gnus-article-current)) cont)
+      (if (not (mark t))
+         (with-current-buffer gnus-summary-buffer
+           (gnus-summary-followup (list (list article))))
+       (setq cont (buffer-substring (point) (mark t)))
+       ;; Deactivate active regions.
+       (when (and (boundp 'transient-mark-mode)
+                  transient-mark-mode)
+         (setq mark-active nil))
+       (with-current-buffer gnus-summary-buffer
+         (gnus-summary-followup
+          (list (list article cont)))))))
 
 (defun gnus-article-hide (&optional arg force)
   "Hide all the gruft in the current article.
@@ -4940,6 +4988,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 +5008,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 +5017,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)))
@@ -5203,13 +5257,25 @@ 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-man-handler 'man
+  "Function to use for displaying man pages.
+The function must take at least one argument with a string naming the
+man page."
+  :type '(choice (function-item :tag "Man" man)
+                (function-item :tag "Woman" woman)
+                (function :tag "Other"))
+  :group 'gnus-article-buttons)
+
 (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)
@@ -5228,11 +5294,14 @@ 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)
+    ;; man pages
+    ("\\b\\([a-z]+\\)([0-9])\\W" 0 t gnus-button-handle-man 1))
   "*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,
@@ -5251,14 +5320,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))
@@ -5471,7 +5540,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)))
@@ -5601,6 +5670,10 @@ specified by `gnus-button-alist'."
      (group
       (gnus-button-fetch-group url)))))
 
+(defun gnus-button-handle-man (url)
+  "Fetch a man page."
+  (funcall gnus-button-man-handler url))
+
 (defun gnus-button-handle-info (url)
   "Fetch an info URL."
   (if (string-match
@@ -5782,11 +5855,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))
 ")