(uncompface): Be verbose when changing `uncompface-use-external'.
[gnus] / lisp / gnus-art.el
index 81da9ce..7ccf568 100644 (file)
@@ -337,8 +337,6 @@ advertisements.  For example:
            (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.
@@ -755,6 +753,7 @@ When nil (the default value), then some MIME parts do not get buttons,
 as described by the variables `gnus-buttonized-mime-types' and
 `gnus-unbuttonized-mime-types'."
   :version "21.3"
+  :group 'gnus-article-mime
   :type 'boolean)
 
 (defcustom gnus-body-boundary-delimiter "_"
@@ -794,7 +793,7 @@ on parts -- for instance, adding Vcard info to a database."
   "An alist of MIME types to functions to display them."
   :version "21.1"
   :group 'gnus-article-mime
-  :type 'alist)
+  :type '(repeat (cons :format "%v" (string :tag "MIME type") function)))
 
 (defcustom gnus-article-date-lapsed-new-header nil
   "Whether the X-Sent and Date headers can coexist.
@@ -2057,7 +2056,7 @@ unfolded."
            (save-restriction
              (mail-narrow-to-head)
              (while (gnus-article-goto-header "Face")
-               (push (mail-header-field-value) faces))))
+               (setq faces (nconc faces (list (mail-header-field-value)))))))
          (while (setq face (pop faces))
            (let ((png (gnus-convert-face-to-png face))
                  image)
@@ -2259,15 +2258,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)))))))))
@@ -2484,18 +2481,25 @@ always hide."
          (article-really-strip-banner
           (gnus-parameter-banner gnus-newsgroup-name)))
        (when gnus-article-address-banner-alist
-         (article-really-strip-banner
-          (let ((from (save-restriction
-                        (widen)
-                        (article-narrow-to-head)
-                        (mail-fetch-field "from"))))
-            (when (and from
-                       (setq from
-                             (caar (mail-header-parse-addresses from))))
-              (catch 'found
-                (dolist (pair gnus-article-address-banner-alist)
-                  (when (string-match (car pair) from)
-                    (throw 'found (cdr pair)))))))))))))
+         ;; It is necessary to encode from fields before checking,
+         ;; because `mail-header-parse-addresses' does not work
+         ;; (reliably) on decoded headers.  And more, it is
+         ;; impossible to use `gnus-fetch-original-field' here,
+         ;; because `article-strip-banner' may be called in draft
+         ;; buffers to preview them.
+         (let ((from (save-restriction
+                       (widen)
+                       (article-narrow-to-head)
+                       (mail-fetch-field "from"))))
+           (when (and from
+                      (setq from
+                            (caar (mail-header-parse-addresses
+                                   (mail-encode-encoded-word-string from)))))
+             (catch 'found
+               (dolist (pair gnus-article-address-banner-alist)
+                 (when (string-match (car pair) from)
+                   (throw 'found
+                          (article-really-strip-banner (cdr pair)))))))))))))
 
 (defun article-really-strip-banner (banner)
   "Strip the banner specified by the argument."
@@ -3988,6 +3992,9 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
   (gnus-article-check-buffer)
   (when (gnus-group-read-only-p)
     (error "The current group does not support deleting of parts"))
+  (when (mm-complicated-handles gnus-article-mime-handles)
+    (error "\
+The current article has a complicated MIME structure, giving up..."))
   (when (gnus-yes-or-no-p "\
 Deleting parts may malfunction or destroy the article; continue? ")
     (let* ((data (get-text-property (point) 'gnus-data))
@@ -4019,6 +4026,9 @@ Replace it with some information about the removed part."
   (gnus-article-check-buffer)
   (when (gnus-group-read-only-p)
     (error "The current group does not support deleting of parts"))
+  (when (mm-complicated-handles gnus-article-mime-handles)
+    (error "\
+The current article has a complicated MIME structure, giving up..."))
   (when (gnus-yes-or-no-p "\
 Deleting parts may malfunction or destroy the article; continue? ")
     (let* ((data (get-text-property (point) 'gnus-data))
@@ -4032,6 +4042,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)
@@ -5138,11 +5150,13 @@ not have a face in `gnus-article-boring-faces'."
       (let ((obuf (current-buffer))
            (owin (current-window-configuration))
            (opoint (point))
-           (summary gnus-article-current-summary)
-           func in-buffer selected)
-       (if not-restore-window
-           (pop-to-buffer summary 'norecord)
-         (switch-to-buffer summary 'norecord))
+           win func in-buffer selected new-sum-start new-sum-hscroll)
+       (cond (not-restore-window
+              (pop-to-buffer gnus-article-current-summary 'norecord))
+             ((setq win (get-buffer-window gnus-article-current-summary))
+              (select-window win))
+             (t
+              (switch-to-buffer gnus-article-current-summary 'norecord)))
        (setq in-buffer (current-buffer))
        ;; We disable the pick minor mode commands.
        (if (and (setq func (let (gnus-pick-mode)
@@ -5150,7 +5164,10 @@ not have a face in `gnus-article-boring-faces'."
                 (functionp func))
            (progn
              (call-interactively func)
-             (setq new-sum-point (point))
+             (when (eq win (selected-window))
+               (setq new-sum-point (point)
+                     new-sum-start (window-start win)
+                     new-sum-hscroll (window-hscroll win))
              (when (eq in-buffer (current-buffer))
                (setq selected (gnus-summary-select-article))
                (set-buffer obuf)
@@ -5162,10 +5179,12 @@ not have a face in `gnus-article-boring-faces'."
                                    1)
                  (set-window-point (get-buffer-window (current-buffer))
                                    (point)))
-               (let ((win (get-buffer-window gnus-article-current-summary)))
-                 (when win
-                   (set-window-point win new-sum-point))))    )
-         (switch-to-buffer gnus-article-buffer)
+               (when (and (not not-restore-window)
+                          new-sum-point)
+                 (set-window-point win new-sum-point)
+                 (set-window-start win new-sum-start)
+                 (set-window-hscroll win new-sum-hscroll)))))
+         (set-window-configuration owin)
          (ding))))))
 
 (defun gnus-article-describe-key (key)
@@ -5217,7 +5236,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)))
@@ -5236,7 +5255,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)))
@@ -6109,16 +6128,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]*)\\)\\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
@@ -6480,6 +6499,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)