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