]> code.delx.au - gnu-emacs/blobdiff - lisp/bookmark.el
(normal-splash-screen, fancy-splash-screens-1): Add a reference to the Lisp
[gnu-emacs] / lisp / bookmark.el
index 23e1ce11277a766c3b1dc745c0846eb5002e4e0f..104a9c6512fa4d6871940772c09d3c68890a260f 100644 (file)
@@ -1,7 +1,7 @@
 ;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later
 
 ;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003,
-;;   2004, 2005 Free Software Foundation, Inc.
+;;   2004, 2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: Karl Fogel <kfogel@red-bean.com>
 ;; Maintainer: Karl Fogel <kfogel@red-bean.com>
@@ -198,6 +198,13 @@ following in your `.emacs' file:
   :group 'bookmark)
 
 
+(defface bookmark-menu-heading
+  '((t (:inherit font-lock-type-face)))
+  "Face used to highlight the heading in bookmark menu buffers."
+  :group 'bookmark
+  :version "22.1")
+
+
 ;;; No user-serviceable parts beyond this point.
 
 ;; Is it XEmacs?
@@ -211,12 +218,6 @@ following in your `.emacs' file:
 ;; suggested for lucid compatibility by david hughes:
 (or (fboundp 'frame-height)  (defalias 'frame-height 'screen-height))
 
-;; This variable is probably obsolete now...
-(or (boundp 'baud-rate)
-    ;; some random value higher than 9600
-    (setq baud-rate 19200))
-
-
 \f
 ;;; Keymap stuff:
 
@@ -715,6 +716,14 @@ This expects to be called from `point-min' in a bookmark file."
 
 ;;; end file-format stuff
 
+\f
+;;; Generic helpers.
+
+(defun bookmark-maybe-message (fmt &rest args)
+  "Apply `message' to FMT and ARGS, but only if the display is fast enough."
+  (if (>= baud-rate 9600)
+      (apply 'message fmt args)))
+
 \f
 ;;; Core code:
 
@@ -1175,12 +1184,14 @@ minibuffer history list `bookmark-history'."
     (prog1
        (insert (bookmark-location bookmark)) ; *Return this line*
       (if (and (display-color-p) (display-mouse-p))
-         (add-text-properties start
-                              (save-excursion (re-search-backward
-                                               "[^ \t]")
+         (add-text-properties
+          start
+          (save-excursion (re-search-backward
+                           "[^ \t]")
                                               (1+ (point)))
-                              '(mouse-face highlight
-                                help-echo "mouse-2: go to this bookmark"))))))
+          '(mouse-face highlight
+            follow-link t
+            help-echo "mouse-2: go to this bookmark in other window"))))))
 
 ;;;###autoload
 (defalias 'bookmark-locate 'bookmark-insert-location)
@@ -1347,14 +1358,12 @@ for a file, defaulting to the file defined by variable
 (defun bookmark-write-file (file)
   (save-excursion
     (save-window-excursion
-      (if (>= baud-rate 9600)
-          (message "Saving bookmarks to file %s..." file))
-      (set-buffer (let ((enable-local-variables nil))
-                    (find-file-noselect file)))
+      (bookmark-maybe-message "Saving bookmarks to file %s..." file)
+      (set-buffer (get-buffer-create " *Bookmarks*"))
       (goto-char (point-min))
+      (delete-region (point-min) (point-max))
       (let ((print-length nil)
            (print-level nil))
-       (delete-region (point-min) (point-max))
        (bookmark-insert-file-format-version-stamp)
        (pp bookmark-alist (current-buffer))
        (let ((version-control
@@ -1365,11 +1374,11 @@ for a file, defaulting to the file defined by variable
                (t
                 t))))
           (condition-case nil
-              (write-file file)
+              (write-region (point-min) (point-max) file)
             (file-error (message "Can't write %s" file)))
          (kill-buffer (current-buffer))
-         (if (>= baud-rate 9600)
-             (message "Saving bookmarks to file %s...done" file)))))))
+          (bookmark-maybe-message
+           "Saving bookmarks to file %s...done" file))))))
 
 
 (defun bookmark-import-new-list (new-list)
@@ -1435,8 +1444,8 @@ method buffers use to resolve name collisions."
   (if (file-readable-p file)
       (save-excursion
         (save-window-excursion
-          (if (and (null no-msg) (>= baud-rate 9600))
-              (message "Loading bookmarks from %s..." file))
+          (if (null no-msg)
+              (bookmark-maybe-message "Loading bookmarks from %s..." file))
           (set-buffer (let ((enable-local-variables nil))
                         (find-file-noselect file)))
           (goto-char (point-min))
@@ -1459,8 +1468,8 @@ method buffers use to resolve name collisions."
                   (bookmark-bmenu-surreptitiously-rebuild-list))
               (error "Invalid bookmark list in %s" file)))
           (kill-buffer (current-buffer)))
-       (if (and (null no-msg) (>= baud-rate 9600))
-            (message "Loading bookmarks from %s...done" file)))
+       (if (null no-msg)
+            (bookmark-maybe-message "Loading bookmarks from %s...done" file)))
     (error "Cannot read bookmark file %s" file)))
 
 
@@ -1553,6 +1562,8 @@ deletion, or > if it is flagged for displaying."
   (let ((inhibit-read-only t))
     (erase-buffer)
     (insert "% Bookmark\n- --------\n")
+    (add-text-properties (point-min) (point)
+                        '(font-lock-face bookmark-menu-heading))
     (bookmark-maybe-sort-alist)
     (mapcar
      (lambda (full-record)
@@ -1566,12 +1577,14 @@ deletion, or > if it is flagged for displaying."
         (let ((start (point)))
           (insert (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
-                                     help-echo "mouse-2: go to this bookmark")))
+              (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 bookmark in other window")))
           (insert "\n")
           )))
      bookmark-alist))
@@ -1695,13 +1708,15 @@ Optional argument SHOW means show them unconditionally."
                (let ((start (point)))
                  (insert (car bookmark-bmenu-hidden-bookmarks))
                  (if (and (display-color-p) (display-mouse-p))
-                     (add-text-properties start
-                                          (save-excursion (re-search-backward
-                                                           "[^ \t]")
-                                                          (1+ (point)))
-                                          '(mouse-face highlight
-                                            help-echo
-                                            "mouse-2: go to this bookmark"))))
+                     (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 bookmark in other window"))))
                 (setq bookmark-bmenu-hidden-bookmarks
                       (cdr bookmark-bmenu-hidden-bookmarks))
                 (forward-line 1))))))))
@@ -2058,7 +2073,7 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
   (interactive)
   (if (bookmark-bmenu-check-position)
       (let ((bmrk (bookmark-bmenu-bookmark)))
-        (message (bookmark-location bmrk)))))
+        (message "%s" (bookmark-location bmrk)))))
 
 (defun bookmark-bmenu-relocate ()
   "Change the file path of the bookmark on the current line,