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