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

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