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

   1 ;;; gnus-bookmark.el --- Set real bookmarks in Gnus
   2
   3 ;; Copyright 2006 Bastien Guerry
   4 ;;
   5 ;; Author: bzg AT altern DOT org
   6 ;; Version: $Id: gnus-bookmark.el,v 0.5 2006/06/19 10:52:08 guerry Exp guerry $
   7 ;; Keywords: Gnus bookmark
   8 ;; Time-stamp: <2006-06-19 11:54:04 guerry>
   9 ;; X-URL: <http://www.cognition.ens.fr/~guerry/u/gnus-bookmark.el>
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15 ;;
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program; if not, write to the Free Software
  23 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; This file implements real bookmarks for Gnus, closely following the
  28 ;; way 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 ;; Put this file into your load-path and the following into your
  53 ;;   ~/.emacs: (require 'gnus-bookmark)
  54
  55
  56 ;;; History:
  57 ;;
  58 ;; Started in 04/2006.
  59
  60 ;;; Code:
  61
  62 (provide 'gnus-bookmark)
  63 (eval-when-compile
  64   (require 'cl))
  65
  66 ;; FIXME: should avoid using C-c (no?)
  67 ;; (define-key gnus-summary-mode-map "\C-crm" 'gnus-bookmark-set)
  68 ;; (define-key global-map "\C-crb" 'gnus-bookmark-jump)
  69 ;; (define-key global-map "\C-crj" 'gnus-bookmark-jump)
  70 ;; (define-key global-map "\C-crl" 'gnus-bookmark-bmenu-list)
  71
  72 (defgroup gnus-bookmark nil
  73   "Setting, annotation and jumping to Gnus bookmarks."
  74   :group 'gnus)
  75
  76
  77 (defcustom gnus-bookmark-default-file
  78   (concat (getenv "HOME") "/.gnus.bmk")
  79   "The default Gnus bookmarks file."
  80   :type 'string
  81   :group 'gnus-bookmark)
  82
  83
  84 (defcustom gnus-bookmark-sort-flag t
  85   "Non-nil means Gnus bookmarks are sorted by bookmark names.
  86 Otherwise they will be displayed in LIFO order (that is,
  87 most recently set ones come first, oldest ones come last)."
  88   :type 'boolean
  89   :group 'gnus-bookmark)
  90
  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
 103 (defcustom gnus-bookmark-bmenu-file-column 30
 104   "*Column at which to display details in a buffer listing Gnus bookmarks.
 105 You can toggle whether details are shown with \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-toggle-infos]."
 106   :type 'integer
 107   :group 'gnus-bookmark)
 108
 109
 110 (defcustom gnus-bookmark-use-annotations nil
 111   "*If non-nil, ask for an annotation when setting a bookmark."
 112   :type 'boolean
 113   :group 'gnus-bookmark)
 114
 115
 116 (defcustom gnus-bookmark-bookmark-inline-details '(author)
 117   "Details to be shown with `gnus-bookmark-bmenu-toggle-infos'.
 118 The default value is \(subject\)."
 119   :type '(list :tag "Gnus bookmark details"
 120                (set :inline t
 121                     (const :tag "Author" author)
 122                     (const :tag "Subject" subject)
 123                     (const :tag "Date" date)
 124                     (const :tag "Group" group)
 125                     (const :tag "Message-id" message-id)))
 126   :group 'gnus-bookmark)
 127
 128
 129 (defcustom gnus-bookmark-bookmark-details
 130   '(author subject date group annotation)
 131   "Details to be shown with `gnus-bookmark-bmenu-show-details'.
 132 The default value is \(author subject date group annotation\)."
 133   :type '(list :tag "Gnus bookmark details"
 134                (set :inline t
 135                     (const :tag "Author" author)
 136                     (const :tag "Subject" subject)
 137                     (const :tag "Date" date)
 138                     (const :tag "Group" group)
 139                     (const :tag "Message-id" message-id)
 140                     (const :tag "Annotation" annotation)))
 141   :group 'gnus-bookmark)
 142
 143
 144 (defface gnus-bookmark-menu-heading
 145   '((t (:inherit font-lock-type-face)))
 146   "Face used to highlight the heading in Gnus bookmark menu buffers."
 147   :group 'gnus-bookmark
 148   :version "22.1")
 149
 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
 156 (defconst gnus-bookmark-file-format-version 0
 157   "The current version of the format used by bookmark files.
 158 You should never need to change this.")
 159
 160
 161 (defvar gnus-bookmark-after-jump-hook nil
 162   "Hook run after `gnus-bookmark-jump' jumps to a Gnus bookmark.")
 163
 164
 165 (defvar gnus-bookmark-alist ()
 166   "Association list of Gnus bookmarks and their records.
 167 The format of the alist is
 168
 169      \(BMK1 BMK2 ...\)
 170
 171 where each BMK is of the form
 172
 173 \(NAME
 174   \(group . GROUP\)
 175   \(message-id . MESSAGE-ID\)
 176   \(author . AUTHOR\)
 177   \(date . DATE\)
 178   \(subject . SUBJECT\)
 179   \(annotation . ANNOTATION\)\)
 180
 181 So the cdr of each bookmark is an alist too.")
 182
 183 ;;;###autoload
 184 (defun gnus-bookmark-set ()
 185   "Set a bookmark for this article."
 186   (interactive)
 187   (gnus-bookmark-maybe-load-default-file)
 188   (if (or (not (eq major-mode 'gnus-summary-mode))
 189           (not gnus-article-current))
 190       (error "Please select an article in the Gnus summary buffer")
 191     (let* ((group (car gnus-article-current))
 192            (article (cdr gnus-article-current))
 193            (header (gnus-summary-article-header article))
 194            (author (mail-header-from header))
 195            (message-id (mail-header-id header))
 196            (date (mail-header-date header))
 197            (subject (gnus-summary-subject-string))
 198            (bmk-name (gnus-bookmark-set-bookmark-name group author subject))
 199            ;; Maybe ask for annotation
 200            (annotation
 201             (if gnus-bookmark-use-annotations
 202                  (read-from-minibuffer
 203                   (format "Annotation for %s: " bmk-name)) "")))
 204       ;; Set the bookmark list
 205       (setq gnus-bookmark-alist
 206             (cons
 207              (list bmk-name
 208                    (gnus-bookmark-make-cell
 209                     group message-id author date subject annotation))
 210              gnus-bookmark-alist))))
 211   (gnus-bookmark-bmenu-surreptitiously-rebuild-list)
 212   (gnus-bookmark-write-file))
 213
 214
 215 (defun gnus-bookmark-make-cell
 216   (group message-id author date subject annotation)
 217   "Return the record part of a new bookmark, given GROUP MESSAGE-ID AUTHOR DATE SUBJECT and ANNOTATION."
 218   (let ((the-record
 219          `((group . ,group)
 220            (message-id . ,message-id)
 221            (author . ,author)
 222            (date . ,date)
 223            (subject . ,subject)
 224            (annotation . ,annotation))))
 225     the-record))
 226
 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
 232            (concat (car (reverse (split-string group "[\\.:]" t))) "-"
 233                    (car (split-string author)) "-"
 234                    (concat (car subject) "-"
 235                            (cadr subject))))
 236          (default-name-1
 237            ;; Strip "[]" chars from the bookmark name:
 238            (replace-regexp-in-string "[]_[]" "" default-name-0))
 239          (name (read-from-minibuffer
 240                 (format "Set bookmark (%s): " default-name-1)
 241                 nil nil nil nil
 242                 default-name-1)))
 243     (if (string-equal name "")
 244         default-name-1
 245       name)))
 246
 247
 248 (defun gnus-bookmark-write-file ()
 249   "Write currently defined Gnus bookmarks into `gnus-bookmark-default-file'."
 250   (interactive)
 251   (save-excursion
 252     (save-window-excursion
 253       ;; Avoir warnings?
 254       ;; (message "Saving Gnus bookmarks to file %s..." gnus-bookmark-default-file)
 255       (set-buffer (get-buffer-create  " *Gnus bookmarks*"))
 256       (goto-char (point-min))
 257       (delete-region (point-min) (point-max))
 258       (gnus-bookmark-insert-file-format-version-stamp)
 259       (pp gnus-bookmark-alist (current-buffer))
 260       (condition-case nil
 261           (write-region (point-min) (point-max)
 262                         gnus-bookmark-default-file)
 263         (file-error (message "Can't write %s"
 264                              gnus-bookmark-default-file)))
 265       (kill-buffer (current-buffer))
 266       (message
 267        "Saving Gnus bookmarks to file %s...done"
 268        gnus-bookmark-default-file))))
 269
 270
 271 (defun gnus-bookmark-insert-file-format-version-stamp ()
 272   "Insert text indicating current version of Gnus bookmark file format."
 273   (insert
 274    (format ";;;; Gnus Bookmark Format Version %d ;;;;\n"
 275            gnus-bookmark-file-format-version))
 276   (insert ";;; This format is meant to be slightly human-readable;\n"
 277           ";;; nevertheless, you probably don't want to edit it.\n"
 278           ";;; "
 279           gnus-bookmark-end-of-version-stamp-marker))
 280
 281
 282 ;;;###autoload
 283 (defun gnus-bookmark-jump (&optional bmk-name)
 284   "Jump to a Gnus bookmark (BMK-NAME)."
 285   (interactive)
 286   (gnus-bookmark-maybe-load-default-file)
 287   (let* ((bookmark (or bmk-name
 288           (completing-read "Jump to bookmarked article: "
 289                            (mapcar 'car gnus-bookmark-alist))))
 290          (bmk-cell (cadr (assoc bookmark gnus-bookmark-alist)))
 291          (group (cdr (assoc 'group bmk-cell)))
 292          (message-id (cdr (assoc 'message-id bmk-cell))))
 293     (require 'gnus)
 294     (if group (gnus-fetch-group group))
 295     (if message-id
 296       (or (gnus-summary-goto-article message-id nil 'force)
 297           (if (fboundp 'gnus-summary-insert-cached-articles)
 298               (progn
 299                 (gnus-summary-insert-cached-articles)
 300                 (gnus-summary-goto-article message-id nil 'force))
 301             (message "Message could not be found."))))))
 302
 303
 304 (defvar gnus-bookmark-already-loaded nil)
 305
 306
 307 (defun gnus-bookmark-alist-from-buffer ()
 308   "Return a `gnus-bookmark-alist' from the current buffer.
 309 The buffer must of course contain Gnus bookmark format information.
 310 Does not care from where in the buffer it is called, and does not
 311 affect point."
 312   (save-excursion
 313     (goto-char (point-min))
 314     (if (search-forward
 315          gnus-bookmark-end-of-version-stamp-marker nil t)
 316         (read (current-buffer))
 317       ;; Else no hope of getting information here.
 318       (error "Not Gnus bookmark format"))))
 319
 320
 321 (defun gnus-bookmark-load (file)
 322   "Load Gnus bookmarks from FILE (which must be in bookmark format)."
 323   (interactive
 324    (list (read-file-name
 325           (format "Load Gnus bookmarks from: (%s) "
 326                   gnus-bookmark-default-file)
 327           "~/" gnus-bookmark-default-file 'confirm)))
 328   (setq file (expand-file-name file))
 329   (if (file-readable-p file)
 330       (save-excursion
 331         (save-window-excursion
 332           (set-buffer (let ((enable-local-variables nil))
 333                         (find-file-noselect file)))
 334           (goto-char (point-min))
 335           (let ((blist (gnus-bookmark-alist-from-buffer)))
 336             (if (listp blist)
 337                 (progn (setq gnus-bookmark-already-loaded t)
 338                        (setq gnus-bookmark-alist blist))
 339               (error "Not Gnus bookmark format")))))))
 340
 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
 350 (defun gnus-bookmark-maybe-sort-alist ()
 351   "Return the gnus-bookmark-alist for display.
 352 If the gnus-bookmark-sort-flag is non-nil, then return a sorted copy of the alist."
 353   (if 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
 360 ;;;###autoload
 361 (defun gnus-bookmark-bmenu-list ()
 362   "Display a list of existing Gnus bookmarks.
 363 The list is displayed in a buffer named `*Gnus Bookmark List*'.
 364 The leftmost column displays a D if the bookmark is flagged for
 365 deletion, or > if it is flagged for displaying."
 366   (interactive)
 367   (gnus-bookmark-maybe-load-default-file)
 368   (if (interactive-p)
 369       (switch-to-buffer (get-buffer-create "*Gnus Bookmark List*"))
 370     (set-buffer (get-buffer-create "*Gnus Bookmark List*")))
 371   (let ((inhibit-read-only t))
 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     (mapcar
 380      (lambda (full-record)
 381        ;; if a Gnus bookmark has an annotation, prepend a "*"
 382        ;; in the list of bookmarks.
 383        (let ((annotation (gnus-bookmark-get-annotation
 384                           (gnus-bookmark-name-from-full-record full-record))))
 385          (if (and annotation (not (string-equal annotation "")))
 386              (insert " *")
 387            (insert "  "))
 388          (let ((start (point)))
 389            (insert (gnus-bookmark-name-from-full-record full-record))
 390            (if (and (display-color-p) (display-mouse-p))
 391                (add-text-properties
 392                 start
 393                 (save-excursion (re-search-backward
 394                                  "[^ \t]")
 395                                 (1+ (point)))
 396                 '(mouse-face highlight
 397                   follow-link t
 398                   help-echo "mouse-2: go to this article")))
 399            (insert "\n")
 400            )))
 401      gnus-bookmark-alist)
 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
 409 (defun gnus-bookmark-bmenu-surreptitiously-rebuild-list ()
 410   "Rebuild the Bookmark List if it exists.
 411 Don't affect the buffer ring order."
 412   (if (get-buffer "*Gnus Bookmark List*")
 413       (save-excursion
 414         (save-window-excursion
 415           (gnus-bookmark-bmenu-list)))))
 416
 417
 418 (defun gnus-bookmark-get-annotation (bookmark)
 419   "Return the annotation of Gnus BOOKMARK, or nil if none."
 420   (cdr (assq 'annotation (gnus-bookmark-get-bookmark-record bookmark))))
 421
 422
 423 (defun gnus-bookmark-get-bookmark (bookmark)
 424   "Return the full entry for Gnus BOOKMARK in `guns-bmk-alist'.
 425 If BOOKMARK is not a string, return nil."
 426   (when (stringp bookmark)
 427     (assoc-string bookmark gnus-bookmark-alist t)))
 428
 429
 430 (defun gnus-bookmark-get-bookmark-record (bookmark)
 431   "Return the guts of the entry for Gnus BOOKMARK in `gnus-bookmark-alist'.
 432 That is, all information but the name."
 433   (car (cdr (gnus-bookmark-get-bookmark bookmark))))
 434
 435
 436 (defun gnus-bookmark-name-from-full-record (full-record)
 437   "Return name of FULL-RECORD \(an alist element instead of a string\)."
 438   (car full-record))
 439
 440 (defvar gnus-bookmark-bmenu-bookmark-column nil)
 441 (defvar gnus-bookmark-bmenu-hidden-bookmarks ())
 442 (defvar gnus-bookmark-bmenu-mode-map nil)
 443
 444 (if gnus-bookmark-bmenu-mode-map
 445     nil
 446   (setq gnus-bookmark-bmenu-mode-map (make-keymap))
 447   (suppress-keymap gnus-bookmark-bmenu-mode-map t)
 448   (define-key gnus-bookmark-bmenu-mode-map "q" 'quit-window)
 449   (define-key gnus-bookmark-bmenu-mode-map "\C-m" 'gnus-bookmark-bmenu-select)
 450   (define-key gnus-bookmark-bmenu-mode-map "v" 'gnus-bookmark-bmenu-select)
 451   (define-key gnus-bookmark-bmenu-mode-map "d" 'gnus-bookmark-bmenu-delete)
 452   (define-key gnus-bookmark-bmenu-mode-map "k" 'gnus-bookmark-bmenu-delete)
 453   (define-key gnus-bookmark-bmenu-mode-map "\C-d" 'gnus-bookmark-bmenu-delete-backwards)
 454   (define-key gnus-bookmark-bmenu-mode-map "x" 'gnus-bookmark-bmenu-execute-deletions)
 455   (define-key gnus-bookmark-bmenu-mode-map " " 'next-line)
 456   (define-key gnus-bookmark-bmenu-mode-map "n" 'next-line)
 457   (define-key gnus-bookmark-bmenu-mode-map "p" 'previous-line)
 458   (define-key gnus-bookmark-bmenu-mode-map "\177" 'gnus-bookmark-bmenu-backup-unmark)
 459   (define-key gnus-bookmark-bmenu-mode-map "?" 'describe-mode)
 460   (define-key gnus-bookmark-bmenu-mode-map "u" 'gnus-bookmark-bmenu-unmark)
 461   (define-key gnus-bookmark-bmenu-mode-map "m" 'gnus-bookmark-bmenu-mark)
 462   (define-key gnus-bookmark-bmenu-mode-map "l" 'gnus-bookmark-bmenu-load)
 463   (define-key gnus-bookmark-bmenu-mode-map "s" 'gnus-bookmark-bmenu-save)
 464   (define-key gnus-bookmark-bmenu-mode-map "t" 'gnus-bookmark-bmenu-toggle-infos)
 465   (define-key gnus-bookmark-bmenu-mode-map "a" 'gnus-bookmark-bmenu-show-details)
 466   (define-key gnus-bookmark-bmenu-mode-map [mouse-2] 'gnus-bookmark-bmenu-select))
 467
 468 ;; Bookmark Buffer Menu mode is suitable only for specially formatted
 469 ;; data.
 470 (put 'gnus-bookmark-bmenu-mode 'mode-class 'special)
 471
 472 ;; Been to lazy to use gnus-bookmark-save...
 473 (defalias 'gnus-bookmark-bmenu-save 'gnus-bookmark-write-file)
 474
 475 (defun gnus-bookmark-bmenu-mode ()
 476   "Major mode for editing a list of Gnus bookmarks.
 477 Each line describes one of the bookmarks in Gnus.
 478 Letters do not insert themselves; instead, they are commands.
 479 Gnus bookmarks names preceded by a \"*\" have annotations.
 480 \\<gnus-bookmark-bmenu-mode-map>
 481 \\[gnus-bookmark-bmenu-mark] -- mark bookmark to be displayed.
 482 \\[gnus-bookmark-bmenu-select] -- select bookmark of line point is on.
 483   Also show bookmarks marked using m in other windows.
 484 \\[gnus-bookmark-bmenu-toggle-infos] -- toggle displaying of details (they may obscure long bookmark names).
 485 \\[gnus-bookmark-bmenu-locate] -- display (in minibuffer) location of this bookmark.
 486 \\[gnus-bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\).
 487 \\[gnus-bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down.
 488 \\[gnus-bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up.
 489 \\[gnus-bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[gnus-bookmark-bmenu-delete]'.
 490 \\[gnus-bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.)
 491 \\[gnus-bookmark-bmenu-save] -- load in a file of bookmarks (prompts for file.)
 492 \\[gnus-bookmark-bmenu-unmark] -- remove all kinds of marks from current line.
 493   With prefix argument, also move up one line.
 494 \\[gnus-bookmark-bmenu-backup-unmark] -- back up a line and remove marks.
 495 \\[gnus-bookmark-bmenu-show-details] -- show the annotation, if it exists, for the current bookmark
 496   in another buffer.
 497 \\[gnus-bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer.
 498 \\[gnus-bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark."
 499   (kill-all-local-variables)
 500   (use-local-map gnus-bookmark-bmenu-mode-map)
 501   (setq truncate-lines t)
 502   (setq buffer-read-only t)
 503   (setq major-mode 'gnus-bookmark-bmenu-mode)
 504   (setq mode-name "Bookmark Menu")
 505   (run-mode-hooks 'gnus-bookmark-bmenu-mode-hook))
 506
 507 ;; avoid compilation warnings
 508 (defvar gnus-bookmark-bmenu-toggle-infos nil)
 509
 510 (defun gnus-bookmark-bmenu-toggle-infos (&optional show)
 511   "Toggle whether details are shown in the Gnus bookmark list.
 512 Optional argument SHOW means show them unconditionally."
 513   (interactive)
 514   (cond
 515    (show
 516     (setq gnus-bookmark-bmenu-toggle-infos nil)
 517     (gnus-bookmark-bmenu-show-infos)
 518     (setq gnus-bookmark-bmenu-toggle-infos t))
 519    (gnus-bookmark-bmenu-toggle-infos
 520     (gnus-bookmark-bmenu-hide-infos)
 521     (setq gnus-bookmark-bmenu-toggle-infos nil))
 522    (t
 523     (gnus-bookmark-bmenu-show-infos)
 524     (setq gnus-bookmark-bmenu-toggle-infos t))))
 525
 526
 527 (defun gnus-bookmark-bmenu-show-infos (&optional force)
 528   "Show infos in bmenu, maybe FORCE display of infos."
 529   (if (and (not force) gnus-bookmark-bmenu-toggle-infos)
 530       nil ;already shown, so do nothing
 531     (save-excursion
 532       (save-window-excursion
 533         (goto-char (point-min))
 534         (forward-line 2)
 535         (setq gnus-bookmark-bmenu-hidden-bookmarks ())
 536         (let ((inhibit-read-only t))
 537           (while (< (point) (point-max))
 538             (let ((bmrk (gnus-bookmark-bmenu-bookmark)))
 539               (setq gnus-bookmark-bmenu-hidden-bookmarks
 540                     (cons bmrk gnus-bookmark-bmenu-hidden-bookmarks))
 541               (let ((start (save-excursion (end-of-line) (point))))
 542                 (move-to-column gnus-bookmark-bmenu-file-column t)
 543                 ;; Strip off `mouse-face' from the white spaces region.
 544                 (if (and (display-color-p) (display-mouse-p))
 545                     (remove-text-properties start (point)
 546                                             '(mouse-face nil help-echo nil))))
 547               (delete-region (point) (progn (end-of-line) (point)))
 548               (insert "  ")
 549               ;; Pass the NO-HISTORY arg:
 550               (gnus-bookmark-insert-details bmrk)
 551               (forward-line 1))))))))
 552
 553
 554 (defun gnus-bookmark-insert-details (bmk-name)
 555   "Insert the details of the article associated with BMK-NAME."
 556   (let ((start (point)))
 557     (prog1
 558         (insert (gnus-bookmark-get-details
 559                  bmk-name
 560                  gnus-bookmark-bookmark-inline-details))
 561       (if (and (display-color-p) (display-mouse-p))
 562           (add-text-properties
 563            start
 564            (save-excursion (re-search-backward
 565                             "[^ \t]")
 566                                                (1+ (point)))
 567            '(mouse-face highlight
 568              follow-link t
 569              help-echo "mouse-2: go to this article"))))))
 570
 571
 572 (defun gnus-bookmark-kill-line (&optional newline-too)
 573   "Kill from point to end of line.
 574 If optional arg NEWLINE-TOO is non-nil, delete the newline too.
 575 Does not affect the kill ring."
 576   (let ((eol (save-excursion (end-of-line) (point))))
 577     (delete-region (point) eol)
 578     (if (and newline-too (looking-at "\n"))
 579         (delete-char 1))))
 580
 581
 582 (defun gnus-bookmark-get-details (bmk-name details-list)
 583   "Get details for a Gnus BMK-NAME depending on DETAILS-LIST."
 584   (let ((details (cadr (assoc bmk-name gnus-bookmark-alist))))
 585     (mapconcat
 586      (lambda (info)
 587        (cdr (assoc info details)))
 588      details-list " | ")))
 589
 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 (and (display-color-p) (display-mouse-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                          "mouse-2: go to this bookmark in other window"))))
 623                 (setq gnus-bookmark-bmenu-hidden-bookmarks
 624                       (cdr gnus-bookmark-bmenu-hidden-bookmarks))
 625                 (forward-line 1))))))))
 626
 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
 643 (defun gnus-bookmark-bmenu-bookmark ()
 644   "Return a string which is bookmark of this line."
 645   (if (gnus-bookmark-bmenu-check-position)
 646       (save-excursion
 647         (save-window-excursion
 648           (goto-char (point-min))
 649           (search-forward "Gnus Bookmark")
 650           (backward-word 2)
 651           (setq gnus-bookmark-bmenu-bookmark-column (current-column)))))
 652   (if gnus-bookmark-bmenu-toggle-infos
 653       (gnus-bookmark-bmenu-hide-infos))
 654   (save-excursion
 655     (save-window-excursion
 656       (beginning-of-line)
 657       (forward-char gnus-bookmark-bmenu-bookmark-column)
 658       (prog1
 659           (buffer-substring-no-properties (point)
 660                             (progn
 661                               (end-of-line)
 662                               (point)))
 663         ;; well, this is certainly crystal-clear:
 664         (if gnus-bookmark-bmenu-toggle-infos
 665             (gnus-bookmark-bmenu-toggle-infos t))))))
 666
 667
 668 (defun gnus-bookmark-show-details (bookmark)
 669   "Display the annotation for BOOKMARK in a buffer."
 670   (let ((record (gnus-bookmark-get-bookmark-record bookmark))
 671         (details-list gnus-bookmark-bookmark-details))
 672     (save-excursion
 673       (let ((old-buf (current-buffer)))
 674         (pop-to-buffer (get-buffer-create "*Gnus Bookmark Annotation*") t)
 675         (delete-region (point-min) (point-max))
 676         (mapcar
 677          (lambda (detail)
 678            (when (not (equal (cdr (assoc detail record)) ""))
 679              (insert (concat (symbol-name detail) ": "
 680                              (cdr (assoc detail record))
 681                              "\n"))))
 682          gnus-bookmark-bookmark-details)
 683         (goto-char (point-min))
 684         (pop-to-buffer old-buf)))))
 685
 686
 687 (defun gnus-bookmark-bmenu-show-details ()
 688   "Show the annotation for the current bookmark in another window."
 689   (interactive)
 690   (let ((bookmark (gnus-bookmark-bmenu-bookmark)))
 691     (if (gnus-bookmark-bmenu-check-position)
 692         (gnus-bookmark-show-details bookmark))))
 693
 694
 695 (defun gnus-bookmark-bmenu-mark ()
 696   "Mark bookmark on this line to be displayed by \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-select]."
 697   (interactive)
 698   (beginning-of-line)
 699   (if (gnus-bookmark-bmenu-check-position)
 700       (let ((inhibit-read-only t))
 701         (delete-char 1)
 702         (insert ?>)
 703         (forward-line 1)
 704         (gnus-bookmark-bmenu-check-position))))
 705
 706
 707 (defun gnus-bookmark-bmenu-unmark (&optional backup)
 708   "Cancel all requested operations on bookmark on this line and move down.
 709 Optional BACKUP means move up."
 710   (interactive "P")
 711   (beginning-of-line)
 712   (if (gnus-bookmark-bmenu-check-position)
 713       (progn
 714         (let ((inhibit-read-only t))
 715           (delete-char 1)
 716           ;; any flags to reset according to circumstances?  How about a
 717           ;; flag indicating whether this bookmark is being visited?
 718           ;; well, we don't have this now, so maybe later.
 719           (insert " "))
 720         (forward-line (if backup -1 1))
 721         (gnus-bookmark-bmenu-check-position))))
 722
 723
 724 (defun gnus-bookmark-bmenu-backup-unmark ()
 725   "Move up and cancel all requested operations on bookmark on line above."
 726   (interactive)
 727   (forward-line -1)
 728   (if (gnus-bookmark-bmenu-check-position)
 729       (progn
 730         (gnus-bookmark-bmenu-unmark)
 731         (forward-line -1)
 732         (gnus-bookmark-bmenu-check-position))))
 733
 734
 735 (defun gnus-bookmark-bmenu-delete ()
 736   "Mark Gnus bookmark on this line to be deleted.
 737 To carry out the deletions that you've marked, use
 738 \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-execute-deletions]."
 739   (interactive)
 740   (beginning-of-line)
 741   (if (gnus-bookmark-bmenu-check-position)
 742       (let ((inhibit-read-only t))
 743         (delete-char 1)
 744         (insert ?D)
 745         (forward-line 1)
 746         (gnus-bookmark-bmenu-check-position))))
 747
 748
 749 (defun gnus-bookmark-bmenu-delete-backwards ()
 750   "Mark bookmark on this line to be deleted, then move up one line.
 751 To carry out the deletions that you've marked, use
 752 \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-execute-deletions]."
 753   (interactive)
 754   (gnus-bookmark-bmenu-delete)
 755   (forward-line -2)
 756   (if (gnus-bookmark-bmenu-check-position)
 757       (forward-line 1))
 758   (gnus-bookmark-bmenu-check-position))
 759
 760
 761 (defun gnus-bookmark-bmenu-select ()
 762   "Select this line's bookmark; also display bookmarks marked with `>'.
 763 You can mark bookmarks with the
 764 \\<gnus-bookmark-bmenu-mode-map>\\[gnus-bookmark-bmenu-mark]
 765 command."
 766   (interactive)
 767   (if (gnus-bookmark-bmenu-check-position)
 768       (let ((bmrk (gnus-bookmark-bmenu-bookmark))
 769             (menu (current-buffer)))
 770         (goto-char (point-min))
 771         (delete-other-windows)
 772         (gnus-bookmark-jump bmrk)
 773         (bury-buffer menu))))
 774
 775
 776 (defun gnus-bookmark-bmenu-load ()
 777   "Load the Gnus bookmark file and rebuild the bookmark menu-buffer."
 778   (interactive)
 779   (if (gnus-bookmark-bmenu-check-position)
 780       (save-excursion
 781         (save-window-excursion
 782           ;; This will call `gnus-bookmark-bmenu-list'
 783           (call-interactively 'gnus-bookmark-load)))))
 784
 785
 786 (defun gnus-bookmark-bmenu-execute-deletions ()
 787   "Delete Gnus bookmarks marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
 788   (interactive)
 789   (message "Deleting Gnus bookmarks...")
 790   (let ((hide-em gnus-bookmark-bmenu-toggle-infos)
 791         (o-point  (point))
 792         (o-str    (save-excursion
 793                     (beginning-of-line)
 794                     (if (looking-at "^D")
 795                         nil
 796                       (buffer-substring
 797                        (point)
 798                        (progn (end-of-line) (point))))))
 799         (o-col     (current-column)))
 800     (if hide-em (gnus-bookmark-bmenu-hide-infos))
 801     (setq gnus-bookmark-bmenu-toggle-infos nil)
 802     (goto-char (point-min))
 803     (forward-line 1)
 804     (while (re-search-forward "^D" (point-max) t)
 805       (gnus-bookmark-delete (gnus-bookmark-bmenu-bookmark) t)) ; pass BATCH arg
 806     (gnus-bookmark-bmenu-list)
 807     (setq gnus-bookmark-bmenu-toggle-infos hide-em)
 808     (if gnus-bookmark-bmenu-toggle-infos
 809         (gnus-bookmark-bmenu-toggle-infos t))
 810     (if o-str
 811         (progn
 812           (goto-char (point-min))
 813           (search-forward o-str)
 814           (beginning-of-line)
 815           (forward-char o-col))
 816       (goto-char o-point))
 817     (beginning-of-line)
 818     (gnus-bookmark-write-file)
 819     (message "Deleting bookmarks...done")))
 820
 821
 822 (defun gnus-bookmark-delete (bookmark &optional batch)
 823   "Delete BOOKMARK from the bookmark list.
 824 Removes only the first instance of a bookmark with that name.  If
 825 there are one or more other bookmarks with the same name, they will
 826 not be deleted.  Defaults to the \"current\" bookmark \(that is, the
 827 one most recently used in this file, if any\).
 828 Optional second arg BATCH means don't update the bookmark list buffer,
 829 probably because we were called from there."
 830   (gnus-bookmark-maybe-load-default-file)
 831   (let ((will-go (gnus-bookmark-get-bookmark bookmark)))
 832     (setq gnus-bookmark-alist (delq will-go gnus-bookmark-alist)))
 833   ;; Don't rebuild the list
 834   (if batch
 835       nil
 836     (gnus-bookmark-bmenu-surreptitiously-rebuild-list)))
 837
 838
 839 \f
 840 ;;;;##########################################################################
 841 ;;;;  User Options, Variables
 842 ;;;;##########################################################################
 843
 844
 845
 846
 847
 848 ;;; gnus-bookmark.el ends here