* nnrss.el (nnrss-decode-entities-unibyte-string): Use `buffer-string'.
[gnus] / lisp / gnus-art.el
index 627c7ec..1af0325 100644 (file)
@@ -185,6 +185,8 @@ Possible values in this list are:
   'empty       Headers with no content.
   'newsgroups  Newsgroup identical to Gnus group.
   'to-address  To identical to To-address.
+  'to-list     To identical to To-list.
+  'cc-list     CC identical to To-list.
   'followup-to Followup-to identical to Newsgroups.
   'reply-to    Reply-to identical to From.
   'date        Date less than four days old.
@@ -193,6 +195,8 @@ Possible values in this list are:
   :type '(set (const :tag "Headers with no content." empty)
              (const :tag "Newsgroups identical to Gnus group." newsgroups)
              (const :tag "To identical to To-address." to-address)
+             (const :tag "To identical to To-list." to-list)
+             (const :tag "CC identical to To-list." cc-list)
              (const :tag "Followup-to identical to Newsgroups." followup-to)
              (const :tag "Reply-to identical to From." reply-to)
              (const :tag "Date less than four days old." date)
@@ -1584,7 +1588,7 @@ always hide."
              (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t)
                (forward-line -1)
                (gnus-article-hide-text-type
-                (progn (beginning-of-line) (point))
+                (gnus-point-at-bol)
                 (progn
                   (end-of-line)
                   (if (re-search-forward "^[^ \t]" nil t)
@@ -1613,6 +1617,32 @@ always hide."
                              (nth 1 (mail-extract-address-components to))
                              to-address)))
                  (gnus-article-hide-header "to"))))
+            ((eq elem 'to-list)
+             (let ((to (message-fetch-field "to"))
+                   (to-list
+                    (gnus-parameter-to-list
+                     (if (boundp 'gnus-newsgroup-name)
+                         gnus-newsgroup-name ""))))
+               (when (and to to-list
+                          (ignore-errors
+                            (gnus-string-equal
+                             ;; only one address in To
+                             (nth 1 (mail-extract-address-components to))
+                             to-list)))
+                 (gnus-article-hide-header "to"))))
+            ((eq elem 'cc-list)
+             (let ((cc (message-fetch-field "cc"))
+                   (to-list
+                    (gnus-parameter-to-list
+                     (if (boundp 'gnus-newsgroup-name)
+                         gnus-newsgroup-name ""))))
+               (when (and cc to-list
+                          (ignore-errors
+                            (gnus-string-equal
+                             ;; only one address in CC
+                             (nth 1 (mail-extract-address-components cc))
+                             to-list)))
+                 (gnus-article-hide-header "cc"))))
             ((eq elem 'followup-to)
              (when (gnus-string-equal
                     (message-fetch-field "followup-to")
@@ -1674,7 +1704,7 @@ always hide."
     (goto-char (point-min))
     (when (re-search-forward (concat "^" header ":") nil t)
       (gnus-article-hide-text-type
-       (progn (beginning-of-line) (point))
+       (gnus-point-at-bol)
        (progn
         (end-of-line)
         (if (re-search-forward "^[^ \t]" nil t)
@@ -1790,7 +1820,7 @@ unfolded."
       (while (not (eobp))
        (save-restriction
          (mail-header-narrow-to-field)
-         (let ((header (buffer-substring (point-min) (point-max))))
+         (let ((header (buffer-string)))
            (with-temp-buffer
              (insert header)
              (goto-char (point-min))
@@ -3710,7 +3740,7 @@ General format specifiers can also be used.  See Info node
     (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")))
+    (gnus-mime-action-on-part "." "Take action on the part...")))
 
 (defun gnus-article-mime-part-status ()
   (if gnus-article-mime-handle-alist-1
@@ -3730,21 +3760,36 @@ General format specifiers can also be used.  See Info node
       (define-key map (cadr c) (car c)))
     map))
 
-(defun gnus-mime-button-menu (event)
-  "Construct a context-sensitive menu of MIME commands."
-  (interactive "e")
-  (save-window-excursion
-    (let ((pos (event-start event)))
-      (select-window (posn-window pos))
-      (goto-char (posn-point pos))
-      (gnus-article-check-buffer)
-      (let ((response (x-popup-menu
-                      t `("MIME Part"
-                          ("" ,@(mapcar (lambda (c)
-                                          (cons (caddr c) (car c)))
-                                        gnus-mime-button-commands))))))
-       (if response
-           (call-interactively response))))))
+(easy-menu-define gnus-mime-button-menu gnus-mime-button-map "MIME button menu."
+  `("MIME Part"
+    ,@(mapcar (lambda (c)
+               (vector (caddr c) (car c) :enable t)) gnus-mime-button-commands)))
+
+(eval-when-compile
+  (define-compiler-macro popup-menu (&whole form
+                                           menu &optional position prefix)
+    (if (and (fboundp 'popup-menu)
+            (not (memq 'popup-menu (assoc "lmenu" load-history))))
+       form
+      ;; Gnus is probably running under Emacs 20.
+      `(let* ((menu (cdr ,menu))
+             (response (x-popup-menu
+                        t (list (car menu)
+                                (cons "" (mapcar (lambda (c)
+                                                   (cons (caddr c) (car c)))
+                                                 (cdr menu)))))))
+        (if response
+            (call-interactively (nth 3 (assq response menu))))))))
+
+(defun gnus-mime-button-menu (event prefix)
+ "Construct a context-sensitive menu of MIME commands."
+ (interactive "e\nP")
+ (save-window-excursion
+   (let ((pos (event-start event)))
+     (select-window (posn-window pos))
+     (goto-char (posn-point pos))
+     (gnus-article-check-buffer)
+     (popup-menu gnus-mime-button-menu nil prefix))))
 
 (defun gnus-mime-view-all-parts (&optional handles)
   "View all the MIME parts."
@@ -4063,7 +4108,7 @@ If no internal viewer is available, use an external viewer."
   (interactive
    (list (completing-read "Action: " gnus-mime-action-alist nil t)))
   (gnus-article-check-buffer)
-  (let ((action-pair (assoc action gnus-mime-action-alistq)))
+  (let ((action-pair (assoc action gnus-mime-action-alist)))
     (if action-pair
        (funcall (cdr action-pair)))))
 
@@ -4194,16 +4239,14 @@ If no internal viewer is available, use an external viewer."
              (if (window-live-p window)
                  (select-window window)))))
       (goto-char point)
-      (delete-region (gnus-point-at-bol) (progn (forward-line 1) (point)))
+      (gnus-delete-line)
       (gnus-insert-mime-button
        handle id (list (mm-handle-displayed-p handle)))
       (goto-char point))))
 
 (defun gnus-article-goto-part (n)
   "Go to MIME part N."
-  (let ((point (text-property-any (point-min) (point-max) 'gnus-part n)))
-    (when point
-      (goto-char point))))
+  (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-part n)))
 
 (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
   (let ((gnus-tmp-name
@@ -4773,14 +4816,13 @@ not have a face in `gnus-article-boring-faces'."
   "Read article specified by message-id around point."
   (interactive)
   (save-excursion
-    (re-search-backward "<?news:\\|<" (point-at-bol) t)
-    (cond ((re-search-forward
-           gnus-button-mid-or-mail-regexp (point-at-eol) t)
-           (let ((msg-id (concat "<" (match-string 0) ">")))
-             (set-buffer gnus-summary-buffer)
-             (gnus-summary-refer-article msg-id)))
-         (t
-           (error "No references around point")))))
+    (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t)
+    (re-search-forward "<?news:<?\\|<" (gnus-point-at-eol) t)
+    (if (re-search-forward "[^@ ]+@[^ \t>]+" (gnus-point-at-eol) t)
+       (let ((msg-id (concat "<" (match-string 0) ">")))
+         (set-buffer gnus-summary-buffer)
+         (gnus-summary-refer-article msg-id))
+      (error "No references around point"))))
 
 (defun gnus-article-show-summary ()
   "Reconfigure windows to show summary buffer."
@@ -5098,9 +5140,7 @@ If given a prefix, show the hidden text instead."
                 (gnus-cache-request-article article group))
            'article)
           ;; Check the agent cache.
-          ((and gnus-agent gnus-agent-cache gnus-plugged
-                (numberp article)
-                (gnus-agent-request-article article group))
+          ((gnus-agent-request-article article group)
            'article)
           ;; Get the article and put into the article buffer.
           ((or (stringp article)
@@ -5484,6 +5524,8 @@ must return `mid', `mail', `invalid' or `ask'."
     (-3.0
      . "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9].*@")
     ;; "[0-9]{12,}.*\@"
+    ;; compensation for TDMA dated mail addresses:
+    (25.0  . "-dated-[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]+.*@")
     ;;
     (-20.0 . "\\.fsf@")        ;; Gnus
     (-20.0 . "^slrn")
@@ -6474,7 +6516,7 @@ For example:
                                   (search-forward field nil t))
                                 (prog2
                                     (message-narrow-to-field)
-                                    (buffer-substring (point-min) (point-max))
+                                    (buffer-string)
                                   (delete-region (point-min) (point-max))
                                   (widen))))
                          '("Content-Type:" "Content-Transfer-Encoding:"