gmm-utils.el (gmm-called-interactively-p): Restore as a macro.
[gnus] / lisp / gnus-bookmark.el
1 ;;; gnus-bookmark.el --- Bookmarks in Gnus
2
3 ;; Copyright (C) 2006-2012  Free Software Foundation, Inc.
4
5 ;; Author: Bastien Guerry <bzg AT altern DOT org>
6 ;; Keywords: news
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
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
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
22
23 ;;; Commentary:
24
25 ;; This file implements real bookmarks for Gnus, closely following the way
26 ;; `bookmark.el' handles bookmarks.  Most of the code comes from
27 ;; `bookmark.el'.
28 ;;
29 ;; Set a Gnus bookmark:
30 ;; M-x `gnus-bookmark-set' from the summary buffer.
31 ;;
32 ;; Jump to a Gnus bookmark:
33 ;; M-x `gnus-bookmark-jump'.
34 ;;
35 ;; Display a list of bookmarks
36 ;; M-x `gnus-bookmark-bmenu-list'.
37 ;;
38
39 ;;; Todo:
40
41 ;; - add tags to bookmarks
42 ;; - don't write file each time a bookmark is created
43 ;; - better annotation interactive buffer
44 ;; - edit annotation in gnus-bookmark-bmenu
45 ;; - sort gnus-bookmark-buffer by author/subject/date/group/message-id
46 ;; - auto-bmk-name customizable format
47 ;; - renaming bookmarks in gnus-bookmark-bmenu-list
48 ;; - better (formatted string) display in bmenu-list
49
50 ;; - Integrate the `gnus-summary-*-bookmark' functionality
51 ;; - Initialize defcustoms from corresponding `bookmark.el' variables?
52
53 ;;; Code:
54
55 (require 'gnus-sum)
56
57 ;; FIXME: should avoid using C-c (no?)
58 ;; (define-key gnus-summary-mode-map "\C-crm" 'gnus-bookmark-set)
59 ;; (define-key global-map "\C-crb" 'gnus-bookmark-jump)
60 ;; (define-key global-map "\C-crj" 'gnus-bookmark-jump)
61 ;; (define-key global-map "\C-crl" 'gnus-bookmark-bmenu-list)
62
63 ;; FIXME: Add keybindings, see
64 ;; http://thread.gmane.org/gmane.emacs.gnus.general/63101/focus=63379
65 ;; http://thread.gmane.org/v9fxx9fkm4.fsf@marauder.physik.uni-ulm.de
66
67 ;; FIXME: Check if `gnus-bookmark.el' should use
68 ;; `bookmark-make-cell-function'.
69 ;; Cf. http://article.gmane.org/gmane.emacs.gnus.general/66076
70
71 (defgroup gnus-bookmark nil
72   "Setting, annotation and jumping to Gnus bookmarks."
73   :group 'gnus)
74
75 (defcustom gnus-bookmark-default-file
76   (cond
77    ;; Backward compatibility with previous versions:
78    ((file-exists-p "~/.gnus.bmk") "~/.gnus.bmk")
79    (t (nnheader-concat gnus-directory "bookmarks.el")))
80   "The default Gnus bookmarks file."
81   :type 'string
82   :group 'gnus-bookmark)
83
84 (defcustom gnus-bookmark-file-coding-system
85   (if (mm-coding-system-p 'iso-2022-7bit)
86       'iso-2022-7bit)
87   "Coding system used for writing Gnus bookmark files."
88   :type '(symbol :tag "Coding system")
89   :group 'gnus-bookmark)
90
91 (defcustom gnus-bookmark-sort-flag t
92   "Non-nil means Gnus bookmarks are sorted by bookmark names.
93 Otherwise they will be displayed in LIFO order (that is,
94 most recently set ones come first, oldest ones come last)."
95   :type 'boolean
96   :group 'gnus-bookmark)
97
98 (defcustom gnus-bookmark-bmenu-toggle-infos t
99   "Non-nil means show details when listing Gnus bookmarks.
100 List of details is defined in `gnus-bookmark-bookmark-inline-details'.
101 This may result in truncated bookmark names.  To disable this, put the
102 following in your `.emacs' file:
103
104 \(setq gnus-bookmark-bmenu-toggle-infos nil\)"
105   :type 'boolean
106   :group 'gnus-bookmark)
107
108 (defcustom gnus-bookmark-bmenu-file-column 30
109   "Column at which to display details in a buffer listing Gnus bookmarks.
110 You can toggle whether details are shown with \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-toggle-infos]."
111   :type 'integer
112   :group 'gnus-bookmark)
113
114 (defcustom gnus-bookmark-use-annotations nil
115   "If non-nil, ask for an annotation when setting a bookmark."
116   :type 'boolean
117   :group 'gnus-bookmark)
118
119 (defcustom gnus-bookmark-bookmark-inline-details '(author)
120   "Details to be shown with `gnus-bookmark-bmenu-toggle-infos'.
121 The default value is \(subject\)."
122   :type '(list :tag "Gnus bookmark details"
123                (set :inline t
124                     (const :tag "Author" author)
125                     (const :tag "Subject" subject)
126                     (const :tag "Date" date)
127                     (const :tag "Group" group)
128                     (const :tag "Message-id" message-id)))
129   :group 'gnus-bookmark)
130
131 (defcustom gnus-bookmark-bookmark-details
132   '(author subject date group annotation)
133   "Details to be shown with `gnus-bookmark-bmenu-show-details'.
134 The default value is \(author subject date group annotation\)."
135   :type '(list :tag "Gnus bookmark details"
136                (set :inline t
137                     (const :tag "Author" author)
138                     (const :tag "Subject" subject)
139                     (const :tag "Date" date)
140                     (const :tag "Group" group)
141                     (const :tag "Message-id" message-id)
142                     (const :tag "Annotation" annotation)))
143   :group 'gnus-bookmark)
144
145 (defface gnus-bookmark-menu-heading
146   '((t (:inherit font-lock-type-face)))
147   "Face used to highlight the heading in Gnus bookmark menu buffers."
148   :version "23.1" ;; No Gnus
149   :group 'gnus-bookmark)
150
151 (defconst gnus-bookmark-end-of-version-stamp-marker
152   "-*- End Of Bookmark File Format Version Stamp -*-\n"
153   "This string marks the end of the version stamp in a Gnus bookmark file.")
154
155 (defconst gnus-bookmark-file-format-version 0
156   "The current version of the format used by bookmark files.
157 You should never need to change this.")
158
159 (defvar gnus-bookmark-alist ()
160   "Association list of Gnus bookmarks and their records.
161 The format of the alist is
162
163      \(BMK1 BMK2 ...\)
164
165 where each BMK is of the form
166
167 \(NAME
168   \(group . GROUP\)
169   \(message-id . MESSAGE-ID\)
170   \(author . AUTHOR\)
171   \(date . DATE\)
172   \(subject . SUBJECT\)
173   \(annotation . ANNOTATION\)\)
174
175 So the cdr of each bookmark is an alist too.")
176
177 (defmacro gnus-bookmark-mouse-available-p ()
178   "Return non-nil if a mouse is available."
179   (if (featurep 'xemacs)
180       '(device-on-window-system-p)
181     '(display-mouse-p)))
182
183 (defun gnus-bookmark-remove-properties (string)
184   "Remove all text properties from STRING."
185   (set-text-properties 0 (length string) nil string)
186   string)
187
188 ;;;###autoload
189 (defun gnus-bookmark-set ()
190   "Set a bookmark for this article."
191   (interactive)
192   (gnus-bookmark-maybe-load-default-file)
193   (if (or (not (eq major-mode 'gnus-summary-mode))
194           (not gnus-article-current))
195       (error "Please select an article in the Gnus summary buffer")
196     (let* ((group (car gnus-article-current))
197            (article (cdr gnus-article-current))
198            (header (gnus-summary-article-header article))
199            (author (mail-header-from header))
200            (message-id (mail-header-id header))
201            (date (mail-header-date header))
202            (subject (gnus-summary-subject-string))
203            (bmk-name (gnus-bookmark-set-bookmark-name group author subject))
204            ;; Maybe ask for annotation
205            (annotation
206             (if gnus-bookmark-use-annotations
207                  (read-from-minibuffer
208                   (format "Annotation for %s: " bmk-name)) "")))
209       ;; Set the bookmark list
210       (setq gnus-bookmark-alist
211             (cons
212              (list (gnus-bookmark-remove-properties bmk-name)
213                    (gnus-bookmark-make-record
214                     group message-id author date subject annotation))
215              gnus-bookmark-alist))))
216   (gnus-bookmark-bmenu-surreptitiously-rebuild-list)
217   (gnus-bookmark-write-file))
218
219 (defun gnus-bookmark-make-record
220   (group message-id author date subject annotation)
221   "Return the record part of a new bookmark, given GROUP MESSAGE-ID AUTHOR DATE SUBJECT and ANNOTATION."
222   (let ((the-record
223          `((group . ,(gnus-bookmark-remove-properties group))
224            (message-id . ,(gnus-bookmark-remove-properties message-id))
225            (author . ,(gnus-bookmark-remove-properties author))
226            (date . ,(gnus-bookmark-remove-properties date))
227            (subject . ,(gnus-bookmark-remove-properties subject))
228            (annotation . ,(gnus-bookmark-remove-properties annotation)))))
229     the-record))
230
231 (defun gnus-bookmark-set-bookmark-name (group author subject)
232   "Set bookmark name from GROUP AUTHOR and SUBJECT."
233   (let* ((subject (split-string subject))
234          (default-name-0 ;; Should be merged with -1?
235            (concat (car (nreverse (delete "" (split-string group "[\\.:]"))))
236                    "-" (car (split-string author))
237                    "-" (car subject) "-" (cadr subject)))
238          (default-name-1
239            ;; Strip "[]" chars from the bookmark name:
240            (gnus-replace-in-string default-name-0 "[]_[]" ""))
241          (name (read-from-minibuffer
242                 (format "Set bookmark (%s): " default-name-1)
243                 nil nil nil nil
244                 default-name-1)))
245     (if (string-equal name "")
246         default-name-1
247       name)))
248
249 (defun gnus-bookmark-write-file ()
250   "Write currently defined Gnus bookmarks into `gnus-bookmark-default-file'."
251   (interactive)
252   (save-excursion
253     (save-window-excursion
254       ;; Avoir warnings?
255       ;; (message "Saving Gnus bookmarks to file %s..." gnus-bookmark-default-file)
256       (set-buffer (get-buffer-create  " *Gnus bookmarks*"))
257       (erase-buffer)
258       (gnus-bookmark-insert-file-format-version-stamp)
259       (pp gnus-bookmark-alist (current-buffer))
260       (condition-case nil
261           (let ((coding-system-for-write gnus-bookmark-file-coding-system))
262             (write-region (point-min) (point-max)
263                           gnus-bookmark-default-file))
264         (file-error (message "Can't write %s"
265                              gnus-bookmark-default-file)))
266       (kill-buffer (current-buffer))
267       (message
268        "Saving Gnus bookmarks to file %s...done"
269        gnus-bookmark-default-file))))
270
271 (defun gnus-bookmark-insert-file-format-version-stamp ()
272   "Insert text indicating current version of Gnus bookmark file format."
273   (insert
274    (format ";;;; Gnus Bookmark Format Version %d %s;;;;\n"
275            gnus-bookmark-file-format-version
276            (if gnus-bookmark-file-coding-system
277                (concat "-*- coding: "
278                        (symbol-name gnus-bookmark-file-coding-system)
279                        "; -*- ")
280              "")))
281   (insert ";;; This format is meant to be slightly human-readable;\n"
282           ";;; nevertheless, you probably don't want to edit it.\n"
283           ";;; "
284           gnus-bookmark-end-of-version-stamp-marker))
285
286 ;;;###autoload
287 (defun gnus-bookmark-jump (&optional bmk-name)
288   "Jump to a Gnus bookmark (BMK-NAME)."
289   (interactive)
290   (gnus-bookmark-maybe-load-default-file)
291   (let* ((bookmark (or bmk-name
292                        (gnus-completing-read "Jump to bookmarked article"
293                                              (mapcar 'car gnus-bookmark-alist))))
294          (bmk-record (cadr (assoc bookmark gnus-bookmark-alist)))
295          (group (cdr (assoc 'group bmk-record)))
296          (message-id (cdr (assoc 'message-id bmk-record))))
297     (when group
298       (unless (get-buffer gnus-group-buffer)
299         (gnus-no-server))
300       (gnus-activate-group group)
301       (gnus-group-quick-select-group 0 group))
302     (if message-id
303       (or (gnus-summary-goto-article message-id nil 'force)
304           (if (fboundp 'gnus-summary-insert-cached-articles)
305               (progn
306                 (gnus-summary-insert-cached-articles)
307                 (gnus-summary-goto-article message-id nil 'force))
308             (message "Message could not be found."))))))
309
310 (defvar gnus-bookmark-already-loaded nil)
311
312 (defun gnus-bookmark-alist-from-buffer ()
313   "Return a `gnus-bookmark-alist' from the current buffer.
314 The buffer must of course contain Gnus bookmark format information.
315 Does not care from where in the buffer it is called, and does not
316 affect point."
317   (save-excursion
318     (goto-char (point-min))
319     (if (search-forward
320          gnus-bookmark-end-of-version-stamp-marker nil t)
321         (read (current-buffer))
322       ;; Else no hope of getting information here.
323       (error "Not Gnus bookmark format"))))
324
325 (defun gnus-bookmark-load (file)
326   "Load Gnus bookmarks from FILE (which must be in bookmark format)."
327   (interactive
328    (list (read-file-name
329           (format "Load Gnus bookmarks from: (%s) "
330                   gnus-bookmark-default-file)
331           "~/" gnus-bookmark-default-file 'confirm)))
332   (setq file (expand-file-name file))
333   (if (file-readable-p file)
334       (save-excursion
335         (save-window-excursion
336           (set-buffer (let ((enable-local-variables nil))
337                         (find-file-noselect file)))
338           (goto-char (point-min))
339           (let ((blist (gnus-bookmark-alist-from-buffer)))
340             (if (listp blist)
341                 (progn (setq gnus-bookmark-already-loaded t)
342                        (setq gnus-bookmark-alist blist))
343               (error "Not Gnus bookmark format")))))))
344
345 (defun gnus-bookmark-maybe-load-default-file ()
346   "Maybe load Gnus bookmarks in `gnus-bookmark-alist'."
347   (and (not gnus-bookmark-already-loaded)
348        (null gnus-bookmark-alist)
349        (file-readable-p (expand-file-name gnus-bookmark-default-file))
350        (gnus-bookmark-load gnus-bookmark-default-file)))
351
352 (defun gnus-bookmark-maybe-sort-alist ()
353   "Return the gnus-bookmark-alist for display.
354 If the gnus-bookmark-sort-flag is non-nil, then return a sorted
355 copy of the alist."
356   (when gnus-bookmark-sort-flag
357     (setq gnus-bookmark-alist
358           (sort (copy-alist gnus-bookmark-alist)
359                 (function
360                  (lambda (x y) (string-lessp (car x) (car y))))))))
361
362 ;;;###autoload
363 (defun gnus-bookmark-bmenu-list ()
364   "Display a list of existing Gnus bookmarks.
365 The list is displayed in a buffer named `*Gnus Bookmark List*'.
366 The leftmost column displays a D if the bookmark is flagged for
367 deletion, or > if it is flagged for displaying."
368   (interactive)
369   (gnus-bookmark-maybe-load-default-file)
370   (if (gmm-called-interactively-p 'any)
371       (switch-to-buffer (get-buffer-create "*Gnus Bookmark List*"))
372     (set-buffer (get-buffer-create "*Gnus Bookmark List*")))
373   (let ((inhibit-read-only t)
374         alist name start end)
375     (erase-buffer)
376     (insert "% Gnus Bookmark\n- --------\n")
377     (add-text-properties (point-min) (point)
378                          '(font-lock-face gnus-bookmark-menu-heading))
379     ;; sort before displaying
380     (gnus-bookmark-maybe-sort-alist)
381     ;; Display gnus bookmarks
382     (setq alist gnus-bookmark-alist)
383     (while alist
384       (setq name (gnus-bookmark-name-from-full-record (pop alist)))
385       ;; if a Gnus bookmark has an annotation, prepend a "*"
386       ;; in the list of bookmarks.
387       (insert (if (member (gnus-bookmark-get-annotation name) (list nil ""))
388                   "  "
389                 " *"))
390       (if (gnus-bookmark-mouse-available-p)
391           (add-text-properties
392            (prog1
393                (point)
394              (insert name))
395            (let ((end (point)))
396              (prog2
397                  (re-search-backward "[^ \t]")
398                  (1+ (point))
399                (goto-char end)
400                (insert "\n")))
401            `(mouse-face highlight follow-link t
402                         help-echo ,(format "%s: go to this article"
403                                            (aref gnus-mouse-2 0))))
404         (insert name "\n")))
405     (goto-char (point-min))
406     (forward-line 2)
407     (gnus-bookmark-bmenu-mode)
408     (if gnus-bookmark-bmenu-toggle-infos
409         (gnus-bookmark-bmenu-toggle-infos t))))
410
411 (defun gnus-bookmark-bmenu-surreptitiously-rebuild-list ()
412   "Rebuild the Bookmark List if it exists.
413 Don't affect the buffer ring order."
414   (if (get-buffer "*Gnus Bookmark List*")
415       (save-excursion
416         (save-window-excursion
417           (gnus-bookmark-bmenu-list)))))
418
419 (defun gnus-bookmark-get-annotation (bookmark)
420   "Return the annotation of Gnus BOOKMARK, or nil if none."
421   (cdr (assq 'annotation (gnus-bookmark-get-bookmark-record bookmark))))
422
423 (defun gnus-bookmark-get-bookmark (bookmark)
424   "Return the full entry for Gnus BOOKMARK in `gnus-bookmark-alist'.
425 If BOOKMARK is not a string, return nil."
426   (when (stringp bookmark)
427     (assoc bookmark gnus-bookmark-alist)))
428
429 (defun gnus-bookmark-get-bookmark-record (bookmark)
430   "Return the guts of the entry for Gnus BOOKMARK in `gnus-bookmark-alist'.
431 That is, all information but the name."
432   (car (cdr (gnus-bookmark-get-bookmark bookmark))))
433
434 (defun gnus-bookmark-name-from-full-record (full-record)
435   "Return name of FULL-RECORD \(an alist element instead of a string\)."
436   (car full-record))
437
438 (defvar gnus-bookmark-bmenu-bookmark-column nil)
439 (defvar gnus-bookmark-bmenu-hidden-bookmarks ())
440 (defvar gnus-bookmark-bmenu-mode-map nil)
441
442 (if gnus-bookmark-bmenu-mode-map
443     nil
444   (setq gnus-bookmark-bmenu-mode-map (make-keymap))
445   (suppress-keymap gnus-bookmark-bmenu-mode-map t)
446   (define-key gnus-bookmark-bmenu-mode-map "q" (if (fboundp 'quit-window)
447                                                    'quit-window
448                                                  'bury-buffer))
449   (define-key gnus-bookmark-bmenu-mode-map "\C-m" 'gnus-bookmark-bmenu-select)
450   (define-key gnus-bookmark-bmenu-mode-map "v" 'gnus-bookmark-bmenu-select)
451   (define-key gnus-bookmark-bmenu-mode-map "d" 'gnus-bookmark-bmenu-delete)
452   (define-key gnus-bookmark-bmenu-mode-map "k" 'gnus-bookmark-bmenu-delete)
453   (define-key gnus-bookmark-bmenu-mode-map "\C-d" 'gnus-bookmark-bmenu-delete-backwards)
454   (define-key gnus-bookmark-bmenu-mode-map "x" 'gnus-bookmark-bmenu-execute-deletions)
455   (define-key gnus-bookmark-bmenu-mode-map " " 'next-line)
456   (define-key gnus-bookmark-bmenu-mode-map "n" 'next-line)
457   (define-key gnus-bookmark-bmenu-mode-map "p" 'previous-line)
458   (define-key gnus-bookmark-bmenu-mode-map "\177" 'gnus-bookmark-bmenu-backup-unmark)
459   (define-key gnus-bookmark-bmenu-mode-map "?" 'describe-mode)
460   (define-key gnus-bookmark-bmenu-mode-map "u" 'gnus-bookmark-bmenu-unmark)
461   (define-key gnus-bookmark-bmenu-mode-map "m" 'gnus-bookmark-bmenu-mark)
462   (define-key gnus-bookmark-bmenu-mode-map "l" 'gnus-bookmark-bmenu-load)
463   (define-key gnus-bookmark-bmenu-mode-map "s" 'gnus-bookmark-bmenu-save)
464   (define-key gnus-bookmark-bmenu-mode-map "t" 'gnus-bookmark-bmenu-toggle-infos)
465   (define-key gnus-bookmark-bmenu-mode-map "a" 'gnus-bookmark-bmenu-show-details)
466   (define-key gnus-bookmark-bmenu-mode-map gnus-mouse-2
467     'gnus-bookmark-bmenu-select-by-mouse))
468
469 ;; Bookmark Buffer Menu mode is suitable only for specially formatted
470 ;; data.
471 (put 'gnus-bookmark-bmenu-mode 'mode-class 'special)
472
473 ;; Been to lazy to use gnus-bookmark-save...
474 (defalias 'gnus-bookmark-bmenu-save 'gnus-bookmark-write-file)
475
476 (defun gnus-bookmark-bmenu-mode ()
477   "Major mode for editing a list of Gnus bookmarks.
478 Each line describes one of the bookmarks in Gnus.
479 Letters do not insert themselves; instead, they are commands.
480 Gnus bookmarks names preceded by a \"*\" have annotations.
481 \\<gnus-bookmark-bmenu-mode-map>
482 \\[gnus-bookmark-bmenu-mark] -- mark bookmark to be displayed.
483 \\[gnus-bookmark-bmenu-select] -- select bookmark of line point is on.
484   Also show bookmarks marked using m in other windows.
485 \\[gnus-bookmark-bmenu-toggle-infos] -- toggle displaying of details (they may obscure long bookmark names).
486 \\[gnus-bookmark-bmenu-locate] -- display (in minibuffer) location of this bookmark.
487 \\[gnus-bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\).
488 \\[gnus-bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down.
489 \\[gnus-bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up.
490 \\[gnus-bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[gnus-bookmark-bmenu-delete]'.
491 \\[gnus-bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.)
492 \\[gnus-bookmark-bmenu-save] -- load in a file of bookmarks (prompts for file.)
493 \\[gnus-bookmark-bmenu-unmark] -- remove all kinds of marks from current line.
494   With prefix argument, also move up one line.
495 \\[gnus-bookmark-bmenu-backup-unmark] -- back up a line and remove marks.
496 \\[gnus-bookmark-bmenu-show-details] -- show the annotation, if it exists, for the current bookmark
497   in another buffer.
498 \\[gnus-bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer.
499 \\[gnus-bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark."
500   (kill-all-local-variables)
501   (use-local-map gnus-bookmark-bmenu-mode-map)
502   (setq truncate-lines t)
503   (setq buffer-read-only t)
504   (setq major-mode 'gnus-bookmark-bmenu-mode)
505   (setq mode-name "Bookmark Menu")
506   (gnus-run-mode-hooks 'gnus-bookmark-bmenu-mode-hook))
507
508 ;; avoid compilation warnings
509 (defvar gnus-bookmark-bmenu-toggle-infos nil)
510
511 (defun gnus-bookmark-bmenu-toggle-infos (&optional show)
512   "Toggle whether details are shown in the Gnus bookmark list.
513 Optional argument SHOW means show them unconditionally."
514   (interactive)
515   (cond
516    (show
517     (setq gnus-bookmark-bmenu-toggle-infos nil)
518     (gnus-bookmark-bmenu-show-infos)
519     (setq gnus-bookmark-bmenu-toggle-infos t))
520    (gnus-bookmark-bmenu-toggle-infos
521     (gnus-bookmark-bmenu-hide-infos)
522     (setq gnus-bookmark-bmenu-toggle-infos nil))
523    (t
524     (gnus-bookmark-bmenu-show-infos)
525     (setq gnus-bookmark-bmenu-toggle-infos t))))
526
527 (defun gnus-bookmark-bmenu-show-infos (&optional force)
528   "Show infos in bmenu, maybe FORCE display of infos."
529   (if (and (not force) gnus-bookmark-bmenu-toggle-infos)
530       nil ;already shown, so do nothing
531     (save-excursion
532       (save-window-excursion
533         (goto-char (point-min))
534         (forward-line 2)
535         (setq gnus-bookmark-bmenu-hidden-bookmarks ())
536         (let ((inhibit-read-only t))
537           (while (< (point) (point-max))
538             (let ((bmrk (gnus-bookmark-bmenu-bookmark)))
539               (setq gnus-bookmark-bmenu-hidden-bookmarks
540                     (cons bmrk gnus-bookmark-bmenu-hidden-bookmarks))
541               (let ((start (point-at-eol)))
542                 (move-to-column gnus-bookmark-bmenu-file-column t)
543                 ;; Strip off `mouse-face' from the white spaces region.
544                 (if (gnus-bookmark-mouse-available-p)
545                     (remove-text-properties start (point)
546                                             '(mouse-face nil help-echo nil))))
547               (delete-region (point) (progn (end-of-line) (point)))
548               (insert "  ")
549               ;; Pass the NO-HISTORY arg:
550               (gnus-bookmark-insert-details bmrk)
551               (forward-line 1))))))))
552
553 (defun gnus-bookmark-insert-details (bmk-name)
554   "Insert the details of the article associated with BMK-NAME."
555   (let ((start (point)))
556     (prog1
557         (insert (gnus-bookmark-get-details
558                  bmk-name
559                  gnus-bookmark-bookmark-inline-details))
560       (if (gnus-bookmark-mouse-available-p)
561           (add-text-properties
562            start
563            (save-excursion (re-search-backward
564                             "[^ \t]")
565                                                (1+ (point)))
566            `(mouse-face highlight
567              follow-link t
568              help-echo ,(format "%s: go to this article"
569                                 (aref gnus-mouse-2 0))))))))
570
571 (defun gnus-bookmark-kill-line (&optional newline-too)
572   "Kill from point to end of line.
573 If optional arg NEWLINE-TOO is non-nil, delete the newline too.
574 Does not affect the kill ring."
575   (delete-region (point) (point-at-eol))
576   (if (and newline-too (looking-at "\n"))
577       (delete-char 1)))
578
579 (defun gnus-bookmark-get-details (bmk-name details-list)
580   "Get details for a Gnus BMK-NAME depending on DETAILS-LIST."
581   (let ((details (cadr (assoc bmk-name gnus-bookmark-alist))))
582     (mapconcat
583      (lambda (info)
584        (cdr (assoc info details)))
585      details-list " | ")))
586
587 (defun gnus-bookmark-bmenu-hide-infos (&optional force)
588   "Hide infos in bmenu, maybe FORCE."
589   (if (and (not force) gnus-bookmark-bmenu-toggle-infos)
590       ;; nothing to hide if above is nil
591       (save-excursion
592         (save-window-excursion
593           (goto-char (point-min))
594           (forward-line 2)
595           (setq gnus-bookmark-bmenu-hidden-bookmarks
596                 (nreverse gnus-bookmark-bmenu-hidden-bookmarks))
597           (save-excursion
598             (goto-char (point-min))
599             (search-forward "Gnus Bookmark")
600             (backward-word 2)
601             (setq gnus-bookmark-bmenu-bookmark-column (current-column)))
602           (save-excursion
603             (let ((inhibit-read-only t))
604               (while gnus-bookmark-bmenu-hidden-bookmarks
605                 (move-to-column gnus-bookmark-bmenu-bookmark-column t)
606                 (gnus-bookmark-kill-line)
607                 (let ((start (point)))
608                   (insert (car gnus-bookmark-bmenu-hidden-bookmarks))
609                   (if (gnus-bookmark-mouse-available-p)
610                       (add-text-properties
611                        start
612                        (save-excursion (re-search-backward
613                                         "[^ \t]")
614                                        (1+ (point)))
615                        `(mouse-face highlight
616                          follow-link t
617                          help-echo
618                          ,(format "%s: go to this bookmark in other window"
619                                   (aref gnus-mouse-2 0))))))
620                 (setq gnus-bookmark-bmenu-hidden-bookmarks
621                       (cdr gnus-bookmark-bmenu-hidden-bookmarks))
622                 (forward-line 1))))))))
623
624 (defun gnus-bookmark-bmenu-check-position ()
625   "Return non-nil if on a line with a bookmark.
626 The actual value returned is gnus-bookmark-alist.  Else
627 reposition and try again, else return nil."
628   (cond ((< (count-lines (point-min) (point)) 2)
629          (goto-char (point-min))
630          (forward-line 2)
631          gnus-bookmark-alist)
632         ((and (bolp) (eobp))
633          (beginning-of-line 0)
634          gnus-bookmark-alist)
635         (t
636          gnus-bookmark-alist)))
637
638 (defun gnus-bookmark-bmenu-bookmark ()
639   "Return a string which is bookmark of this line."
640   (if (gnus-bookmark-bmenu-check-position)
641       (save-excursion
642         (save-window-excursion
643           (goto-char (point-min))
644           (search-forward "Gnus Bookmark")
645           (backward-word 2)
646           (setq gnus-bookmark-bmenu-bookmark-column (current-column)))))
647   (if gnus-bookmark-bmenu-toggle-infos
648       (gnus-bookmark-bmenu-hide-infos))
649   (save-excursion
650     (save-window-excursion
651       (beginning-of-line)
652       (forward-char gnus-bookmark-bmenu-bookmark-column)
653       (prog1
654           (buffer-substring-no-properties (point)
655                             (progn
656                               (end-of-line)
657                               (point)))
658         ;; well, this is certainly crystal-clear:
659         (if gnus-bookmark-bmenu-toggle-infos
660             (gnus-bookmark-bmenu-toggle-infos t))))))
661
662 (defun gnus-bookmark-show-details (bookmark)
663   "Display the annotation for BOOKMARK in a buffer."
664   (let ((record (gnus-bookmark-get-bookmark-record bookmark))
665         (old-buf (current-buffer))
666         (details gnus-bookmark-bookmark-details)
667         detail)
668     (save-excursion
669       (pop-to-buffer (get-buffer-create "*Gnus Bookmark Annotation*") t)
670       (erase-buffer)
671       (while details
672         (setq detail (pop details))
673         (unless (equal (cdr (assoc detail record)) "")
674           (insert (symbol-name detail) ": " (cdr (assoc detail record)) "\n")))
675       (goto-char (point-min))
676       (pop-to-buffer old-buf))))
677
678 (defun gnus-bookmark-bmenu-show-details ()
679   "Show the annotation for the current bookmark in another window."
680   (interactive)
681   (let ((bookmark (gnus-bookmark-bmenu-bookmark)))
682     (if (gnus-bookmark-bmenu-check-position)
683         (gnus-bookmark-show-details bookmark))))
684
685 (defun gnus-bookmark-bmenu-mark ()
686   "Mark bookmark on this line to be displayed by \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-select]."
687   (interactive)
688   (beginning-of-line)
689   (if (gnus-bookmark-bmenu-check-position)
690       (let ((inhibit-read-only t))
691         (delete-char 1)
692         (insert ?>)
693         (forward-line 1)
694         (gnus-bookmark-bmenu-check-position))))
695
696 (defun gnus-bookmark-bmenu-unmark (&optional backup)
697   "Cancel all requested operations on bookmark on this line and move down.
698 Optional BACKUP means move up."
699   (interactive "P")
700   (beginning-of-line)
701   (if (gnus-bookmark-bmenu-check-position)
702       (progn
703         (let ((inhibit-read-only t))
704           (delete-char 1)
705           ;; any flags to reset according to circumstances?  How about a
706           ;; flag indicating whether this bookmark is being visited?
707           ;; well, we don't have this now, so maybe later.
708           (insert " "))
709         (forward-line (if backup -1 1))
710         (gnus-bookmark-bmenu-check-position))))
711
712 (defun gnus-bookmark-bmenu-backup-unmark ()
713   "Move up and cancel all requested operations on bookmark on line above."
714   (interactive)
715   (forward-line -1)
716   (if (gnus-bookmark-bmenu-check-position)
717       (progn
718         (gnus-bookmark-bmenu-unmark)
719         (forward-line -1)
720         (gnus-bookmark-bmenu-check-position))))
721
722 (defun gnus-bookmark-bmenu-delete ()
723   "Mark Gnus bookmark on this line to be deleted.
724 To carry out the deletions that you've marked, use
725 \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-execute-deletions]."
726   (interactive)
727   (beginning-of-line)
728   (if (gnus-bookmark-bmenu-check-position)
729       (let ((inhibit-read-only t))
730         (delete-char 1)
731         (insert ?D)
732         (forward-line 1)
733         (gnus-bookmark-bmenu-check-position))))
734
735 (defun gnus-bookmark-bmenu-delete-backwards ()
736   "Mark bookmark on this line to be deleted, then move up one line.
737 To carry out the deletions that you've marked, use
738 \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-execute-deletions]."
739   (interactive)
740   (gnus-bookmark-bmenu-delete)
741   (forward-line -2)
742   (if (gnus-bookmark-bmenu-check-position)
743       (forward-line 1))
744   (gnus-bookmark-bmenu-check-position))
745
746 (defun gnus-bookmark-bmenu-select ()
747   "Select this line's bookmark; also display bookmarks marked with `>'.
748 You can mark bookmarks with the
749 \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-mark]
750 command."
751   (interactive)
752   (if (gnus-bookmark-bmenu-check-position)
753       (let ((bmrk (gnus-bookmark-bmenu-bookmark))
754             (menu (current-buffer)))
755         (goto-char (point-min))
756         (delete-other-windows)
757         (gnus-bookmark-jump bmrk)
758         (bury-buffer menu))))
759
760 (defun gnus-bookmark-bmenu-select-by-mouse (event)
761   (interactive "e")
762   (mouse-set-point event)
763   (gnus-bookmark-bmenu-select))
764
765 (defun gnus-bookmark-bmenu-load ()
766   "Load the Gnus bookmark file and rebuild the bookmark menu-buffer."
767   (interactive)
768   (if (gnus-bookmark-bmenu-check-position)
769       (save-excursion
770         (save-window-excursion
771           ;; This will call `gnus-bookmark-bmenu-list'
772           (call-interactively 'gnus-bookmark-load)))))
773
774 (defun gnus-bookmark-bmenu-execute-deletions ()
775   "Delete Gnus bookmarks marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
776   (interactive)
777   (message "Deleting Gnus bookmarks...")
778   (let ((hide-em gnus-bookmark-bmenu-toggle-infos)
779         (o-point  (point))
780         (o-str    (save-excursion
781                     (beginning-of-line)
782                     (if (looking-at "^D")
783                         nil
784                       (buffer-substring
785                        (point)
786                        (progn (end-of-line) (point))))))
787         (o-col     (current-column)))
788     (if hide-em (gnus-bookmark-bmenu-hide-infos))
789     (setq gnus-bookmark-bmenu-toggle-infos nil)
790     (goto-char (point-min))
791     (forward-line 1)
792     (while (re-search-forward "^D" (point-max) t)
793       (gnus-bookmark-delete (gnus-bookmark-bmenu-bookmark) t)) ; pass BATCH arg
794     (gnus-bookmark-bmenu-list)
795     (setq gnus-bookmark-bmenu-toggle-infos hide-em)
796     (if gnus-bookmark-bmenu-toggle-infos
797         (gnus-bookmark-bmenu-toggle-infos t))
798     (if o-str
799         (progn
800           (goto-char (point-min))
801           (search-forward o-str)
802           (beginning-of-line)
803           (forward-char o-col))
804       (goto-char o-point))
805     (beginning-of-line)
806     (gnus-bookmark-write-file)
807     (message "Deleting bookmarks...done")))
808
809 (defun gnus-bookmark-delete (bookmark &optional batch)
810   "Delete BOOKMARK from the bookmark list.
811 Removes only the first instance of a bookmark with that name.  If
812 there are one or more other bookmarks with the same name, they will
813 not be deleted.  Defaults to the \"current\" bookmark \(that is, the
814 one most recently used in this file, if any\).
815 Optional second arg BATCH means don't update the bookmark list buffer,
816 probably because we were called from there."
817   (gnus-bookmark-maybe-load-default-file)
818   (let ((will-go (gnus-bookmark-get-bookmark bookmark)))
819     (setq gnus-bookmark-alist (delq will-go gnus-bookmark-alist)))
820   ;; Don't rebuild the list
821   (if batch
822       nil
823     (gnus-bookmark-bmenu-surreptitiously-rebuild-list)))
824
825 (provide 'gnus-bookmark)
826
827 ;;; gnus-bookmark.el ends here