]> code.delx.au - gnu-emacs/blobdiff - lisp/gnus/gnus-sum.el
Finish idna->puny changes in last Message patch
[gnu-emacs] / lisp / gnus / gnus-sum.el
index 683eca1f15a7eccad9c572ed691d1fa3640b2f97..67b4268dbd98a7cced3d0da00e06009216031849 100644 (file)
@@ -1061,9 +1061,7 @@ automatically when it is selected."
   :group 'gnus-summary
   :type 'hook)
 
-(defcustom gnus-summary-display-arrow
-  (and (fboundp 'display-graphic-p)
-       (display-graphic-p))
+(defcustom gnus-summary-display-arrow (display-graphic-p)
   "*If non-nil, display an arrow highlighting the current article."
   :version "22.1"
   :group 'gnus-summary
@@ -2442,10 +2440,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
                                       '((1 . ,cs))))
                                  (gnus-summary-show-article 1))))
                       `[,(symbol-name cs) ,command t]))
-                  (sort (if (fboundp 'coding-system-list)
-                            (coding-system-list)
-                          (mapcar 'car mm-mime-mule-charset-alist))
-                        'string<)))))
+                  (sort (coding-system-list) 'string<)))))
             ("Washing"
              ("Remove Blanks"
               ["Leading" gnus-article-strip-leading-blank-lines t]
@@ -2567,7 +2562,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
          (easy-menu-define
            gnus-article-commands-menu gnus-article-mode-map ""
            (cons "Commands" innards))
-       ;; in Emacs, don't share menu.
+       ;; Don't share the menu.
        (setq gnus-article-commands-menu
              (copy-keymap gnus-summary-article-menu))
        (define-key gnus-article-mode-map [menu-bar commands]
@@ -2943,12 +2938,8 @@ When FORCE, rebuild the tool bar."
             tool-bar-mode
             (or (not gnus-summary-tool-bar-map) force))
     (let* ((load-path
-           (gmm-image-load-path-for-library "gnus"
-                                            "mail/save.xpm"
-                                            nil t))
-           (image-load-path (cons (car load-path)
-                                  (when (boundp 'image-load-path)
-                                    image-load-path)))
+           (image-load-path-for-library "gnus" "mail/save.xpm" nil t))
+           (image-load-path (cons (car load-path) image-load-path))
           (map (gmm-tool-bar-from-list gnus-summary-tool-bar
                                        gnus-summary-tool-bar-zap-list
                                        'gnus-summary-mode-map)))
@@ -3632,7 +3623,7 @@ buffer that was in action when the last article was fetched."
 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
   "Insert a dummy root in the summary buffer."
   (beginning-of-line)
-  (gnus-add-text-properties
+  (add-text-properties
    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
 
@@ -3738,7 +3729,7 @@ buffer that was in action when the last article was fetched."
        (setq gnus-tmp-lines "?")
       (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
     (condition-case ()
-       (gnus-put-text-property
+       (put-text-property
         (point)
         (progn (eval gnus-summary-line-format-spec) (point))
         'gnus-number gnus-tmp-number)
@@ -3855,8 +3846,8 @@ respectively."
 Returns \"  ?  \" if there's bad input or if another error occurs.
 Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
   (condition-case ()
-      (let* ((messy-date (gnus-float-time (gnus-date-get-time messy-date)))
-            (now (gnus-float-time))
+      (let* ((messy-date (float-time (gnus-date-get-time messy-date)))
+            (now (float-time))
             ;;If we don't find something suitable we'll use this one
             (my-format "%b %d '%y"))
        (let* ((difference (- now messy-date))
@@ -4446,9 +4437,9 @@ Returns HEADER if it was entered in the DEPENDENCIES.  Returns nil otherwise."
 
 (defsubst gnus-remove-odd-characters (string)
   "Translate STRING into something that doesn't contain weird characters."
-  (mm-subst-char-in-string
+  (subst-char-in-string
    ?\r ?\-
-   (mm-subst-char-in-string ?\n ?\- string t) t))
+   (subst-char-in-string ?\n ?\- string t) t))
 
 ;; This function has to be called with point after the article number
 ;; on the beginning of the line.
@@ -5068,7 +5059,7 @@ Unscored articles will be counted as having a score of zero."
 (defun gnus-thread-latest-date (thread)
   "Return the highest article date in THREAD."
   (apply 'max
-        (mapcar (lambda (header) (gnus-float-time
+        (mapcar (lambda (header) (float-time
                                   (gnus-date-get-time
                                    (mail-header-date header))))
                 (message-flatten-list thread))))
@@ -5428,7 +5419,7 @@ or a straight list of headers."
            (if (= gnus-tmp-lines -1)
                (setq gnus-tmp-lines "?")
              (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
-           (gnus-put-text-property
+           (put-text-property
             (point)
             (progn (eval gnus-summary-line-format-spec) (point))
             'gnus-number number)
@@ -5578,15 +5569,15 @@ If SELECT-ARTICLES, only select those articles from GROUP."
            (gnus-kill-buffer (current-buffer)))
          (error
           "Couldn't activate group %s: %s"
-          (mm-decode-coding-string group charset)
-          (mm-decode-coding-string (gnus-status-message group) charset))))
+          (decode-coding-string group charset)
+          (decode-coding-string (gnus-status-message group) charset))))
 
     (unless (gnus-request-group group t nil (gnus-get-info group))
       (when (derived-mode-p 'gnus-summary-mode)
        (gnus-kill-buffer (current-buffer)))
       (error "Couldn't request group %s: %s"
-            (mm-decode-coding-string group charset)
-            (mm-decode-coding-string (gnus-status-message group) charset)))
+            (decode-coding-string group charset)
+            (decode-coding-string (gnus-status-message group) charset)))
 
     (when (and gnus-agent
               (gnus-active group))
@@ -6043,6 +6034,11 @@ If SELECT-ARTICLES, only select those articles from GROUP."
                (setq arts (cdr arts)))
              (setq list (cdr all)))))
 
+       ;; When exiting the group, everything that's previously been
+       ;; unseen is now seen.
+       (when (eq (cdr type) 'seen)
+         (setq list (gnus-range-add list gnus-newsgroup-unseen)))
+
        (when (eq (gnus-article-mark-to-type (cdr type)) 'list)
          (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
 
@@ -6822,9 +6818,7 @@ Also do horizontal recentering."
   (when (and gnus-auto-center-summary
             (not (eq gnus-auto-center-summary 'vertical)))
     (gnus-horizontal-recenter))
-  (if (fboundp 'recenter-top-bottom)
-      (recenter-top-bottom n)
-    (recenter n)))
+  (recenter-top-bottom n))
 
 (put 'gnus-recenter 'isearch-scroll t)
 
@@ -7797,7 +7791,7 @@ If BACKWARD, the previous article is selected instead of the next."
                          "exiting"))
          (gnus-summary-next-group nil group backward)))
        (t
-       (when (gnus-key-press-event-p last-input-event)
+       (when (numberp last-input-event)
          ;; Somehow or other, we may now have selected a different
          ;; window.  Make point go back to the summary buffer.
          (when (eq current-summary (current-buffer))
@@ -8321,15 +8315,14 @@ in `nnmail-extra-headers'."
       (gnus-summary-position-point))))
 
 (defun gnus-summary-limit-strange-charsets-predicate (header)
-  (when (fboundp 'char-charset)
-    (let ((string (concat (mail-header-subject header)
-                         (mail-header-from header)))
-         charset found)
-      (dotimes (i (1- (length string)))
-       (setq charset (format "%s" (char-charset (aref string (1+ i)))))
-       (when (string-match "unicode\\|big\\|japanese" charset)
-         (setq found t)))
-      found)))
+  (let ((string (concat (mail-header-subject header)
+                       (mail-header-from header)))
+       charset found)
+    (dotimes (i (1- (length string)))
+      (setq charset (format "%s" (char-charset (aref string (1+ i)))))
+      (when (string-match "unicode\\|big\\|japanese" charset)
+       (setq found t)))
+    found))
 
 (defun gnus-summary-limit-to-predicate (predicate)
   "Limit to articles where PREDICATE returns non-nil.
@@ -8624,7 +8617,7 @@ fetched for this group."
        (gnus-agent nil)
        (gnus-read-all-available-headers t))
     (setq gnus-newsgroup-headers
-         (gnus-merge
+         (cl-merge
           'list gnus-newsgroup-headers
           (gnus-fetch-headers articles nil t)
           'gnus-article-sort-by-number))
@@ -9036,7 +9029,7 @@ non-numeric or nil fetch the number specified by the
            (gnus-sorted-nunion gnus-newsgroup-unreads new-unreads))
       (setq gnus-newsgroup-headers
             (gnus-delete-duplicate-headers
-             (gnus-merge
+             (cl-merge
               'list gnus-newsgroup-headers new-headers
               'gnus-article-sort-by-number)))
       (setq gnus-newsgroup-articles
@@ -9085,7 +9078,7 @@ non-numeric or nil fetch the number specified by the
   (gnus-warp-to-article)
   (when (and (stringp message-id)
             (not (zerop (length message-id))))
-    (setq message-id (replace-regexp-in-string message-id " " ""))
+    (setq message-id (replace-regexp-in-string " " "" message-id))
     ;; Construct the correct Message-ID if necessary.
     ;; Suggested by tale@pawl.rpi.edu.
     (unless (string-match "^<" message-id)
@@ -9563,10 +9556,10 @@ article.  If BACKWARD (the prefix) is non-nil, search backward instead."
 
 (defun gnus-summary-print-truncate-and-quote (string &optional len)
   "Truncate to LEN and quote all \"(\"'s in STRING."
-  (replace-regexp-in-string (if (and len (> (length string) len))
+  (replace-regexp-in-string "[()]" "\\\\\\&"
+                           (if (and len (> (length string) len))
                                (substring string 0 len)
-                             string)
-                           "[()]" "\\\\\\&"))
+                             string)))
 
 (defun gnus-summary-print-article (&optional filename n)
   "Generate and print a PostScript image of the process-marked (mail) articles.
@@ -9653,7 +9646,7 @@ C-u g', show the raw article."
     (gnus-summary-show-article t)
     (let ((gnus-newsgroup-charset
           (or (cdr (assq arg gnus-summary-show-article-charset-alist))
-              (mm-read-coding-system
+              (read-coding-system
                "View as charset: " ;; actually it is coding system.
                (with-current-buffer gnus-article-buffer
                  (mm-detect-coding-region (point) (point-max))))))
@@ -9814,8 +9807,6 @@ prefix specifies how many places to rotate each letter forward."
   ;; Create buttons and stuff...
   (gnus-treat-article nil))
 
-(declare-function idna-to-unicode "ext:idna" (str))
-
 (defun gnus-summary-idna-message (&optional arg)
   "Decode IDNA encoded domain names in the current articles.
 IDNA encoded domain names looks like `xn--bar'.  If a string
@@ -9825,25 +9816,16 @@ invalid IDNA string (`xn--bar' is invalid).
 You must have GNU Libidn (URL `http://www.gnu.org/software/libidn/')
 installed for this command to work."
   (interactive "P")
-  (if (not (and (mm-coding-system-p 'utf-8)
-               (condition-case nil
-                   (require 'idna)
-                 (file-error)
-                 (invalid-operation))
-               (symbol-value 'idna-program)
-               (executable-find (symbol-value 'idna-program))))
-      (gnus-message
-       5 "GNU Libidn not installed properly (`idn' or `idna.el' missing)")
-    (gnus-summary-select-article)
-    (let ((mail-header-separator ""))
-      (gnus-eval-in-buffer-window gnus-article-buffer
-       (save-restriction
-         (widen)
-         (let ((start (window-start))
-               buffer-read-only)
-           (while (re-search-forward "\\(xn--[-0-9a-z]+\\)" nil t)
-             (replace-match (idna-to-unicode (match-string 1))))
-           (set-window-start (get-buffer-window (current-buffer)) start)))))))
+  (gnus-summary-select-article)
+  (let ((mail-header-separator ""))
+    (gnus-eval-in-buffer-window gnus-article-buffer
+      (save-restriction
+       (widen)
+       (let ((start (window-start))
+             buffer-read-only)
+         (while (re-search-forward "\\(xn--[-0-9a-z]+\\)" nil t)
+           (replace-match (puny-decode-domain (match-string 1))))
+         (set-window-start (get-buffer-window (current-buffer)) start))))))
 
 (defun gnus-summary-morse-message (&optional arg)
   "Morse decode the current article."
@@ -9948,7 +9930,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
            encoded to-newsgroup
            to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
       (set (intern (format "gnus-current-%s-group" action))
-          (mm-decode-coding-string
+          (decode-coding-string
            to-newsgroup
            (gnus-group-name-charset to-method to-newsgroup))))
     (unless to-method
@@ -9958,7 +9940,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
     (setq to-newsgroup
          (or encoded
              (and to-newsgroup
-                  (mm-encode-coding-string
+                  (encode-coding-string
                    to-newsgroup
                    (gnus-group-name-charset to-method to-newsgroup)))))
     ;; Check the method we are to move this article to...
@@ -11135,7 +11117,7 @@ If NO-EXPIRE, auto-expiry will be inhibited."
        (goto-char (+ forward (point)))
        ;; Replace the old mark with the new mark.
         (let ((to-insert
-               (mm-subst-char-in-string
+               (subst-char-in-string
                (char-after) mark
                (buffer-substring (point) (1+ (point))))))
           (delete-region (point) (1+ (point)))
@@ -11667,15 +11649,7 @@ Returns nil if no thread was there to be shown."
          (end (or (gnus-summary--inv end) (gnus-summary--inv (1- end))))
         ;; Leave point at bol
         (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point)))))
-        (eoi (when end
-               (if (fboundp 'next-single-char-property-change)
-                   (next-single-char-property-change end 'invisible)
-                 (while (progn
-                          (end-of-line 2)
-                          (and (not (eobp))
-                               (eq (get-char-property (point) 'invisible)
-                                   'gnus-sum))))
-                 (point)))))
+        (eoi (and end (next-single-char-property-change end 'invisible))))
     (when eoi
       (remove-overlays beg eoi 'invisible 'gnus-sum)
       (goto-char orig)
@@ -12079,7 +12053,7 @@ no matter what the properties `:decode' and `:headers' are."
         command result)
     (unless (numberp (car articles))
       (error "No article to pipe"))
-    (setq command (gnus-read-shell-command
+    (setq command (read-shell-command
                   (concat "Shell command on "
                           (if (cdr articles)
                               (format "these %d articles" (length articles))
@@ -12279,7 +12253,7 @@ save those articles instead."
          (setq to-newsgroup default))
       (unless to-newsgroup
        (error "No group name entered"))
-      (setq encoded (mm-encode-coding-string
+      (setq encoded (encode-coding-string
                     to-newsgroup
                     (gnus-group-name-charset to-method to-newsgroup)))
       (or (gnus-active encoded)
@@ -12405,7 +12379,7 @@ If REVERSE, save parts that do not match TYPE."
                  ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
          (setq e (point))
          (forward-line -1)             ; back to `b'
-         (gnus-add-text-properties
+         (add-text-properties
           b (1- e) (list 'gnus-number gnus-reffed-article-number
                          'mouse-face gnus-mouse-face))
          (gnus-data-enter
@@ -12862,10 +12836,10 @@ returned."
                                                (mail-header-number h))
                                              gnus-newsgroup-headers)))
     (setq gnus-newsgroup-headers
-         (gnus-merge 'list
-                     gnus-newsgroup-headers
-                     (gnus-fetch-headers articles nil t)
-                     'gnus-article-sort-by-number))
+         (cl-merge 'list
+                   gnus-newsgroup-headers
+                   (gnus-fetch-headers articles nil t)
+                   'gnus-article-sort-by-number))
     (setq gnus-newsgroup-articles
          (gnus-sorted-nunion gnus-newsgroup-articles articles))
     ;; Suppress duplicates?