Remove dead code
[gnus] / lisp / gnus-kill.el
index 02ee66e..c1e5bcb 100644 (file)
@@ -1,5 +1,6 @@
 ;;; gnus-kill.el --- kill commands for Gnus
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
 
 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -7,10 +8,10 @@
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -18,9 +19,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -49,7 +48,8 @@
   :type 'boolean)
 
 (defcustom gnus-winconf-kill-file nil
-  "What does this do, Lars?"
+  "What does this do, Lars?
+I don't know, Per."
   :group 'gnus-score-kill
   :type 'sexp)
 
@@ -159,7 +159,7 @@ gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
   (setq major-mode 'gnus-kill-file-mode)
   (setq mode-name "Kill")
   (lisp-mode-variables nil)
-  (gnus-run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
+  (gnus-run-mode-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
 
 (defun gnus-kill-file-edit-file (newsgroup)
   "Begin editing a kill file for NEWSGROUP.
@@ -328,43 +328,24 @@ If NEWSGROUP is nil, the global kill file is selected."
 
 ;; For kill files
 
-(defun gnus-Newsgroup-kill-file (newsgroup)
-  "Return the name of a kill file for NEWSGROUP.
-If NEWSGROUP is nil, return the global kill file instead."
-  (cond ((or (null newsgroup)
-            (string-equal newsgroup ""))
-        ;; The global kill file is placed at top of the directory.
-        (expand-file-name gnus-kill-file-name gnus-kill-files-directory))
-       (gnus-use-long-file-name
-        ;; Append ".KILL" to capitalized newsgroup name.
-        (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
-                                  "." gnus-kill-file-name)
-                          gnus-kill-files-directory))
-       (t
-        ;; Place "KILL" under the hierarchical directory.
-        (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
-                                  "/" gnus-kill-file-name)
-                          gnus-kill-files-directory))))
-
 (defun gnus-expunge (marks)
   "Remove lines marked with MARKS."
-  (save-excursion
-    (set-buffer gnus-summary-buffer)
+  (with-current-buffer gnus-summary-buffer
     (gnus-summary-limit-to-marks marks 'reverse)))
 
 (defun gnus-apply-kill-file-unless-scored ()
   "Apply .KILL file, unless a .SCORE file for the same newsgroup exists."
   (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name))
-         ;; Ignores global KILL.
-         (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))
+        ;; Ignores global KILL.
+        (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))
           (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE"
                         gnus-newsgroup-name))
-         0)
-        ((or (file-exists-p (gnus-newsgroup-kill-file nil))
-             (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
-         (gnus-apply-kill-file-internal))
-        (t
-         0)))
+        0)
+       ((or (file-exists-p (gnus-newsgroup-kill-file nil))
+            (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
+        (gnus-apply-kill-file-internal))
+       (t
+        0)))
 
 (defun gnus-apply-kill-file-internal ()
   "Apply a kill file to the current newsgroup.
@@ -396,7 +377,7 @@ Returns the number of articles marked as read."
                          gnus-newsgroup-kill-headers))
                  (setq headers (cdr headers))))
              (setq files nil))
-         (setq files (cdr files)))))
+         (setq files (cdr files)))))
     (if (not gnus-newsgroup-kill-headers)
        ()
       (save-window-excursion
@@ -426,16 +407,6 @@ Returns the number of articles marked as read."
        0))))
 
 ;; Parse a Gnus killfile.
-(defun gnus-score-insert-help (string alist idx)
-  (save-excursion
-    (pop-to-buffer "*Score Help*")
-    (buffer-disable-undo (current-buffer))
-    (erase-buffer)
-    (insert string ":\n\n")
-    (while alist
-      (insert (format " %c: %s\n" (caar alist) (nth idx (car alist))))
-      (setq alist (cdr alist)))))
-
 (defun gnus-kill-parse-gnus-kill-file ()
   (goto-char (point-min))
   (gnus-kill-file-mode)
@@ -444,15 +415,14 @@ Returns the number of articles marked as read."
             (setq beg (point))
             (setq form (ignore-errors (read (current-buffer)))))
       (unless (listp form)
-       (error "Illegal kill entry (possibly rn kill file?): %s" form))
+       (error "Invalid kill entry (possibly rn kill file?): %s" form))
       (if (or (eq (car form) 'gnus-kill)
              (eq (car form) 'gnus-raise)
              (eq (car form) 'gnus-lower))
          (progn
            (delete-region beg (point))
            (insert (or (eval form) "")))
-       (save-excursion
-         (set-buffer gnus-summary-buffer)
+       (with-current-buffer gnus-summary-buffer
          (ignore-errors (eval form)))))
     (and (buffer-modified-p)
         gnus-kill-save-kill-file
@@ -491,7 +461,7 @@ Returns the number of articles marked as read."
         (or (cdr (assq modifier mod-to-header)) "subject")
         pattern
         (if (string-match "m" commands)
-            '(gnus-summary-mark-as-unread nil " ")
+            '(gnus-summary-tick-article nil " ")
           '(gnus-summary-mark-as-read nil "X"))
         nil t))
       (forward-line 1))))
@@ -504,7 +474,7 @@ Optional 1st argument COMMAND is default to
        (gnus-summary-mark-as-read nil \"X\").
 If optional 2nd argument ALL is non-nil, articles marked are also applied to.
 If FIELD is an empty string (or nil), entire article body is searched for.
-COMMAND must be a lisp expression or a string representing a key sequence."
+COMMAND must be a Lisp expression or a string representing a key sequence."
   ;; We don't want to change current point nor window configuration.
   (let ((old-buffer (current-buffer)))
     (save-excursion
@@ -521,7 +491,7 @@ COMMAND must be a lisp expression or a string representing a key sequence."
          (if (listp kill-list)
              ;; It is a list.
              (if (not (consp (cdr kill-list)))
-                 ;; It's on the form (regexp . date).
+                 ;; It's of the form (regexp . date).
                  (if (zerop (gnus-execute field (car kill-list)
                                           command nil (not all)))
                      (when (> (days-between date (cdr kill-list))
@@ -564,9 +534,8 @@ COMMAND must be a lisp expression or a string representing a key sequence."
          (and (eq 'quote (car (nth 2 object)))
               (not (consp (cdadr (nth 2 object))))))
       (concat "\n" (gnus-prin1-to-string object))
-    (save-excursion
-      (set-buffer (gnus-get-buffer-create "*Gnus PP*"))
-      (buffer-disable-undo (current-buffer))
+    (with-current-buffer (gnus-get-buffer-create "*Gnus PP*")
+      (buffer-disable-undo)
       (erase-buffer)
       (insert (format "\n(%S %S\n  '(" (nth 0 object) (nth 1 object)))
       (let ((klist (cadr (nth 2 object)))
@@ -586,7 +555,7 @@ COMMAND must be a lisp expression or a string representing a key sequence."
        (insert "\n  t"))
       (insert ")")
       (prog1
-         (buffer-substring (point-min) (point-max))
+         (buffer-string)
        (kill-buffer (current-buffer))))))
 
 (defun gnus-execute-1 (function regexp form header)
@@ -606,7 +575,7 @@ COMMAND must be a lisp expression or a string representing a key sequence."
                     (setq did-kill (string-match regexp value)))
                   (cond ((stringp form) ;Keyboard macro.
                          (execute-kbd-macro form))
-                        ((gnus-functionp form)
+                        ((functionp form)
                          (funcall form))
                         (t
                          (eval form)))))
@@ -619,38 +588,49 @@ COMMAND must be a lisp expression or a string representing a key sequence."
             6 "Searching for article: %d..." (mail-header-number header))
            (gnus-article-setup-buffer)
            (gnus-article-prepare (mail-header-number header) t)
-           (when (save-excursion
-                   (set-buffer gnus-article-buffer)
+           (when (with-current-buffer gnus-article-buffer
                    (goto-char (point-min))
                    (setq did-kill (re-search-forward regexp nil t)))
              (cond ((stringp form)     ;Keyboard macro.
                     (execute-kbd-macro form))
-                   ((gnus-functionp form)
+                   ((functionp form)
                     (funcall form))
                    (t
                     (eval form)))))))
       did-kill)))
 
 (defun gnus-execute (field regexp form &optional backward unread)
-  "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
+  "If FIELD of article header matches REGEXP, execute Lisp FORM (or a string).
 If FIELD is an empty string (or nil), entire article body is searched for.
 If optional 1st argument BACKWARD is non-nil, do backward instead.
 If optional 2nd argument UNREAD is non-nil, articles which are
 marked as read or ticked are ignored."
   (save-excursion
     (let ((killed-no 0)
-         function article header)
+         function article header extras)
       (cond
        ;; Search body.
        ((or (null field)
            (string-equal field ""))
        (setq function nil))
        ;; Get access function of header field.
-       ((fboundp
-        (setq function
-              (intern-soft
-               (concat "mail-header-" (downcase field)))))
-       (setq function `(lambda (h) (,function h))))
+       ((cond ((fboundp
+               (setq function
+                     (intern-soft
+                      (concat "mail-header-" (downcase field)))))
+              (setq function `(lambda (h) (,function h))))
+             ((when (setq extras
+                          (member (downcase field)
+                                  (mapcar (lambda (header)
+                                            (downcase (symbol-name header)))
+                                          gnus-extra-headers)))
+                (setq function
+                      `(lambda (h)
+                         (gnus-extra-header
+                          (quote ,(nth (- (length gnus-extra-headers)
+                                          (length extras))
+                                       gnus-extra-headers))
+                          h)))))))
        ;; Signal error.
        (t
        (error "Unknown header field: \"%s\"" field)))
@@ -682,10 +662,10 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score"
           (concat "options -n "
                   (mapconcat 'identity command-line-args-left " "))))
         (gnus-expert-user t)
-        (nnmail-spool-file nil)
+        (mail-sources nil)
         (gnus-use-dribble-file nil)
         (gnus-batch-mode t)
-        info group newsrc entry
+        info group newsrc unread
         ;; Disable verbose message.
         gnus-novice-user gnus-large-newsgroup
         gnus-options-subscribe gnus-auto-subscribed-groups
@@ -697,12 +677,13 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score"
     (setq newsrc (cdr gnus-newsrc-alist))
     (while (setq info (pop newsrc))
       (setq group (gnus-info-group info)
-           entry (gnus-gethash group gnus-newsrc-hashtb))
+           unread (gnus-group-unread group))
       (when (and (<= (gnus-info-level info) gnus-level-subscribed)
-                (and (car entry)
-                     (or (eq (car entry) t)
-                         (not (zerop (car entry))))))
-       (gnus-summary-read-group group nil t nil t)
+                (and unread
+                     (or (eq unread t)
+                         (not (zerop unread)))))
+       (ignore-errors
+         (gnus-summary-read-group group nil t nil t))
        (when (eq (current-buffer) (get-buffer gnus-summary-buffer))
          (gnus-summary-exit))))
     ;; Exit Emacs.