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 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; This file implements real bookmarks for Gnus, closely following the way
  26 ;; `bookmark.el' handles bookmarks.  Most of the code comes from
  27 ;; `bookmark.el'.
  28 ;;
  29 ;; Set a Gnus bookmark:
  30 ;; M-x `gnus-bookmark-set' from the summary buffer.
  31 ;;
  32 ;; Jump to a Gnus bookmark:
  33 ;; M-x `gnus-bookmark-jump'.
  34 ;;
  35 ;; Display a list of bookmarks
  36 ;; M-x `gnus-bookmark-bmenu-list'.
  37 ;;
  38
  39 ;;; Todo:
  40
  41 ;; - add tags to bookmarks
  42 ;; - don't write file each time a bookmark is created
  43 ;; - better annotation interactive buffer
  44 ;; - edit annotation in gnus-bookmark-bmenu
  45 ;; - sort gnus-bookmark-buffer by author/subject/date/group/message-id
  46 ;; - auto-bmk-name customizable format
  47 ;; - renaming bookmarks in gnus-bookmark-bmenu-list
  48 ;; - better (formatted string) display in bmenu-list
  49
  50 ;; - Integrate the `gnus-summary-*-bookmark' functionality
  51 ;; - Initialize defcustoms from corresponding `bookmark.el' variables?
  52
  53 ;;; Code:
  54
  55 (require 'gnus-sum)
  56
  57 ;; FIXME: should avoid using C-c (no?)
  58 ;; (define-key gnus-summary-mode-map "\C-crm" 'gnus-bookmark-set)
  59 ;; (define-key global-map "\C-crb" 'gnus-bookmark-jump)
  60 ;; (define-key global-map "\C-crj" 'gnus-bookmark-jump)
  61 ;; (define-key global-map "\C-crl" 'gnus-bookmark-bmenu-list)
  62
  63 ;; FIXME: Add keybindings, see
  64 ;; http://thread.gmane.org/gmane.emacs.gnus.general/63101/focus=63379
  65 ;; http://thread.gmane.org/v9fxx9fkm4.fsf@marauder.physik.uni-ulm.de
  66
  67 ;; FIXME: Check if `gnus-bookmark.el' should use
  68 ;; `bookmark-make-cell-function'.
  69 ;; Cf. http://article.gmane.org/gmane.emacs.gnus.general/66076
  70
  71 (defgroup gnus-bookmark nil
  72   "Setting, annotation and jumping to Gnus bookmarks."
  73   :group 'gnus)
  74
  75 (defcustom gnus-bookmark-default-file
  76   (cond
  77    ;; Backward compatibility with previous versions:
  78    ((file-exists-p "~/.gnus.bmk") "~/.gnus.bmk")
  79    (t (nnheader-concat gnus-directory "bookmarks.el")))
  80   "The default Gnus bookmarks file."
  81   :type 'string
  82   :group 'gnus-bookmark)
  83
  84 (defcustom gnus-bookmark-file-coding-system
  85   (if (mm-coding-system-p 'iso-2022-7bit)
  86       'iso-2022-7bit)
  87   "Coding system used for writing Gnus bookmark files."
  88   :type '(symbol :tag "Coding system")
  89   :group 'gnus-bookmark)
  90
  91 (defcustom gnus-bookmark-sort-flag t
  92   "Non-nil means Gnus bookmarks are sorted by bookmark names.
  93 Otherwise they will be displayed in LIFO order (that is,
  94 most recently set ones come first, oldest ones come last)."
  95   :type 'boolean
  96   :group 'gnus-bookmark)
  97
  98 (defcustom gnus-bookmark-bmenu-toggle-infos t
  99   "Non-nil means show details when listing Gnus bookmarks.
 100 List of details is defined in `gnus-bookmark-bookmark-inline-details'.
 101 This may result in truncated bookmark names.  To disable this, put the
 102 following in your `.emacs' file:
 103
 104 \(setq gnus-bookmark-bmenu-toggle-infos nil\)"
 105   :type 'boolean
 106   :group 'gnus-bookmark)
 107
 108 (defcustom gnus-bookmark-bmenu-file-column 30
 109   "Column at which to display details in a buffer listing Gnus bookmarks.
 110 You can toggle whether details are shown with \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-toggle-infos]."
 111   :type 'integer
 112   :group 'gnus-bookmark)
 113
 114 (defcustom gnus-bookmark-use-annotations nil
 115   "If non-nil, ask for an annotation when setting a bookmark."
 116   :type 'boolean
 117   :group 'gnus-bookmark)
 118
 119 (defcustom gnus-bookmark-bookmark-inline-details '(author)
 120   "Details to be shown with `gnus-bookmark-bmenu-toggle-infos'.
 121 The default value is \(subject\)."
 122   :type '(list :tag "Gnus bookmark details"
 123                (set :inline t
 124                     (const :tag "Author" author)
 125                     (const :tag "Subject" subject)
 126                     (const :tag "Date" date)
 127                     (const :tag "Group" group)
 128                     (const :tag "Message-id" message-id)))
 129   :group 'gnus-bookmark)
 130
 131 (defcustom gnus-bookmark-bookmark-details
 132   '(author subject date group annotation)
 133   "Details to be shown with `gnus-bookmark-bmenu-show-details'.
 134 The default value is \(author subject date group annotation\)."
 135   :type '(list :tag "Gnus bookmark details"
 136                (set :inline t
 137                     (const :tag "Author" author)
 138                     (const :tag "Subject" subject)
 139                     (const :tag "Date" date)
 140                     (const :tag "Group" group)
 141                     (const :tag "Message-id" message-id)
 142                     (const :tag "Annotation" annotation)))
 143   :group 'gnus-bookmark)
 144
 145 (defface gnus-bookmark-menu-heading
 146   '((t (:inherit font-lock-type-face)))
 147   "Face used to highlight the heading in Gnus bookmark menu buffers."
 148   :version "23.1" ;; No Gnus
 149   :group 'gnus-bookmark)
 150
 151 (defconst gnus-bookmark-end-of-version-stamp-marker
 152   "-*- End Of Bookmark File Format Version Stamp -*-\n"
 153   "This string marks the end of the version stamp in a Gnus bookmark file.")
 154
 155 (defconst gnus-bookmark-file-format-version 0
 156   "The current version of the format used by bookmark files.
 157 You should never need to change this.")
 158
 159 (defvar gnus-bookmark-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)
 183       '(device-on-window-system-p)
 184     '(display-mouse-p)))
 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)
 216                    (gnus-bookmark-make-record
 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
 222 (defun gnus-bookmark-make-record
 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)))
 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))))
 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