X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-bookmark.el;h=423750893d85a62462a177704eaf75e55821ca70;hb=b0eccd76f35ef80c3ad13f09e588d49358e9c22a;hp=a5928b84991f8f1875520b6d719ba49fa9644dac;hpb=9b139a13c0650a18872ebd64849560a97554afa8;p=gnus diff --git a/lisp/gnus-bookmark.el b/lisp/gnus-bookmark.el index a5928b849..423750893 100644 --- a/lisp/gnus-bookmark.el +++ b/lisp/gnus-bookmark.el @@ -1,26 +1,24 @@ ;;; gnus-bookmark.el --- Bookmarks in Gnus -;; Copyright (C) 2006 Free Software Foundation, Inc. +;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Bastien Guerry ;; 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 3, 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 . ;;; Commentary: @@ -62,6 +60,14 @@ ;; (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) @@ -139,7 +145,7 @@ The default value is \(author subject date group annotation\)." (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 @@ -150,9 +156,6 @@ The default value is \(author subject date group annotation\)." "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 @@ -174,8 +177,8 @@ 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) - '(and (eq (device-class) 'color) (device-on-window-system-p)) - '(and (display-color-p) (display-mouse-p)))) + '(device-on-window-system-p) + '(display-mouse-p))) (defun gnus-bookmark-remove-properties (string) "Remove all text properties from STRING." @@ -207,13 +210,13 @@ So the cdr of each bookmark is an alist too.") (setq gnus-bookmark-alist (cons (list (gnus-bookmark-remove-properties bmk-name) - (gnus-bookmark-make-cell + (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 @@ -286,11 +289,11 @@ So the cdr of each bookmark is an alist too.") (interactive) (gnus-bookmark-maybe-load-default-file) (let* ((bookmark (or bmk-name - (completing-read "Jump to bookmarked article: " - 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)))) + (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)) @@ -367,7 +370,8 @@ deletion, or > if it is flagged for displaying." (if (interactive-p) (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) @@ -375,30 +379,29 @@ deletion, or > if it is flagged for displaying." ;; 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 (gnus-bookmark-mouse-available-p) - (add-text-properties - start - (save-excursion (re-search-backward - "[^ \t]") - (1+ (point))) - `(mouse-face highlight - follow-link t - help-echo ,(format "%s: go to this article" - (aref gnus-mouse-2 0))))) - (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) @@ -659,20 +662,19 @@ reposition and try again, else return nil." (defun gnus-bookmark-show-details (bookmark) "Display the annotation for BOOKMARK in a buffer." - (let ((record (gnus-bookmark-get-bookmark-record bookmark))) + (let ((record (gnus-bookmark-get-bookmark-record bookmark)) + (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." @@ -823,5 +825,4 @@ probably because we were called from there." (provide 'gnus-bookmark) -;; arch-tag: 779df694-366f-46e8-84b2-1d0340e6f525 ;;; gnus-bookmark.el ends here