;;; gnus-bookmark.el --- Bookmarks in Gnus
-;; Copyright (C) 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2014 Free Software Foundation, Inc.
;; Author: Bastien Guerry <bzg AT altern DOT org>
;; Keywords: news
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; - renaming bookmarks in gnus-bookmark-bmenu-list
;; - better (formatted string) display in bmenu-list
-;; - Fix use of `split-string' and `assoc-string' for compatibility with Emacs
-;; 21 and XEmacs 21.4.
;; - Integrate the `gnus-summary-*-bookmark' functionality
;; - Initialize defcustoms from corresponding `bookmark.el' variables?
;; (define-key global-map "\C-crj" 'gnus-bookmark-jump)
;; (define-key global-map "\C-crl" 'gnus-bookmark-bmenu-list)
+;; FIXME: Add keybindings, see
+;; http://thread.gmane.org/gmane.emacs.gnus.general/63101/focus=63379
+;; http://thread.gmane.org/v9fxx9fkm4.fsf@marauder.physik.uni-ulm.de
+
+;; FIXME: Check if `gnus-bookmark.el' should use
+;; `bookmark-make-cell-function'.
+;; Cf. http://article.gmane.org/gmane.emacs.gnus.general/66076
+
(defgroup gnus-bookmark nil
"Setting, annotation and jumping to Gnus bookmarks."
:group 'gnus)
:type 'string
:group 'gnus-bookmark)
+(defcustom gnus-bookmark-file-coding-system
+ (if (mm-coding-system-p 'iso-2022-7bit)
+ 'iso-2022-7bit)
+ "Coding system used for writing Gnus bookmark files."
+ :type '(symbol :tag "Coding system")
+ :group 'gnus-bookmark)
+
(defcustom gnus-bookmark-sort-flag t
"Non-nil means Gnus bookmarks are sorted by bookmark names.
Otherwise they will be displayed in LIFO order (that is,
(defface gnus-bookmark-menu-heading
'((t (:inherit font-lock-type-face)))
"Face used to highlight the heading in Gnus bookmark menu buffers."
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:group 'gnus-bookmark)
(defconst gnus-bookmark-end-of-version-stamp-marker
"The current version of the format used by bookmark files.
You should never need to change this.")
-(defvar gnus-bookmark-after-jump-hook nil
- "Hook run after `gnus-bookmark-jump' jumps to a Gnus bookmark.")
-
(defvar gnus-bookmark-alist ()
"Association list of Gnus bookmarks and their records.
The format of the alist is
So the cdr of each bookmark is an alist too.")
+(defmacro gnus-bookmark-mouse-available-p ()
+ "Return non-nil if a mouse is available."
+ (if (featurep 'xemacs)
+ '(device-on-window-system-p)
+ '(display-mouse-p)))
+
+(defun gnus-bookmark-remove-properties (string)
+ "Remove all text properties from STRING."
+ (set-text-properties 0 (length string) nil string)
+ string)
+
;;;###autoload
(defun gnus-bookmark-set ()
"Set a bookmark for this article."
(interactive)
(gnus-bookmark-maybe-load-default-file)
- (if (or (not (eq major-mode 'gnus-summary-mode))
+ (if (or (not (derived-mode-p 'gnus-summary-mode))
(not gnus-article-current))
(error "Please select an article in the Gnus summary buffer")
(let* ((group (car gnus-article-current))
;; Set the bookmark list
(setq gnus-bookmark-alist
(cons
- (list bmk-name
- (gnus-bookmark-make-cell
+ (list (gnus-bookmark-remove-properties bmk-name)
+ (gnus-bookmark-make-record
group message-id author date subject annotation))
gnus-bookmark-alist))))
(gnus-bookmark-bmenu-surreptitiously-rebuild-list)
(gnus-bookmark-write-file))
-(defun gnus-bookmark-make-cell
+(defun gnus-bookmark-make-record
(group message-id author date subject annotation)
"Return the record part of a new bookmark, given GROUP MESSAGE-ID AUTHOR DATE SUBJECT and ANNOTATION."
(let ((the-record
- `((group . ,group)
- (message-id . ,message-id)
- (author . ,author)
- (date . ,date)
- (subject . ,subject)
- (annotation . ,annotation))))
+ `((group . ,(gnus-bookmark-remove-properties group))
+ (message-id . ,(gnus-bookmark-remove-properties message-id))
+ (author . ,(gnus-bookmark-remove-properties author))
+ (date . ,(gnus-bookmark-remove-properties date))
+ (subject . ,(gnus-bookmark-remove-properties subject))
+ (annotation . ,(gnus-bookmark-remove-properties annotation)))))
the-record))
(defun gnus-bookmark-set-bookmark-name (group author subject)
"Set bookmark name from GROUP AUTHOR and SUBJECT."
(let* ((subject (split-string subject))
(default-name-0 ;; Should be merged with -1?
- ;; FIXME: In Emacs 21 or XEmacs 21.4 split-string accepts only 1-2
- ;; args.
- (concat (car (reverse (split-string group "[\\.:]" t))) "-"
- (car (split-string author)) "-"
- (concat (car subject) "-"
- (cadr subject))))
+ (concat (car (nreverse (delete "" (split-string group "[\\.:]"))))
+ "-" (car (split-string author))
+ "-" (car subject) "-" (cadr subject)))
(default-name-1
;; Strip "[]" chars from the bookmark name:
(gnus-replace-in-string default-name-0 "[]_[]" ""))
(gnus-bookmark-insert-file-format-version-stamp)
(pp gnus-bookmark-alist (current-buffer))
(condition-case nil
- (write-region (point-min) (point-max)
- gnus-bookmark-default-file)
+ (let ((coding-system-for-write gnus-bookmark-file-coding-system))
+ (write-region (point-min) (point-max)
+ gnus-bookmark-default-file))
(file-error (message "Can't write %s"
gnus-bookmark-default-file)))
(kill-buffer (current-buffer))
(defun gnus-bookmark-insert-file-format-version-stamp ()
"Insert text indicating current version of Gnus bookmark file format."
(insert
- (format ";;;; Gnus Bookmark Format Version %d ;;;;\n"
- gnus-bookmark-file-format-version))
+ (format ";;;; Gnus Bookmark Format Version %d %s;;;;\n"
+ gnus-bookmark-file-format-version
+ (if gnus-bookmark-file-coding-system
+ (concat "-*- coding: "
+ (symbol-name gnus-bookmark-file-coding-system)
+ "; -*- ")
+ "")))
(insert ";;; This format is meant to be slightly human-readable;\n"
";;; nevertheless, you probably don't want to edit it.\n"
";;; "
(interactive)
(gnus-bookmark-maybe-load-default-file)
(let* ((bookmark (or bmk-name
- (completing-read "Jump to bookmarked article: "
- (mapcar 'car gnus-bookmark-alist))))
- (bmk-cell (cadr (assoc bookmark gnus-bookmark-alist)))
- (group (cdr (assoc 'group bmk-cell)))
- (message-id (cdr (assoc 'message-id bmk-cell))))
- (require 'gnus)
- (if group (gnus-fetch-group group))
+ (gnus-completing-read "Jump to bookmarked article"
+ (mapcar 'car gnus-bookmark-alist))))
+ (bmk-record (cadr (assoc bookmark gnus-bookmark-alist)))
+ (group (cdr (assoc 'group bmk-record)))
+ (message-id (cdr (assoc 'message-id bmk-record))))
+ (when group
+ (unless (get-buffer gnus-group-buffer)
+ (gnus-no-server))
+ (gnus-activate-group group)
+ (gnus-group-quick-select-group 0 group))
(if message-id
(or (gnus-summary-goto-article message-id nil 'force)
(if (fboundp 'gnus-summary-insert-cached-articles)
deletion, or > if it is flagged for displaying."
(interactive)
(gnus-bookmark-maybe-load-default-file)
- (if (interactive-p)
+ (if (gmm-called-interactively-p 'any)
(switch-to-buffer (get-buffer-create "*Gnus Bookmark List*"))
(set-buffer (get-buffer-create "*Gnus Bookmark List*")))
- (let ((inhibit-read-only t))
+ (let ((inhibit-read-only t)
+ alist name start end)
(erase-buffer)
(insert "% Gnus Bookmark\n- --------\n")
(add-text-properties (point-min) (point)
;; sort before displaying
(gnus-bookmark-maybe-sort-alist)
;; Display gnus bookmarks
- (mapcar
- (lambda (full-record)
- ;; if a Gnus bookmark has an annotation, prepend a "*"
- ;; in the list of bookmarks.
- (let ((annotation (gnus-bookmark-get-annotation
- (gnus-bookmark-name-from-full-record full-record))))
- (if (and annotation (not (string-equal annotation "")))
- (insert " *")
- (insert " "))
- (let ((start (point)))
- (insert (gnus-bookmark-name-from-full-record full-record))
- (if (and (display-color-p) (display-mouse-p))
- (add-text-properties
- start
- (save-excursion (re-search-backward
- "[^ \t]")
- (1+ (point)))
- '(mouse-face highlight
- follow-link t
- help-echo "mouse-2: go to this article")))
- (insert "\n")
- )))
- gnus-bookmark-alist)
+ (setq alist gnus-bookmark-alist)
+ (while alist
+ (setq name (gnus-bookmark-name-from-full-record (pop alist)))
+ ;; if a Gnus bookmark has an annotation, prepend a "*"
+ ;; in the list of bookmarks.
+ (insert (if (member (gnus-bookmark-get-annotation name) (list nil ""))
+ " "
+ " *"))
+ (if (gnus-bookmark-mouse-available-p)
+ (add-text-properties
+ (prog1
+ (point)
+ (insert name))
+ (let ((end (point)))
+ (prog2
+ (re-search-backward "[^ \t]")
+ (1+ (point))
+ (goto-char end)
+ (insert "\n")))
+ `(mouse-face highlight follow-link t
+ help-echo ,(format "%s: go to this article"
+ (aref gnus-mouse-2 0))))
+ (insert name "\n")))
(goto-char (point-min))
(forward-line 2)
(gnus-bookmark-bmenu-mode)
"Return the full entry for Gnus BOOKMARK in `gnus-bookmark-alist'.
If BOOKMARK is not a string, return nil."
(when (stringp bookmark)
- ;; FIXME: `assoc-string' doesn't exist in Emacs 21 and XEmacs 21.4:
- (assoc-string bookmark gnus-bookmark-alist t)))
+ (assoc bookmark gnus-bookmark-alist)))
(defun gnus-bookmark-get-bookmark-record (bookmark)
"Return the guts of the entry for Gnus BOOKMARK in `gnus-bookmark-alist'.
nil
(setq gnus-bookmark-bmenu-mode-map (make-keymap))
(suppress-keymap gnus-bookmark-bmenu-mode-map t)
- (define-key gnus-bookmark-bmenu-mode-map "q" 'quit-window)
+ (define-key gnus-bookmark-bmenu-mode-map "q" (if (fboundp 'quit-window)
+ 'quit-window
+ 'bury-buffer))
(define-key gnus-bookmark-bmenu-mode-map "\C-m" 'gnus-bookmark-bmenu-select)
(define-key gnus-bookmark-bmenu-mode-map "v" 'gnus-bookmark-bmenu-select)
(define-key gnus-bookmark-bmenu-mode-map "d" 'gnus-bookmark-bmenu-delete)
(define-key gnus-bookmark-bmenu-mode-map "s" 'gnus-bookmark-bmenu-save)
(define-key gnus-bookmark-bmenu-mode-map "t" 'gnus-bookmark-bmenu-toggle-infos)
(define-key gnus-bookmark-bmenu-mode-map "a" 'gnus-bookmark-bmenu-show-details)
- (define-key gnus-bookmark-bmenu-mode-map [mouse-2] 'gnus-bookmark-bmenu-select))
+ (define-key gnus-bookmark-bmenu-mode-map gnus-mouse-2
+ 'gnus-bookmark-bmenu-select-by-mouse))
;; Bookmark Buffer Menu mode is suitable only for specially formatted
;; data.
;; Been to lazy to use gnus-bookmark-save...
(defalias 'gnus-bookmark-bmenu-save 'gnus-bookmark-write-file)
-(defun gnus-bookmark-bmenu-mode ()
+(define-derived-mode gnus-bookmark-bmenu-mode fundamental-mode "Bookmark Menu"
"Major mode for editing a list of Gnus bookmarks.
Each line describes one of the bookmarks in Gnus.
Letters do not insert themselves; instead, they are commands.
in another buffer.
\\[gnus-bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer.
\\[gnus-bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark."
- (kill-all-local-variables)
- (use-local-map gnus-bookmark-bmenu-mode-map)
(setq truncate-lines t)
- (setq buffer-read-only t)
- (setq major-mode 'gnus-bookmark-bmenu-mode)
- (setq mode-name "Bookmark Menu")
- (gnus-run-mode-hooks 'gnus-bookmark-bmenu-mode-hook))
+ (setq buffer-read-only t))
;; avoid compilation warnings
(defvar gnus-bookmark-bmenu-toggle-infos nil)
(let ((bmrk (gnus-bookmark-bmenu-bookmark)))
(setq gnus-bookmark-bmenu-hidden-bookmarks
(cons bmrk gnus-bookmark-bmenu-hidden-bookmarks))
- (let ((start (save-excursion (end-of-line) (point))))
+ (let ((start (point-at-eol)))
(move-to-column gnus-bookmark-bmenu-file-column t)
;; Strip off `mouse-face' from the white spaces region.
- (if (and (display-color-p) (display-mouse-p))
+ (if (gnus-bookmark-mouse-available-p)
(remove-text-properties start (point)
'(mouse-face nil help-echo nil))))
(delete-region (point) (progn (end-of-line) (point)))
(insert (gnus-bookmark-get-details
bmk-name
gnus-bookmark-bookmark-inline-details))
- (if (and (display-color-p) (display-mouse-p))
+ (if (gnus-bookmark-mouse-available-p)
(add-text-properties
start
(save-excursion (re-search-backward
"[^ \t]")
(1+ (point)))
- '(mouse-face highlight
+ `(mouse-face highlight
follow-link t
- help-echo "mouse-2: go to this article"))))))
+ help-echo ,(format "%s: go to this article"
+ (aref gnus-mouse-2 0))))))))
(defun gnus-bookmark-kill-line (&optional newline-too)
"Kill from point to end of line.
If optional arg NEWLINE-TOO is non-nil, delete the newline too.
Does not affect the kill ring."
- (let ((eol (save-excursion (end-of-line) (point))))
- (delete-region (point) eol)
- (if (and newline-too (looking-at "\n"))
- (delete-char 1))))
+ (delete-region (point) (point-at-eol))
+ (if (and newline-too (looking-at "\n"))
+ (delete-char 1)))
(defun gnus-bookmark-get-details (bmk-name details-list)
"Get details for a Gnus BMK-NAME depending on DETAILS-LIST."
(gnus-bookmark-kill-line)
(let ((start (point)))
(insert (car gnus-bookmark-bmenu-hidden-bookmarks))
- (if (and (display-color-p) (display-mouse-p))
+ (if (gnus-bookmark-mouse-available-p)
(add-text-properties
start
(save-excursion (re-search-backward
"[^ \t]")
(1+ (point)))
- '(mouse-face highlight
+ `(mouse-face highlight
follow-link t
help-echo
- "mouse-2: go to this bookmark in other window"))))
+ ,(format "%s: go to this bookmark in other window"
+ (aref gnus-mouse-2 0))))))
(setq gnus-bookmark-bmenu-hidden-bookmarks
(cdr gnus-bookmark-bmenu-hidden-bookmarks))
(forward-line 1))))))))
(defun gnus-bookmark-show-details (bookmark)
"Display the annotation for BOOKMARK in a buffer."
(let ((record (gnus-bookmark-get-bookmark-record bookmark))
- (details-list gnus-bookmark-bookmark-details))
+ (old-buf (current-buffer))
+ (details gnus-bookmark-bookmark-details)
+ detail)
(save-excursion
- (let ((old-buf (current-buffer)))
- (pop-to-buffer (get-buffer-create "*Gnus Bookmark Annotation*") t)
- (delete-region (point-min) (point-max))
- (mapcar
- (lambda (detail)
- (when (not (equal (cdr (assoc detail record)) ""))
- (insert (concat (symbol-name detail) ": "
- (cdr (assoc detail record))
- "\n"))))
- gnus-bookmark-bookmark-details)
- (goto-char (point-min))
- (pop-to-buffer old-buf)))))
+ (pop-to-buffer (get-buffer-create "*Gnus Bookmark Annotation*") t)
+ (erase-buffer)
+ (while details
+ (setq detail (pop details))
+ (unless (equal (cdr (assoc detail record)) "")
+ (insert (symbol-name detail) ": " (cdr (assoc detail record)) "\n")))
+ (goto-char (point-min))
+ (pop-to-buffer old-buf))))
(defun gnus-bookmark-bmenu-show-details ()
"Show the annotation for the current bookmark in another window."
(gnus-bookmark-jump bmrk)
(bury-buffer menu))))
+(defun gnus-bookmark-bmenu-select-by-mouse (event)
+ (interactive "e")
+ (mouse-set-point event)
+ (gnus-bookmark-bmenu-select))
+
(defun gnus-bookmark-bmenu-load ()
"Load the Gnus bookmark file and rebuild the bookmark menu-buffer."
(interactive)
(provide 'gnus-bookmark)
-;; arch-tag: 779df694-366f-46e8-84b2-1d0340e6f525
;;; gnus-bookmark.el ends here