cgit.sxemacs.org Git - gnus/blob - lisp/gnus-bookmark.el

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