code.delx.au - gnu-emacs/blob - lisp/gnus/gnus-bookmark.el

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