Synch to No Gnus 200406292138.
[elisp/gnus.git-] / lisp / gnus-art.el
index b92c81f..50363b6 100644 (file)
@@ -246,7 +246,9 @@ that number.  If it is a floating point number, no signature may be
 longer (in lines) than that number.  If it is a function, the function
 will be called without any parameters, and if it returns nil, there is
 no signature in the buffer.  If it is a string, it will be used as a
-regexp.  If it matches, the text in question is not a signature."
+regexp.  If it matches, the text in question is not a signature.
+
+This can also be a list of the above values."
   :type '(choice (integer :value 200)
                 (number :value 4.0)
                 (function :value fun)
@@ -379,8 +381,6 @@ advertisements.  For example:
            (format format (car spec) (car (cdr 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.
@@ -450,14 +450,14 @@ Example: (_/*word*/_)."
   "Face used for displaying highlighted words."
   :group 'gnus-article-emphasis)
 
-(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
+(defcustom gnus-article-time-format "%a, %d %b %Y %T %Z"
   "Format for display of Date headers in article bodies.
 See `format-time-string' for the possible values.
 
 The variable can also be function, which should return a complete Date
 header.  The function is called with one argument, the time, which can
 be fed to `format-time-string'."
-  :type '(choice string symbol)
+  :type '(choice string function)
   :link '(custom-manual "(gnus)Article Date")
   :group 'gnus-article-washing)
 
@@ -822,7 +822,8 @@ be controlled by `gnus-treat-body-boundary'."
   :type '(choice (item :tag "None" :value nil)
                 string))
 
-(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces")
+(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces"
+                                 "/usr/share/picons")
   "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"
@@ -1696,25 +1697,35 @@ Initialized from `text-mode-syntax-table.")
        (when (eq 1 (point-min))
          (set-window-start (get-buffer-window (current-buffer)) 1)))
     (unless gnus-inhibit-hiding
-      (save-excursion
-       (save-restriction
-         (let ((inhibit-read-only t)
-               (case-fold-search t)
-               (max (1+ (length gnus-sorted-header-list)))
-               (ignored (when (not gnus-visible-headers)
-                          (cond ((stringp gnus-ignored-headers)
-                                 gnus-ignored-headers)
-                                ((listp gnus-ignored-headers)
-                                 (mapconcat 'identity gnus-ignored-headers
-                                            "\\|")))))
-               (visible
-                (cond ((stringp gnus-visible-headers)
-                       gnus-visible-headers)
-                      ((and gnus-visible-headers
-                            (listp gnus-visible-headers))
-                       (mapconcat 'identity gnus-visible-headers "\\|"))))
-               (inhibit-point-motion-hooks t)
-               beg)
+      (let ((inhibit-read-only t)
+           (case-fold-search t)
+           (max (1+ (length gnus-sorted-header-list)))
+           (inhibit-point-motion-hooks t)
+           (cur (current-buffer))
+           ignored visible beg)
+       (save-excursion
+         ;; `gnus-ignored-headers' and `gnus-visible-headers' may be
+         ;; group parameters, so we should go to the summary buffer.
+         (when (prog1
+                   (condition-case nil
+                       (progn (set-buffer gnus-summary-buffer) t)
+                     (error nil))
+                 (setq ignored (when (not gnus-visible-headers)
+                                 (cond ((stringp gnus-ignored-headers)
+                                        gnus-ignored-headers)
+                                       ((listp gnus-ignored-headers)
+                                        (mapconcat 'identity
+                                                   gnus-ignored-headers
+                                                   "\\|"))))
+                       visible (cond ((stringp gnus-visible-headers)
+                                      gnus-visible-headers)
+                                     ((and gnus-visible-headers
+                                           (listp gnus-visible-headers))
+                                      (mapconcat 'identity
+                                                 gnus-visible-headers
+                                                 "\\|")))))
+           (set-buffer cur))
+         (save-restriction
            ;; First we narrow to just the headers.
            (article-narrow-to-head)
            ;; Hide any "From " lines at the beginning of (mail) articles.
@@ -2399,15 +2410,13 @@ If PROMPT (the prefix), prompt for a coding system to use."
            buffer-read-only)
        (article-narrow-to-head)
        (goto-char (point-min))
-       (while (re-search-forward "\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t)
+       (while (re-search-forward "@.*\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t)
          (let (ace unicode)
            (when (save-match-data
                    (and (setq ace (match-string 1))
                         (save-excursion
                           (and (re-search-backward "^[^ \t]" nil t)
                                (looking-at "From\\|To\\|Cc")))
-                        (save-excursion (backward-char)
-                                        (message-idna-inside-rhs-p))
                         (setq unicode (idna-to-unicode ace))))
              (unless (string= ace unicode)
                (replace-match unicode nil nil nil 1)))))))))
@@ -2994,10 +3003,8 @@ should replace the \"Date:\" one, or should be added below it."
            (forward-line -1)
            ;; Do highlighting.
            (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
-             (put-text-property (match-beginning 1) (1+ (match-end 1))
-                                'original-date date)
-             (put-text-property (match-beginning 1) (1+ (match-end 1))
-                                'face bface)
+             (add-text-properties (match-beginning 1) (1+ (match-end 1))
+                                  (list 'original-date date 'face bface))
              (put-text-property (match-beginning 2) (match-end 2)
                                 'face eface))))))))
 
@@ -3010,22 +3017,21 @@ should replace the \"Date:\" one, or should be added below it."
        (cond
         ;; Convert to the local timezone.
         ((eq type 'local)
-         (let ((tz (car (current-time-zone time))))
-           (format "Date: %s %s%02d%02d" (current-time-string time)
-                   (if (> tz 0) "+" "-") (/ (abs tz) 3600)
-                   (/ (% (abs tz) 3600) 60))))
+         (concat "Date: " (message-make-date time)))
         ;; Convert to Universal Time.
         ((eq type 'ut)
          (concat "Date: "
-                 (current-time-string
-                  (let* ((e (parse-time-string date))
-                         (tm (apply 'encode-time e))
-                         (ms (car tm))
-                         (ls (- (cadr tm) (car (current-time-zone time)))))
-                    (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
-                          ((> ls 65535) (list (1+ ms) (- ls 65536)))
-                          (t (list ms ls)))))
-                 " UT"))
+                 (substring
+                  (message-make-date
+                   (let* ((e (parse-time-string date))
+                          (tm (apply 'encode-time e))
+                          (ms (car tm))
+                          (ls (- (cadr tm) (car (current-time-zone time)))))
+                     (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
+                           ((> ls 65535) (list (1+ ms) (- ls 65536)))
+                           (t (list ms ls)))))
+                  0 -5)
+                 "UT"))
         ;; Get the original date from the article.
         ((eq type 'original)
          (concat "Date: " (if (string-match "\n+$" date)
@@ -3859,7 +3865,8 @@ commands:
   (make-local-variable 'gnus-article-ignored-charsets)
   (gnus-set-default-directory)
   (buffer-disable-undo)
-  (setq buffer-read-only t)
+  (setq buffer-read-only t
+       show-trailing-whitespace nil)
   (set-syntax-table gnus-article-mode-syntax-table)
   (gnus-run-hooks 'gnus-article-mode-hook))
 
@@ -4428,6 +4435,8 @@ Deleting parts may malfunction or destroy the article; continue? ")
            (or (mail-content-type-get (mm-handle-disposition data) 'filename)
                none))
           (type (mm-handle-media-type data)))
+      (unless data
+       (error "No MIME part under point"))
       (with-current-buffer (mm-handle-buffer data)
        (let ((bsize (format "%s" (buffer-size))))
          (erase-buffer)
@@ -5380,6 +5389,7 @@ Argument LINES specifies lines to be scrolled up."
              (save-excursion
                (save-restriction
                  (widen)
+                 (forward-line)
                  (eobp)))) ;Real end-of-buffer?
          (progn
            (when gnus-article-over-scroll
@@ -5622,7 +5632,7 @@ the entire article will be yanked."
   (interactive "P")
   (let ((article (cdr gnus-article-current))
        contents)
-    (if (not (gnus-mark-active-p))
+    (if (not (gnus-region-active-p))
        (with-current-buffer gnus-summary-buffer
          (gnus-summary-reply (list (list article)) wide))
       (setq contents (buffer-substring (point) (mark t)))
@@ -5641,7 +5651,7 @@ the entire article will be yanked."
   (interactive)
   (let ((article (cdr gnus-article-current))
        contents)
-      (if (not (gnus-mark-active-p))
+      (if (not (gnus-region-active-p))
          (with-current-buffer gnus-summary-buffer
            (gnus-summary-followup (list (list article))))
        (setq contents (buffer-substring (point) (mark t)))
@@ -6637,16 +6647,16 @@ positives are possible."
     (gnus-button-url-regexp
      0 (>= gnus-button-browse-level 0) browse-url 0)
     ;; man pages
-    ("\\b\\([a-z][a-z]+\\)([1-9])\\W"
+    ("\\b\\([a-z][a-z]+([1-9])\\)\\W"
      0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3))
      gnus-button-handle-man 1)
     ;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x)
-    ("\\b\\([a-z][-_.a-z0-9]+\\)([1-9])\\W"
+    ("\\b\\([a-z][-_.a-z0-9]+([1-9])\\)\\W"
      0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5))
      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]*)\\)\\|\\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
@@ -7051,6 +7061,10 @@ specified by `gnus-button-alist'."
 
 (defun gnus-button-handle-man (url)
   "Fetch a man page."
+  (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
+  (when (eq gnus-button-man-handler 'woman)
+    (setq url (gnus-replace-in-string url "([1-9][X1a-z]*).*\\'" "")))
+  (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
   (funcall gnus-button-man-handler url))
 
 (defun gnus-button-handle-info-url (url)