[bpt/emacs.git] / lisp / gnus / legacy-gnus-agent.el

;;; gnus-agent.el --- Legacy unplugged support for Gnus

;; Copyright (C) 2004-2014 Free Software Foundation, Inc.

;; Author: Kevin Greiner <kgreiner@xpediantsolutions.com>
;; Keywords: news

;; This file is part of GNU Emacs.

;; 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 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
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Conversion functions for the Agent.

;;; Code:
(require 'gnus-start)
(require 'gnus-util)
(require 'gnus-range)
(require 'gnus-agent)

;; Oort Gnus v0.08 - This release updated agent to no longer use
;;                   history file and to support a compressed alist.

(defvar gnus-agent-compressed-agentview-search-only nil)

(defun gnus-agent-convert-to-compressed-agentview (converting-to)
  "Iterates over all agentview files to ensure that they have been
converted to the compressed format."

  (let ((search-in (list gnus-agent-directory))
        here
        members
        member
        converted-something)
    (while (setq here (pop search-in))
      (setq members (directory-files here t))
      (while (setq member (pop members))
        (cond ((string-match "/\\.\\.?$" member)
	       nil)
	      ((file-directory-p member)
	       (push member search-in))
              ((equal (file-name-nondirectory member) ".agentview")
               (setq converted-something
                     (or (gnus-agent-convert-agentview member)
                         converted-something))))))

    (if converted-something
        (gnus-message 4 "Successfully converted Gnus %s offline (agent) files to %s" gnus-newsrc-file-version converting-to))))

(defun gnus-agent-convert-to-compressed-agentview-prompt ()
  (catch 'found-file-to-convert
    (let ((gnus-agent-compressed-agentview-search-only t))
      (gnus-agent-convert-to-compressed-agentview nil))))

(gnus-convert-mark-converter-prompt 'gnus-agent-convert-to-compressed-agentview 'gnus-agent-convert-to-compressed-agentview-prompt)

(defun gnus-agent-convert-agentview (file)
  "Load FILE and do a `read' there."
  (with-temp-buffer
      (nnheader-insert-file-contents file)
      (goto-char (point-min))
      (let ((inhibit-quit t)
            (alist (read (current-buffer)))
            (version (condition-case nil (read (current-buffer))
                       (end-of-file 0)))
            changed-version
            history-file)

        (cond
	 ((= version 0)
	  (let (entry
                (gnus-command-method nil))
            (mm-disable-multibyte) ;; everything is binary
            (erase-buffer)
            (insert "\n")
            (let ((file (concat (file-name-directory file) "/history")))
              (when (file-exists-p file)
                (nnheader-insert-file-contents file)
                (setq history-file file)))

	    (goto-char (point-min))
	    (while (not (eobp))
	      (if (and (looking-at
			"[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)")
		       (string= (gnus-agent-article-name ".agentview" (match-string 2))
				file)
		       (setq entry (assoc (string-to-number (match-string 3)) alist)))
		  (setcdr entry (string-to-number (match-string 1))))
	      (forward-line 1))
	    (setq changed-version t)))
	 ((= version 1)
	  (setq changed-version t)))

        (when changed-version
	  (when gnus-agent-compressed-agentview-search-only
	    (throw 'found-file-to-convert t))

          (erase-buffer)
          (let (article-id day-of-download comp-list compressed)
	    (while alist
	      (setq article-id (caar alist)
		    day-of-download (cdar alist)
		    comp-list (assq day-of-download compressed)
		    alist (cdr alist))
	      (if comp-list
		  (setcdr comp-list (cons article-id (cdr comp-list)))
		(push (list day-of-download article-id) compressed)))
	    (setq alist compressed)
	    (while alist
	      (setq comp-list (pop alist))
	      (setcdr comp-list
		      (gnus-compress-sequence (nreverse (cdr comp-list)))))
            (princ compressed (current-buffer)))
          (insert "\n2\n")
          (write-file file)
          (when history-file
            (delete-file history-file))
          t))))

;; End of Oort Gnus v0.08 updates

;; No Gnus v0.3 - This release provides a mechanism for upgrading gnus
;;                from previous versions.  Therefore, the previous
;;                hacks to handle a gnus-agent-expire-days that
;;                specifies a list of values can be removed.

(defun gnus-agent-unlist-expire-days (converting-to)
  (when (listp gnus-agent-expire-days)
    (let (buffer)
      (unwind-protect
          (save-window-excursion
            (setq buffer (gnus-get-buffer-create " *Gnus agent upgrade*"))
            (set-buffer buffer)
            (erase-buffer)
            (insert "The definition of gnus-agent-expire-days has been changed.\nYou currently have it set to the list:\n  ")
            (gnus-pp gnus-agent-expire-days)

            (insert "\nIn order to use version '" converting-to "' of gnus, you will need to set\n")
            (insert "gnus-agent-expire-days to an integer. If you still wish to set different\n")
            (insert "expiration days to individual groups, you must instead set the\n")
            (insert "'agent-days-until-old group and/or topic parameter.\n")
            (insert "\n")
            (insert "If you would like, gnus can iterate over every group comparing its name to the\n")
            (insert "regular expressions that you currently have in gnus-agent-expire-days.  When\n")
            (insert "gnus finds a match, it will update that group's 'agent-days-until-old group\n")
            (insert "parameter to the value associated with the regular expression.\n")
            (insert "\n")
            (insert "Whether gnus assigns group parameters, or not, gnus will terminate with an\n")
            (insert "ERROR as soon as this function completes.  The reason is that you must\n")
            (insert "manually edit your configuration to either not set gnus-agent-expire-days or\n")
            (insert "to set it to an integer before gnus can be used.\n")
            (insert "\n")
            (insert "Once you have successfully edited gnus-agent-expire-days, gnus will be able to\n")
            (insert "execute past this function.\n")
            (insert "\n")
            (insert "Should gnus use gnus-agent-expire-days to assign\n")
            (insert "agent-days-until-old parameters to individual groups? (Y/N)")

            (switch-to-buffer buffer)
            (beep)
            (beep)

            (let ((echo-keystrokes 0)
                  c)
              (while (progn (setq c (read-char-exclusive))
                            (cond ((or (eq c ?y) (eq c ?Y))
                                         (save-excursion
                                           (let ((groups (gnus-group-listed-groups)))
                                             (while groups
                                               (let* ((group (pop groups))
                                                      (days gnus-agent-expire-days)
                                                      (day (catch 'found
                                                             (while days
                                                               (when (eq 0 (string-match
                                                                            (caar days)
                                                                            group))
                                                                 (throw 'found (cadr (car days))))
                                                               (setq days (cdr days)))
                                                             nil)))
                                                 (when day
                                                   (gnus-group-set-parameter group 'agent-days-until-old
                                                                             day))))))
                                   nil
                                   )
                                  ((or (eq c ?n) (eq c ?N))
                                   nil)
                                  (t
                                   t))))))
        (kill-buffer buffer))
      (error "Change gnus-agent-expire-days to an integer for gnus to start"))))

;; The gnus-agent-unlist-expire-days has its own conversion prompt.
;; Therefore, hide the default prompt.
(gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t)

(defun gnus-agent-unhook-expire-days (converting-to)
  "Remove every lambda from `gnus-group-prepare-hook' that mention the
symbol `gnus-agent-do-once' in their definition.  This should NOT be
necessary as gnus-agent.el no longer adds them.  However, it is
possible that the hook was persistently saved."
    (let ((h t)) ; Iterate from bgn of hook.
      (while h
        (let ((func (progn (when (eq h t)
                             ;; Init h to list of functions.
                             (setq h (cond ((listp gnus-group-prepare-hook)
                                            gnus-group-prepare-hook)
                                           ((boundp 'gnus-group-prepare-hook)
                                            (list gnus-group-prepare-hook)))))
                           (pop h))))

          (when (cond ((byte-code-function-p func)
                       ;; Search def. of compiled function for
                       ;; gnus-agent-do-once string.
                       (let* (definition
                               print-level
                               print-length
                               (standard-output
                                (lambda (char)
                                  (setq definition (cons char definition)))))
                         (princ func) ; Populates definition with reversed list
				      ; of characters.
                         (let* ((i (length definition))
                                (s (make-string i 0)))
                           (while definition
                             (aset s (setq i (1- i)) (pop definition)))

                           (string-match "\\bgnus-agent-do-once\\b" s))))
                      ((listp func)
                       (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; Handles eval'd lambda.
                       ))

            (remove-hook 'gnus-group-prepare-hook func)
            ;; I don't what remove-hook is going to actually do to the
            ;; hook list so start over from the beginning.
            (setq h t))))))

;; gnus-agent-unhook-expire-days is safe in that it does not modify
;; the .newsrc.eld file.
(gnus-convert-mark-converter-prompt 'gnus-agent-unhook-expire-days t)

(provide 'legacy-gnus-agent)

;;; legacy-gnus-agent.el ends here
Commit	Line	Data
bcd3e063 MB	1	;;; gnus-agent.el --- Legacy unplugged support for Gnus
bcd3e063 MB	2
ba318903	3	;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
bcd3e063 MB	4
	5	;; Author: Kevin Greiner <kgreiner@xpediantsolutions.com>
	6	;; Keywords: news
	7
	8	;; This file is part of GNU Emacs.
	9
5e809f55	10	;; GNU Emacs is free software: you can redistribute it and/or modify
bcd3e063	11	;; it under the terms of the GNU General Public License as published by
5e809f55 GM	12	;; the Free Software Foundation, either version 3 of the License, or
5e809f55 GM	13	;; (at your option) any later version.
bcd3e063 MB	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
5e809f55	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
bcd3e063 MB	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
5e809f55	21	;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
bcd3e063 MB	22
	23	;;; Commentary:
	24
	25	;; Conversion functions for the Agent.
	26
	27	;;; Code:
32c3cab6 MB	28	(require 'gnus-start)
	29	(require 'gnus-util)
	30	(require 'gnus-range)
	31	(require 'gnus-agent)
	32
bcd3e063 MB	33	;; Oort Gnus v0.08 - This release updated agent to no longer use
bcd3e063 MB	34	;; history file and to support a compressed alist.
32c3cab6 MB	35
	36	(defvar gnus-agent-compressed-agentview-search-only nil)
	37
	38	(defun gnus-agent-convert-to-compressed-agentview (converting-to)
	39	"Iterates over all agentview files to ensure that they have been
	40	converted to the compressed format."
	41
	42	(let ((search-in (list gnus-agent-directory))
	43	here
	44	members
	45	member
	46	converted-something)
	47	(while (setq here (pop search-in))
	48	(setq members (directory-files here t))
	49	(while (setq member (pop members))
	50	(cond ((string-match "/\\.\\.?$" member)
	51	nil)
	52	((file-directory-p member)
	53	(push member search-in))
	54	((equal (file-name-nondirectory member) ".agentview")
401d9d1a	55	(setq converted-something
32c3cab6 MB	56	(or (gnus-agent-convert-agentview member)
	57	converted-something))))))
	58
	59	(if converted-something
	60	(gnus-message 4 "Successfully converted Gnus %s offline (agent) files to %s" gnus-newsrc-file-version converting-to))))
	61
	62	(defun gnus-agent-convert-to-compressed-agentview-prompt ()
	63	(catch 'found-file-to-convert
	64	(let ((gnus-agent-compressed-agentview-search-only t))
	65	(gnus-agent-convert-to-compressed-agentview nil))))
	66
	67	(gnus-convert-mark-converter-prompt 'gnus-agent-convert-to-compressed-agentview 'gnus-agent-convert-to-compressed-agentview-prompt)
	68
	69	(defun gnus-agent-convert-agentview (file)
	70	"Load FILE and do a `read' there."
	71	(with-temp-buffer
	72	(nnheader-insert-file-contents file)
	73	(goto-char (point-min))
	74	(let ((inhibit-quit t)
	75	(alist (read (current-buffer)))
	76	(version (condition-case nil (read (current-buffer))
	77	(end-of-file 0)))
	78	changed-version
	79	history-file)
	80
	81	(cond
	82	((= version 0)
	83	(let (entry
	84	(gnus-command-method nil))
	85	(mm-disable-multibyte) ;; everything is binary
	86	(erase-buffer)
	87	(insert "\n")
	88	(let ((file (concat (file-name-directory file) "/history")))
	89	(when (file-exists-p file)
	90	(nnheader-insert-file-contents file)
	91	(setq history-file file)))
	92
	93	(goto-char (point-min))
	94	(while (not (eobp))
	95	(if (and (looking-at
	96	"[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)")
	97	(string= (gnus-agent-article-name ".agentview" (match-string 2))
	98	file)
	99	(setq entry (assoc (string-to-number (match-string 3)) alist)))
	100	(setcdr entry (string-to-number (match-string 1))))
	101	(forward-line 1))
	102	(setq changed-version t)))
	103	((= version 1)
	104	(setq changed-version t)))
	105
	106	(when changed-version
	107	(when gnus-agent-compressed-agentview-search-only
	108	(throw 'found-file-to-convert t))
	109
	110	(erase-buffer)
01c52d31 MB	111	(let (article-id day-of-download comp-list compressed)
	112	(while alist
	113	(setq article-id (caar alist)
	114	day-of-download (cdar alist)
	115	comp-list (assq day-of-download compressed)
	116	alist (cdr alist))
	117	(if comp-list
	118	(setcdr comp-list (cons article-id (cdr comp-list)))
	119	(push (list day-of-download article-id) compressed)))
	120	(setq alist compressed)
	121	(while alist
	122	(setq comp-list (pop alist))
	123	(setcdr comp-list
	124	(gnus-compress-sequence (nreverse (cdr comp-list)))))
32c3cab6 MB	125	(princ compressed (current-buffer)))
	126	(insert "\n2\n")
	127	(write-file file)
	128	(when history-file
	129	(delete-file history-file))
	130	t))))
	131
	132	;; End of Oort Gnus v0.08 updates
	133
	134	;; No Gnus v0.3 - This release provides a mechanism for upgrading gnus
	135	;; from previous versions. Therefore, the previous
	136	;; hacks to handle a gnus-agent-expire-days that
	137	;; specifies a list of values can be removed.
	138
	139	(defun gnus-agent-unlist-expire-days (converting-to)
	140	(when (listp gnus-agent-expire-days)
	141	(let (buffer)
	142	(unwind-protect
	143	(save-window-excursion
	144	(setq buffer (gnus-get-buffer-create " Gnus agent upgrade"))
	145	(set-buffer buffer)
	146	(erase-buffer)
	147	(insert "The definition of gnus-agent-expire-days has been changed.\nYou currently have it set to the list:\n ")
	148	(gnus-pp gnus-agent-expire-days)
	149
	150	(insert "\nIn order to use version '" converting-to "' of gnus, you will need to set\n")
	151	(insert "gnus-agent-expire-days to an integer. If you still wish to set different\n")
	152	(insert "expiration days to individual groups, you must instead set the\n")
	153	(insert "'agent-days-until-old group and/or topic parameter.\n")
	154	(insert "\n")
	155	(insert "If you would like, gnus can iterate over every group comparing its name to the\n")
	156	(insert "regular expressions that you currently have in gnus-agent-expire-days. When\n")
	157	(insert "gnus finds a match, it will update that group's 'agent-days-until-old group\n")
	158	(insert "parameter to the value associated with the regular expression.\n")
	159	(insert "\n")
	160	(insert "Whether gnus assigns group parameters, or not, gnus will terminate with an\n")
	161	(insert "ERROR as soon as this function completes. The reason is that you must\n")
	162	(insert "manually edit your configuration to either not set gnus-agent-expire-days or\n")
	163	(insert "to set it to an integer before gnus can be used.\n")
	164	(insert "\n")
	165	(insert "Once you have successfully edited gnus-agent-expire-days, gnus will be able to\n")
	166	(insert "execute past this function.\n")
	167	(insert "\n")
	168	(insert "Should gnus use gnus-agent-expire-days to assign\n")
	169	(insert "agent-days-until-old parameters to individual groups? (Y/N)")
	170
	171	(switch-to-buffer buffer)
	172	(beep)
	173	(beep)
	174
	175	(let ((echo-keystrokes 0)
	176	c)
	177	(while (progn (setq c (read-char-exclusive))
	178	(cond ((or (eq c ?y) (eq c ?Y))
	179	(save-excursion
	180	(let ((groups (gnus-group-listed-groups)))
	181	(while groups
	182	(let* ((group (pop groups))
	183	(days gnus-agent-expire-days)
	184	(day (catch 'found
	185	(while days
	186	(when (eq 0 (string-match
	187	(caar days)
	188	group))
e3e955fe	189	(throw 'found (cadr (car days))))
32c3cab6 MB	190	(setq days (cdr days)))
	191	nil)))
	192	(when day
	193	(gnus-group-set-parameter group 'agent-days-until-old
	194	day))))))
	195	nil
	196	)
	197	((or (eq c ?n) (eq c ?N))
	198	nil)
	199	(t
	200	t))))))
	201	(kill-buffer buffer))
401d9d1a	202	(error "Change gnus-agent-expire-days to an integer for gnus to start"))))
32c3cab6 MB	203
	204	;; The gnus-agent-unlist-expire-days has its own conversion prompt.
	205	;; Therefore, hide the default prompt.
	206	(gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t)
	207
	208	(defun gnus-agent-unhook-expire-days (converting-to)
a179e3f7 SM	209	"Remove every lambda from `gnus-group-prepare-hook' that mention the
a179e3f7 SM	210	symbol `gnus-agent-do-once' in their definition. This should NOT be
32c3cab6 MB	211	necessary as gnus-agent.el no longer adds them. However, it is
32c3cab6 MB	212	possible that the hook was persistently saved."
a179e3f7	213	(let ((h t)) ; Iterate from bgn of hook.
32c3cab6 MB	214	(while h
32c3cab6 MB	215	(let ((func (progn (when (eq h t)
a179e3f7	216	;; Init h to list of functions.
32c3cab6 MB	217	(setq h (cond ((listp gnus-group-prepare-hook)
	218	gnus-group-prepare-hook)
	219	((boundp 'gnus-group-prepare-hook)
	220	(list gnus-group-prepare-hook)))))
	221	(pop h))))
	222
a179e3f7 SM	223	(when (cond ((byte-code-function-p func)
	224	;; Search def. of compiled function for
	225	;; gnus-agent-do-once string.
401d9d1a JB	226	(let* (definition
401d9d1a JB	227	print-level
32c3cab6 MB	228	print-length
	229	(standard-output
	230	(lambda (char)
	231	(setq definition (cons char definition)))))
a179e3f7 SM	232	(princ func) ; Populates definition with reversed list
a179e3f7 SM	233	; of characters.
32c3cab6 MB	234	(let* ((i (length definition))
	235	(s (make-string i 0)))
	236	(while definition
	237	(aset s (setq i (1- i)) (pop definition)))
	238
	239	(string-match "\\bgnus-agent-do-once\\b" s))))
	240	((listp func)
a179e3f7	241	(eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; Handles eval'd lambda.
32c3cab6 MB	242	))
	243
	244	(remove-hook 'gnus-group-prepare-hook func)
	245	;; I don't what remove-hook is going to actually do to the
	246	;; hook list so start over from the beginning.
	247	(setq h t))))))
	248
	249	;; gnus-agent-unhook-expire-days is safe in that it does not modify
	250	;; the .newsrc.eld file.
	251	(gnus-convert-mark-converter-prompt 'gnus-agent-unhook-expire-days t)
	252
bcd3e063 MB	253	(provide 'legacy-gnus-agent)
bcd3e063 MB	254
bcd3e063	255	;;; legacy-gnus-agent.el ends here