lisp/gnus/gnus-bookmark.el

   1 ;;; gnus-bookmark.el --- Bookmarks in Gnus
   2
   3 ;; Copyright (C) 2006, 2007, 2008, 2009, 2010
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author: Bastien Guerry <bzg AT altern DOT org>
   7 ;; Keywords: news
   8
   9 ;; This file is part of GNU Emacs.
  10
  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.
  15
  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.
  20
  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/>.
  23
  24 ;;; Commentary:
  25
  26 ;; This file implements real bookmarks for Gnus, closely following the way
  27 ;; `bookmark.el' handles bookmarks.  Most of the code comes from
  28 ;; `bookmark.el'.
  29 ;;
  30 ;; Set a Gnus bookmark:
  31 ;; M-x `gnus-bookmark-set' from the summary buffer.
  32 ;;
  33 ;; Jump to a Gnus bookmark:
  34 ;; M-x `gnus-bookmark-jump'.
  35 ;;
  36 ;; Display a list of bookmarks
  37 ;; M-x `gnus-bookmark-bmenu-list'.
  38 ;;
  39
  40 ;;; Todo:
  41
  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
  50
  51 ;; - Integrate the `gnus-summary-*-bookmark' functionality
  52 ;; - Initialize defcustoms from corresponding `bookmark.el' variables?
  53
  54 ;;; Code:
  55
  56 (require 'gnus-sum)
  57
  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)
  63
  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
  67
  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
  71
  72 (defgroup gnus-bookmark nil
  73   "Setting, annotation and jumping to Gnus bookmarks."
  74   :group 'gnus)
  75
  76 (defcustom gnus-bookmark-default-file
  77   (cond
  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."
  82   :type 'string
  83   :group 'gnus-bookmark)
  84
  85 (defcustom gnus-bookmark-file-coding-system
  86   (if (mm-coding-system-p 'iso-2022-7bit)
  87       'iso-2022-7bit)
  88   "Coding system used for writing Gnus bookmark files."
  89   :type '(symbol :tag "Coding system")
  90   :group 'gnus-bookmark)
  91
  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)."
  96   :type 'boolean
  97   :group 'gnus-bookmark)
  98
  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:
 104
 105 \(setq gnus-bookmark-bmenu-toggle-infos nil\)"
 106   :type 'boolean
 107   :group 'gnus-bookmark)
 108
 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]."
 112   :type 'integer
 113   :group 'gnus-bookmark)
 114
 115 (defcustom gnus-bookmark-use-annotations nil
 116   "If non-nil, ask for an annotation when setting a bookmark."
 117   :type 'boolean
 118   :group 'gnus-bookmark)
 119
 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"
 124                (set :inline t
 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)
 131
 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"
 137                (set :inline t
 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)
 145
 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)
 151
 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.")
 155
 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.")
 159
 160 (defvar gnus-bookmark-alist ()
 161   "Association list of Gnus bookmarks and their records.
 162 The format of the alist is
 163
 164      \(BMK1 BMK2 ...\)
 165
 166 where each BMK is of the form
 167
 168 \(NAME
 169   \(group . GROUP\)
 170   \(message-id . MESSAGE-ID\)
 171   \(author . AUTHOR\)
 172   \(date . DATE\)
 173   \(subject . SUBJECT\)
 174   \(annotation . ANNOTATION\)\)
 175
 176 So the cdr of each bookmark is an alist too.")
 177
 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)
 182     '(display-mouse-p)))
 183
 184 (defun gnus-bookmark-remove-properties (string)
 185   "Remove all text properties from STRING."
 186   (set-text-properties 0 (length string) nil string)
 187   string)
 188
 189 ;;;###autoload
 190 (defun gnus-bookmark-set ()
 191   "Set a bookmark for this article."
 192   (interactive)
 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
 206            (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
 212             (cons
 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))
 219
 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."
 223   (let ((the-record
 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)))))
 230     the-record))
 231
 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)))
 239          (default-name-1
 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)
 244                 nil nil nil nil
 245                 default-name-1)))
 246     (if (string-equal name "")
 247         default-name-1
 248       name)))
 249
 250 (defun gnus-bookmark-write-file ()
 251   "Write currently defined Gnus bookmarks into `gnus-bookmark-default-file'."
 252   (interactive)
 253   (save-excursion
 254     (save-window-excursion
 255       ;; Avoir warnings?
 256       ;; (message "Saving Gnus bookmarks to file %s..." gnus-bookmark-default-file)
 257       (set-buffer (get-buffer-create  " *Gnus bookmarks*"))
 258       (erase-buffer)
 259       (gnus-bookmark-insert-file-format-version-stamp)
 260       (pp gnus-bookmark-alist (current-buffer))
 261       (condition-case nil
 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))
 268       (message
 269        "Saving Gnus bookmarks to file %s...done"
 270        gnus-bookmark-default-file))))
 271
 272 (defun gnus-bookmark-insert-file-format-version-stamp ()
 273   "Insert text indicating current version of Gnus bookmark file format."
 274   (insert
 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)
 280                        "; -*- ")
 281              "")))
 282   (insert ";;; This format is meant to be slightly human-readable;\n"
 283           ";;; nevertheless, you probably don't want to edit it.\n"
 284           ";;; "
 285           gnus-bookmark-end-of-version-stamp-marker))
 286
 287 ;;;###autoload
 288 (defun gnus-bookmark-jump (&optional bmk-name)
 289   "Jump to a Gnus bookmark (BMK-NAME)."
 290   (interactive)
 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))))
 298     (when group
 299       (unless (get-buffer gnus-group-buffer)
 300         (gnus-no-server))
 301       (gnus-activate-group group)
 302       (gnus-group-quick-select-group 0 group))
 303     (if message-id
 304       (or (gnus-summary-goto-article message-id nil 'force)
 305           (if (fboundp 'gnus-summary-insert-cached-articles)
 306               (progn
 307                 (gnus-summary-insert-cached-articles)
 308                 (gnus-summary-goto-article message-id nil 'force))
 309             (message "Message could not be found."))))))
 310
 311 (defvar gnus-bookmark-already-loaded nil)
 312
 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
 317 affect point."
 318   (save-excursion
 319     (goto-char (point-min))
 320     (if (search-forward
 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"))))
 325
 326 (defun gnus-bookmark-load (file)
 327   "Load Gnus bookmarks from FILE (which must be in bookmark format)."
 328   (interactive
 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)
 335       (save-excursion
 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)))
 341             (if (listp blist)
 342                 (progn (setq gnus-bookmark-already-loaded t)
 343                        (setq gnus-bookmark-alist blist))
 344               (error "Not Gnus bookmark format")))))))
 345
 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)))
 352
 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
 356 copy of the alist."
 357   (when gnus-bookmark-sort-flag
 358     (setq gnus-bookmark-alist
 359           (sort (copy-alist gnus-bookmark-alist)
 360                 (function
 361                  (lambda (x y) (string-lessp (car x) (car y))))))))
 362
 363 ;;;###autoload
 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."
 369   (interactive)
 370   (gnus-bookmark-maybe-load-default-file)
 371   (if (interactive-p)
 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)
 376     (erase-buffer)
 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)
 384     (while 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 ""))
 389                   "  "
 390                 " *"))
 391       (if (gnus-bookmark-mouse-available-p)
 392           (add-text-properties
 393            (prog1
 394                (point)
 395              (insert name))
 396            (let ((end (point)))
 397              (prog2
 398                  (re-search-backward "[^ \t]")
 399                  (1+ (point))
 400                (goto-char end)
 401                (insert "\n")))
 402            `(mouse-face highlight follow-link t
 403                         help-echo ,(format "%s: go to this article"
 404                                            (aref gnus-mouse-2 0))))
 405         (insert name "\n")))
 406     (goto-char (point-min))
 407     (forward-line 2)
 408     (gnus-bookmark-bmenu-mode)
 409     (if gnus-bookmark-bmenu-toggle-infos
 410         (gnus-bookmark-bmenu-toggle-infos t))))
 411
 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*")
 416       (save-excursion
 417         (save-window-excursion
 418           (gnus-bookmark-bmenu-list)))))
 419
 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))))
 423
 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)))
 429
 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))))
 434
 435 (defun gnus-bookmark-name-from-full-record (full-record)
 436   "Return name of FULL-RECORD \(an alist element instead of a string\)."
 437   (car full-record))
 438
 439 (defvar gnus-bookmark-bmenu-bookmark-column nil)
 440 (defvar gnus-bookmark-bmenu-hidden-bookmarks ())
 441 (defvar gnus-bookmark-bmenu-mode-map nil)
 442
 443 (if gnus-bookmark-bmenu-mode-map
 444     nil
 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)
 448                                                    'quit-window
 449                                                  'bury-buffer))
 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))
 469
 470 ;; Bookmark Buffer Menu mode is suitable only for specially formatted
 471 ;; data.
 472 (put 'gnus-bookmark-bmenu-mode 'mode-class 'special)
 473
 474 ;; Been to lazy to use gnus-bookmark-save...
 475 (defalias 'gnus-bookmark-bmenu-save 'gnus-bookmark-write-file)
 476
 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
 498   in another buffer.
 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))
 508
 509 ;; avoid compilation warnings
 510 (defvar gnus-bookmark-bmenu-toggle-infos nil)
 511
 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."
 515   (interactive)
 516   (cond
 517    (show
 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))
 524    (t
 525     (gnus-bookmark-bmenu-show-infos)
 526     (setq gnus-bookmark-bmenu-toggle-infos t))))
 527
 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
 532     (save-excursion
 533       (save-window-excursion
 534         (goto-char (point-min))
 535         (forward-line 2)
 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)))
 549               (insert "  ")
 550               ;; Pass the NO-HISTORY arg:
 551               (gnus-bookmark-insert-details bmrk)
 552               (forward-line 1))))))))
 553
 554 (defun gnus-bookmark-insert-details (bmk-name)
 555   "Insert the details of the article associated with BMK-NAME."
 556   (let ((start (point)))
 557     (prog1
 558         (insert (gnus-bookmark-get-details
 559                  bmk-name
 560                  gnus-bookmark-bookmark-inline-details))
 561       (if (gnus-bookmark-mouse-available-p)
 562           (add-text-properties
 563            start
 564            (save-excursion (re-search-backward
 565                             "[^ \t]")
 566                                                (1+ (point)))
 567            `(mouse-face highlight
 568              follow-link t
 569              help-echo ,(format "%s: go to this article"
 570                                 (aref gnus-mouse-2 0))))))))
 571
 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"))
 578       (delete-char 1)))
 579
 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))))
 583     (mapconcat
 584      (lambda (info)
 585        (cdr (assoc info details)))
 586      details-list " | ")))
 587
 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
 592       (save-excursion
 593         (save-window-excursion
 594           (goto-char (point-min))
 595           (forward-line 2)
 596           (setq gnus-bookmark-bmenu-hidden-bookmarks
 597                 (nreverse gnus-bookmark-bmenu-hidden-bookmarks))
 598           (save-excursion
 599             (goto-char (point-min))
 600             (search-forward "Gnus Bookmark")
 601             (backward-word 2)
 602             (setq gnus-bookmark-bmenu-bookmark-column (current-column)))
 603           (save-excursion
 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)
 611                       (add-text-properties
 612                        start
 613                        (save-excursion (re-search-backward
 614                                         "[^ \t]")
 615                                        (1+ (point)))
 616                        `(mouse-face highlight
 617                          follow-link t
 618                          help-echo
 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))))))))
 624
 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))
 631          (forward-line 2)
 632          gnus-bookmark-alist)
 633         ((and (bolp) (eobp))
 634          (beginning-of-line 0)
 635          gnus-bookmark-alist)
 636         (t
 637          gnus-bookmark-alist)))
 638
 639 (defun gnus-bookmark-bmenu-bookmark ()
 640   "Return a string which is bookmark of this line."
 641   (if (gnus-bookmark-bmenu-check-position)
 642       (save-excursion
 643         (save-window-excursion
 644           (goto-char (point-min))
 645           (search-forward "Gnus Bookmark")
 646           (backward-word 2)
 647           (setq gnus-bookmark-bmenu-bookmark-column (current-column)))))
 648   (if gnus-bookmark-bmenu-toggle-infos
 649       (gnus-bookmark-bmenu-hide-infos))
 650   (save-excursion
 651     (save-window-excursion
 652       (beginning-of-line)
 653       (forward-char gnus-bookmark-bmenu-bookmark-column)
 654       (prog1
 655           (buffer-substring-no-properties (point)
 656                             (progn
 657                               (end-of-line)
 658                               (point)))
 659         ;; well, this is certainly crystal-clear:
 660         (if gnus-bookmark-bmenu-toggle-infos
 661             (gnus-bookmark-bmenu-toggle-infos t))))))
 662
 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)
 668         detail)
 669     (save-excursion
 670       (pop-to-buffer (get-buffer-create "*Gnus Bookmark Annotation*") t)
 671       (erase-buffer)
 672       (while details
 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))))
 678
 679 (defun gnus-bookmark-bmenu-show-details ()
 680   "Show the annotation for the current bookmark in another window."
 681   (interactive)
 682   (let ((bookmark (gnus-bookmark-bmenu-bookmark)))
 683     (if (gnus-bookmark-bmenu-check-position)
 684         (gnus-bookmark-show-details bookmark))))
 685
 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]."
 688   (interactive)
 689   (beginning-of-line)
 690   (if (gnus-bookmark-bmenu-check-position)
 691       (let ((inhibit-read-only t))
 692         (delete-char 1)
 693         (insert ?>)
 694         (forward-line 1)
 695         (gnus-bookmark-bmenu-check-position))))
 696
 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."
 700   (interactive "P")
 701   (beginning-of-line)
 702   (if (gnus-bookmark-bmenu-check-position)
 703       (progn
 704         (let ((inhibit-read-only t))
 705           (delete-char 1)
 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.
 709           (insert " "))
 710         (forward-line (if backup -1 1))
 711         (gnus-bookmark-bmenu-check-position))))
 712
 713 (defun gnus-bookmark-bmenu-backup-unmark ()
 714   "Move up and cancel all requested operations on bookmark on line above."
 715   (interactive)
 716   (forward-line -1)
 717   (if (gnus-bookmark-bmenu-check-position)
 718       (progn
 719         (gnus-bookmark-bmenu-unmark)
 720         (forward-line -1)
 721         (gnus-bookmark-bmenu-check-position))))
 722
 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]."
 727   (interactive)
 728   (beginning-of-line)
 729   (if (gnus-bookmark-bmenu-check-position)
 730       (let ((inhibit-read-only t))
 731         (delete-char 1)
 732         (insert ?D)
 733         (forward-line 1)
 734         (gnus-bookmark-bmenu-check-position))))
 735
 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]."
 740   (interactive)
 741   (gnus-bookmark-bmenu-delete)
 742   (forward-line -2)
 743   (if (gnus-bookmark-bmenu-check-position)
 744       (forward-line 1))
 745   (gnus-bookmark-bmenu-check-position))
 746
 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]
 751 command."
 752   (interactive)
 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))))
 760
 761 (defun gnus-bookmark-bmenu-select-by-mouse (event)
 762   (interactive "e")
 763   (mouse-set-point event)
 764   (gnus-bookmark-bmenu-select))
 765
 766 (defun gnus-bookmark-bmenu-load ()
 767   "Load the Gnus bookmark file and rebuild the bookmark menu-buffer."
 768   (interactive)
 769   (if (gnus-bookmark-bmenu-check-position)
 770       (save-excursion
 771         (save-window-excursion
 772           ;; This will call `gnus-bookmark-bmenu-list'
 773           (call-interactively 'gnus-bookmark-load)))))
 774
 775 (defun gnus-bookmark-bmenu-execute-deletions ()
 776   "Delete Gnus bookmarks marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
 777   (interactive)
 778   (message "Deleting Gnus bookmarks...")
 779   (let ((hide-em gnus-bookmark-bmenu-toggle-infos)
 780         (o-point  (point))
 781         (o-str    (save-excursion
 782                     (beginning-of-line)
 783                     (if (looking-at "^D")
 784                         nil
 785                       (buffer-substring
 786                        (point)
 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))
 792     (forward-line 1)
 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))
 799     (if o-str
 800         (progn
 801           (goto-char (point-min))
 802           (search-forward o-str)
 803           (beginning-of-line)
 804           (forward-char o-col))
 805       (goto-char o-point))
 806     (beginning-of-line)
 807     (gnus-bookmark-write-file)
 808     (message "Deleting bookmarks...done")))
 809
 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
 822   (if batch
 823       nil
 824     (gnus-bookmark-bmenu-surreptitiously-rebuild-list)))
 825
 826 (provide 'gnus-bookmark)
 827
 828 ;;; gnus-bookmark.el ends here