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