Commit | Line | Data |
---|---|---|
b3bf02fa RS |
1 | ;;; bookmark.el --- set bookmarks, jump to them later. |
2 | ||
3 | ;; Copyright (C) 1993 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Karl Fogel <kfogel@cs.oberlin.edu> | |
6 | ;; Maintainer: FSF | |
7 | ;; Created: July, 1993 | |
8 | ;; Version: 1.7.2 | |
9 | ;; Keywords: bookmarks, placeholders | |
10 | ||
11 | ;; This file is part of GNU Emacs. | |
12 | ||
13 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
14 | ;; it under the terms of the GNU General Public License as published by | |
15 | ;; the Free Software Foundation; either version 2, or (at your option) | |
16 | ;; any later version. | |
17 | ||
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
24 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
25 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
26 | ||
27 | ;; Thanks to David Bremner <bremner@cs.sfu.ca> for thinking of and | |
28 | ;; then implementing the bookmark-current-bookmark idea. He even | |
29 | ;; sent *patches*, bless his soul... | |
30 | ||
31 | ;; Thanks to Gregory M. Saunders <saunders@cis.ohio-state.edu> for | |
32 | ;; fixing and improving bookmark-time-to-save-p. | |
33 | ||
34 | ;; Based on info-bookmark.el, by Karl Fogel and Ken Olstad | |
35 | ;; <olstad@msc.edu>. | |
36 | ||
37 | ;; LCD Archive Entry: | |
38 | ;; bookmark|Karl Fogel|kfogel@cs.oberlin.edu| | |
39 | ;; Setting bookmarks in files or directories, jumping to them later.| | |
40 | ;; 16-July-93|Version: 1.7.2|~/misc/bookmark.el.Z| | |
41 | ||
42 | ;; FAVORITE CHINESE RESTAURANT: | |
43 | ;; Boy, that's a tough one. Probably Hong Min, or maybe Emperor's | |
44 | ;; Choice (both in Chicago's Chinatown). Well, both. How about you? | |
45 | ||
46 | ;;; Commentary on code: | |
47 | ||
48 | ;; bookmark alist format: | |
49 | ;; (... | |
50 | ;; (bookmark-name (filename | |
51 | ;; string-in-front | |
52 | ;; string-behind | |
53 | ;; point)) | |
54 | ;; ...) | |
55 | ;; | |
56 | ;; bookmark-name is the string the user gives the bookmark and | |
57 | ;; accesses it by from then on. filename is the location of the file | |
58 | ;; in which the bookmark is set. string-in-front is a string of | |
59 | ;; `bookmark-search-size' chars of context in front of the point the | |
60 | ;; bookmark is set at, string-behind is the same thing after the | |
61 | ;; point. bookmark-jump will search for string-behind and | |
62 | ;; string-in-front in case the file has changed since the bookmark was | |
63 | ;; set. It will attempt to place the user before the changes, if | |
64 | ;; there were any. | |
65 | ||
66 | ;;; Code: | |
67 | ||
68 | ;; Added for lucid emacs compatibility, db | |
69 | (or (fboundp 'defalias) (fset 'defalias 'fset)) | |
70 | ||
71 | ;; these are the distribution keybindings suggested by RMS, everything | |
72 | ;; else will be done with M-x or the menubar: | |
73 | (define-key ctl-x-map "rb" 'bookmark-jump) | |
74 | (define-key ctl-x-map "rm" 'bookmark-set) | |
75 | (define-key ctl-x-map "rl" 'bookmark-locate) | |
76 | ||
77 | ;; define the map, so it can be bound by those who desire to do so: | |
78 | ||
79 | (defvar bookmark-map nil "This is a keymap containing bookmark | |
80 | functions. It is not bound to any key by default: to bind it so | |
81 | that you have a bookmark prefix, just use global-set-key and bind a | |
82 | key of your choice to \'bookmark-map. All interactive bookmark | |
83 | functions have a binding in this keymap.") | |
84 | ||
85 | (define-prefix-command 'bookmark-map) | |
86 | ||
87 | ;; Read the help on all of these functions for details... | |
88 | ;; "x" marks the spot! | |
89 | (define-key bookmark-map "x" 'bookmark-set) | |
90 | (define-key bookmark-map "j" 'bookmark-jump) | |
91 | (define-key bookmark-map "i" 'bookmark-insert) | |
92 | (define-key bookmark-map "f" 'bookmark-locate) ; "f" for "find" | |
93 | (define-key bookmark-map "n" 'bookmark-rename) ; "n" for "new name" | |
94 | ;; deletes bookmarks | |
95 | (define-key bookmark-map "d" 'bookmark-delete) | |
96 | ;; loads new file | |
97 | (define-key bookmark-map "l" 'bookmark-load) | |
98 | ;; saves them in file | |
99 | (define-key bookmark-map "w" 'bookmark-write) | |
100 | (define-key bookmark-map "s" 'bookmark-save) | |
101 | ||
102 | ;; just add the hook to make sure that people don't lose bookmarks | |
103 | ;; when they kill Emacs, unless they don't want to save them. | |
104 | ||
105 | (add-hook 'kill-emacs-hook | |
106 | (function | |
107 | (lambda () | |
108 | (and (featurep 'bookmark) | |
109 | bookmark-alist | |
110 | (bookmark-time-to-save-p t) | |
111 | (bookmark-save))))) | |
112 | ||
113 | ;; more stuff added by db. | |
114 | (defvar bookmark-current-bookmark nil | |
115 | "Store the bookmark most recently set, jumped to, or renamed. | |
116 | Buffer local, used to make moving a bookmark forward through a | |
117 | file easier.") | |
118 | ||
119 | (make-variable-buffer-local 'bookmark-current-bookmark) | |
120 | ||
121 | (defvar bookmark-save-flag t | |
122 | "*Nil means never save bookmarks, except when bookmark-save is | |
123 | explicitly called \(\\[bookmark-save]\). | |
124 | ||
125 | t means save bookmarks when Emacs is killed. | |
126 | ||
127 | Otherise, it should be a number that is the frequency with which the | |
128 | bookmark list is saved \(i.e.: the number of times which Emacs\' | |
129 | bookmark list may be modified before it is automatically saved.\). If | |
130 | it is a number, Emacs will also automatically save bookmarks when it | |
131 | is killed. | |
132 | ||
133 | Therefore, the way to get it to save every time you make or delete a | |
134 | bookmark is to set this variable to 1 \(or 0, which produces the same | |
135 | behavior.\) | |
136 | ||
137 | To specify the file in which to save them, modify the variable | |
138 | bookmark-file, which is \"~/.emacs-bkmrks\" by default.") | |
139 | ||
140 | (defvar bookmark-alist-modification-count 0 | |
141 | "Number of times the bookmark list has been modified since last | |
142 | saved.") | |
143 | ||
144 | (defvar bookmark-file "~/.emacs-bkmrks" | |
145 | "*File in which to save bookmarks by default.") | |
146 | ||
147 | (defvar bookmark-completion-ignore-case t | |
148 | "*Non-nil means that the various bookmark functions that | |
149 | do completion will be case-insensitive in completion.") | |
150 | ||
151 | (defvar bookmark-search-size 500 "Number of chars resolution used | |
152 | in creating tag strings to record a bookmark. Bookmark functions will | |
153 | search for these strings in deciding where to jump to, to deal with | |
154 | changing values of point. I can\'t think of any reason you would want | |
155 | to modify this, and doing so might have side effects, so on your own | |
156 | head be it...") | |
157 | ||
158 | (defvar bookmark-alist () | |
159 | "Association list of bookmarks. | |
160 | You probably don't want to change the value of this alist yourself; | |
161 | instead, let the various bookmark functions do it for you.") | |
162 | ||
163 | (defvar bookmark-current-point 0) | |
164 | (defvar bookmark-yank-point 0) | |
165 | (defvar bookmark-current-buffer nil) | |
166 | ||
167 | (defun bookmark-set (&optional parg) | |
168 | "Set a bookmark named NAME inside a file. With prefix arg, will not | |
169 | overwrite a bookmark that has the same name as NAME if such a bookmark | |
170 | already exists, but instead will \"push\" the new bookmark onto the | |
171 | bookmark alist. Thus the most recently set bookmark with name NAME would | |
172 | be the one in effect at any given time, but the others are still there, | |
173 | should you decide to delete the most recent one. | |
174 | ||
175 | To yank words from the text of the buffer and use them as part of the | |
176 | bookmark name, type C-w while setting a bookmark. Successive C-w\'s | |
177 | yank successive words. | |
178 | ||
179 | Typing C-v inserts the name of the current file being visited. Typing | |
180 | C-u inserts the name of the last bookmark used in the buffer \(as an | |
181 | aid in using a single bookmark name to track your progress through a | |
182 | large file\). If no bookmark was used, then C-u behaves like C-v and | |
183 | inserts the name of the file being visited. | |
184 | ||
185 | Use \\[bookmark-delete] to remove bookmarks \(you give it a name, | |
186 | and it removes only the first instance of a bookmark with that name from | |
187 | the list of bookmarks.\)" | |
188 | (interactive "P") | |
189 | (if (not (bookmark-buffer-file-name)) | |
190 | (error "Buffer not visiting a file or directory.")) | |
191 | (setq bookmark-current-point (point)) | |
192 | (setq bookmark-yank-point (point)) | |
193 | (setq bookmark-current-buffer (current-buffer)) | |
194 | (let ((str | |
195 | (read-from-minibuffer | |
196 | "Set bookmark: " | |
197 | nil | |
198 | (let ((now-map (copy-keymap minibuffer-local-map))) | |
199 | (progn (define-key now-map "\C-w" | |
200 | 'bookmark-yank-word) | |
201 | (define-key now-map "\C-v" | |
202 | 'bookmark-insert-current-file-name) | |
203 | (define-key now-map "\C-u" | |
204 | 'bookmark-insert-current-bookmark)) | |
205 | now-map)))) | |
206 | (progn | |
207 | (bookmark-make parg str) | |
208 | (setq bookmark-current-bookmark str) | |
209 | (goto-char bookmark-current-point)))) | |
210 | ||
211 | (defun bookmark-insert-current-bookmark () | |
212 | ;; insert this buffer's value of bookmark-current-bookmark, default | |
213 | ;; to file name if it's nil. | |
214 | (interactive) | |
215 | (let ((str | |
216 | (save-excursion | |
217 | (set-buffer bookmark-current-buffer) | |
218 | bookmark-current-bookmark))) | |
219 | (if str (insert str) (bookmark-insert-current-file-name)))) | |
220 | ||
221 | (defun bookmark-insert-current-file-name () | |
222 | ;; insert the name (sans path) of the current file into the bookmark | |
223 | ;; name that is being set. | |
224 | (interactive) | |
225 | (let ((str (save-excursion | |
226 | (set-buffer bookmark-current-buffer) | |
227 | (bookmark-buffer-file-name)))) | |
228 | (insert (substring | |
229 | str | |
230 | (1+ (string-match | |
231 | "\\(/[^/]*\\)/*$" | |
232 | str)))))) | |
233 | ||
234 | (defun bookmark-yank-word () | |
235 | (interactive) | |
236 | ;; get the next word from the buffer and append it to the name of | |
237 | ;; the bookmark currently being set. | |
238 | (let ((string (save-excursion | |
239 | (set-buffer bookmark-current-buffer) | |
240 | (goto-char bookmark-yank-point) | |
241 | (buffer-substring | |
242 | (point) | |
243 | (save-excursion | |
244 | (forward-word 1) | |
245 | (setq bookmark-yank-point (point))))))) | |
246 | (insert string))) | |
247 | ||
248 | (defun bookmark-make (parg str) | |
249 | (if (and (assoc str bookmark-alist) (not parg)) | |
250 | ;; already existing boookmark under that name and | |
251 | ;; no prefix arg means just overwrite old bookmark | |
252 | (setcdr (assoc str bookmark-alist) | |
253 | (list (bookmark-make-cell))) | |
254 | ||
255 | ;; otherwise just cons it onto the front (either the bookmark | |
256 | ;; doesn't exist already, or there is no prefix arg. In either | |
257 | ;; case, we want the new bookmark consed onto the alist...) | |
258 | ||
259 | (setq bookmark-alist | |
260 | (cons | |
261 | (list str | |
262 | (bookmark-make-cell)) | |
263 | bookmark-alist))) | |
264 | ;; Added by db | |
265 | (setq bookmark-current-bookmark str) | |
266 | (setq bookmark-alist-modification-count | |
267 | (1+ bookmark-alist-modification-count)) | |
268 | (if (bookmark-time-to-save-p) | |
269 | (bookmark-save))) | |
270 | ||
271 | (defun bookmark-make-cell () | |
272 | ;; make the cell that is the cdr of a bookmark alist element. It | |
273 | ;; looks like this: | |
274 | ;; (filename search-forward-str search-back-str point) | |
275 | (list | |
276 | (bookmark-buffer-file-name) | |
277 | (if (>= (- (point-max) (point)) bookmark-search-size) | |
278 | (buffer-substring | |
279 | (point) | |
280 | (+ (point) bookmark-search-size)) | |
281 | nil) | |
282 | (if (>= (- (point) (point-min)) bookmark-search-size) | |
283 | (buffer-substring | |
284 | (point) | |
285 | (- (point) bookmark-search-size)) | |
286 | nil) | |
287 | (point))) | |
288 | ||
289 | (defun bookmark-buffer-file-name () | |
290 | (or | |
291 | buffer-file-name | |
292 | (if (and (boundp 'dired-directory) dired-directory) | |
293 | (if (stringp dired-directory) | |
294 | dired-directory | |
295 | (car dired-directory))))) | |
296 | ||
297 | (defun bookmark-try-default-file () | |
298 | (if (and (null bookmark-alist) | |
299 | (file-readable-p (expand-file-name bookmark-file))) | |
300 | (bookmark-load bookmark-file))) | |
301 | ||
302 | (defun bookmark-jump (str) | |
303 | "Go to the location saved in the bookmark BOOKMARK. You may have a | |
304 | problem using this function if the value of variable bookmark-alist | |
305 | is nil. If that happens, you need to load in some bookmarks. See | |
306 | help on function bookmark-load for more about this." | |
307 | (interactive (progn | |
308 | (bookmark-try-default-file) | |
309 | (let ((completion-ignore-case | |
310 | bookmark-completion-ignore-case)) | |
311 | (list (completing-read | |
312 | "Jump to bookmark: " | |
313 | bookmark-alist | |
314 | nil | |
315 | 0))))) | |
316 | (let ((whereto-list (car (cdr (assoc str bookmark-alist))))) | |
317 | (let ((file (car whereto-list)) | |
318 | (forward-str (car (cdr whereto-list))) | |
319 | (behind-str (car (cdr (cdr whereto-list)))) | |
320 | (place (car (cdr (cdr (cdr whereto-list)))))) | |
321 | (if (file-exists-p (expand-file-name file)) | |
322 | (progn | |
323 | (find-file (expand-file-name file)) | |
324 | (goto-char place) | |
325 | ;; Go searching forward first. Then, if forward-str exists and | |
326 | ;; was found in the file, we can search backward for behind-str. | |
327 | ;; Rationale is that if text was inserted between the two in the | |
328 | ;; file, it's better to be put before it so you can read it, | |
329 | ;; rather than after and remain perhaps unaware of the changes. | |
330 | (if forward-str | |
331 | (if (search-forward forward-str (point-max) t) | |
332 | (backward-char bookmark-search-size))) | |
333 | (if behind-str | |
334 | (if (search-backward behind-str (point-min) t) | |
335 | (forward-char bookmark-search-size))) | |
336 | ;; added by db | |
337 | (setq bookmark-current-bookmark str)) | |
338 | (error | |
339 | (concat "File " | |
340 | file | |
341 | " does not exist. Suggest deleting bookmark \"" | |
342 | str | |
343 | "\"")))))) | |
344 | ||
345 | (defun bookmark-locate (str) | |
346 | "Insert the name of the file associated with BOOKMARK \(as opposed | |
347 | to the contents of that file\)." | |
348 | (interactive (progn | |
349 | (bookmark-try-default-file) | |
350 | (let ((completion-ignore-case | |
351 | bookmark-completion-ignore-case)) | |
352 | (list (completing-read | |
353 | "Insert bookmark location: " | |
354 | bookmark-alist | |
355 | nil | |
356 | 0))))) | |
357 | (insert (car (car (cdr (assoc str bookmark-alist)))))) | |
358 | ||
359 | (defun bookmark-rename (old) | |
360 | "Change the name of BOOKMARK to NEWNAME. While you are entering | |
361 | the new name, consecutive C-w\'s will insert consectutive words from | |
362 | the text of the buffer into the new bookmark name, and C-v will insert | |
363 | the name of the file." | |
364 | (interactive (progn | |
365 | (bookmark-try-default-file) | |
366 | (let ((completion-ignore-case | |
367 | bookmark-completion-ignore-case)) | |
368 | (list (completing-read "Old bookmark name: " | |
369 | bookmark-alist | |
370 | nil | |
371 | 0))))) | |
372 | (progn | |
373 | (setq bookmark-current-point (point)) | |
374 | (setq bookmark-yank-point (point)) | |
375 | (setq bookmark-current-buffer (current-buffer)) | |
376 | (let ((cell (assoc old bookmark-alist)) | |
377 | (str | |
378 | (read-from-minibuffer | |
379 | "New name: " | |
380 | nil | |
381 | (let ((now-map (copy-keymap minibuffer-local-map))) | |
382 | (progn (define-key now-map "\C-w" | |
383 | 'bookmark-yank-word) | |
384 | (define-key now-map "\C-v" | |
385 | 'bookmark-insert-current-file-name)) | |
386 | now-map)))) | |
387 | (progn | |
388 | (setcar cell str) | |
389 | (setq bookmark-current-bookmark str) | |
390 | (setq bookmark-alist-modification-count | |
391 | (1+ bookmark-alist-modification-count)) | |
392 | (if (bookmark-time-to-save-p) | |
393 | (bookmark-save)))))) | |
394 | ||
395 | (defun bookmark-insert (str) | |
396 | "Insert the text of the file pointed to by bookmark BOOKMARK. You | |
397 | may have a problem using this function if the value of variable | |
398 | bookmark-alist is nil. If that happens, you need to load in some | |
399 | bookmarks. See help on function bookmark-load for more about this." | |
400 | (interactive (progn | |
401 | (bookmark-try-default-file) | |
402 | (let ((completion-ignore-case | |
403 | bookmark-completion-ignore-case)) | |
404 | (list (completing-read | |
405 | "Insert bookmark contents: " | |
406 | bookmark-alist | |
407 | nil | |
408 | 0))))) | |
409 | (let ((whereto-list (car (cdr (assoc str bookmark-alist))))) | |
410 | (let ((file (car whereto-list))) | |
411 | (if (file-readable-p (expand-file-name file)) | |
412 | (let ((str-to-insert | |
413 | (save-excursion | |
414 | (find-file (expand-file-name file)) | |
415 | (prog1 | |
416 | (buffer-substring (point-min) (point-max)) | |
417 | (bury-buffer)))) | |
418 | (orig-point (point))) | |
419 | (insert str-to-insert) | |
420 | (push-mark) | |
421 | (goto-char orig-point)) | |
422 | (error | |
423 | (concat "File " | |
424 | file | |
425 | " does not exist. Suggest deleting bookmark \"" | |
426 | str | |
427 | "\"")))))) | |
428 | ||
429 | (defun bookmark-delete (str) | |
430 | "Delete the bookmark named NAME from the bookmark list. Removes | |
431 | only the first instance of a bookmark with that name. If there is | |
432 | another bookmark with the same name, it will become \"current\" as | |
433 | soon as the old one is removed from the bookmark list. Defaults to | |
434 | the \"current\" bookmark \(that is, the one most recently set or | |
435 | jumped to in this file\). | |
436 | ||
437 | With a prefix argument, deletes all bookmarks \(will prompt for | |
438 | confirmation before such a drastic step, however.\) If you then save | |
439 | the empty bookmark list, they will truly be deleted; otherwise you | |
440 | will revert to the bookmarks saved in the default bookmark file | |
441 | automatically the next time you jump to a bookmark, insert one, rename | |
442 | one, or kill Emacs." | |
443 | (interactive (let ((completion-ignore-case | |
444 | bookmark-completion-ignore-case)) | |
445 | (list | |
446 | (if current-prefix-arg | |
447 | nil | |
448 | (completing-read | |
449 | "Delete bookmark: " | |
450 | bookmark-alist | |
451 | nil | |
452 | 0 | |
453 | bookmark-current-bookmark))))) | |
454 | (if (null str) | |
455 | (if (y-or-n-p "Delete all bookmarks? ") | |
456 | (progn | |
457 | (setq bookmark-alist nil) | |
458 | (message | |
459 | (if (file-readable-p (expand-file-name bookmark-file)) | |
460 | (format | |
461 | "Will revert to bookmarks in %s, unless you save now." | |
462 | bookmark-file) | |
463 | "All bookmarks deleted."))) | |
464 | (message "No bookmarks deleted.")) | |
465 | (let ((will-go (assoc str bookmark-alist))) | |
466 | (setq bookmark-alist (delq will-go bookmark-alist))) | |
467 | ;; Added by db, nil bookmark-current-bookmark if the last | |
468 | ;; occurence has been deleted | |
469 | (or (assoc bookmark-current-bookmark bookmark-alist) | |
470 | (setq bookmark-current-bookmark nil))) | |
471 | (setq bookmark-alist-modification-count | |
472 | (1+ bookmark-alist-modification-count)) | |
473 | (if (bookmark-time-to-save-p) | |
474 | (bookmark-save))) | |
475 | ||
476 | (defun bookmark-time-to-save-p (&optional last-time) | |
477 | ;; By Gregory M. Saunders <saunders@cis.ohio-state.edu> | |
478 | ;; finds out whether it's time to save bookmarks to a file, by | |
479 | ;; examining the value of variable bookmark-save-flag, and maybe | |
480 | ;; bookmark-alist-modification-count. Returns t if they should be | |
481 | ;; saved, nil otherwise. if last-time is non-nil, then this is | |
482 | ;; being called when emacs is killed. | |
483 | (cond (last-time | |
484 | (and (> bookmark-alist-modification-count 0) | |
485 | bookmark-save-flag)) | |
486 | ((numberp bookmark-save-flag) | |
487 | (>= bookmark-alist-modification-count bookmark-save-flag)) | |
488 | (t | |
489 | nil))) | |
490 | ||
491 | (defun bookmark-write () | |
492 | (interactive) | |
493 | (bookmark-save t)) | |
494 | ||
495 | (defun bookmark-save (&optional parg file) | |
496 | "Saves currently defined bookmarks in the file defined by | |
497 | the variable bookmark-file. With a prefix arg, save it in file | |
498 | FILE. | |
499 | ||
500 | If you are calling this from Lisp, the two arguments are PREFIX-ARG | |
501 | and FILE, and if you just want it to write to the default file, then | |
502 | pass no arguments. Or pass in nil and FILE, and it will save in FILE | |
503 | instead. If you pass in one argument, and it is non-nil, then the | |
504 | user will be interactively queried for a file to save in. | |
505 | ||
506 | When you want to load in the bookmarks from a file, use bookmark-load, | |
507 | \\[bookmark-load]. That function will prompt you for a file, | |
508 | defaulting to the file defined by variable bookmark-file." | |
509 | (interactive "P") | |
510 | (cond | |
511 | ((and (null parg) (null file)) | |
512 | ;;whether interactive or not, write to default file | |
513 | (bookmark-write-file bookmark-file)) | |
514 | ((and (null parg) file) | |
515 | ;;whether interactive or not, write to given file | |
516 | (bookmark-write-file file)) | |
517 | ((and parg (not file)) | |
518 | ;;have been called interactively w/ prefix arg | |
519 | (let ((file (read-file-name "File to save bookmarks in: "))) | |
520 | (bookmark-write-file file))) | |
521 | (t ; someone called us with prefix-arg *and* a file, so just write to file | |
522 | (bookmark-write-file file))) | |
523 | ;; signal that we have synced the bookmark file by setting this to | |
524 | ;; 0. If there was an error at any point before, it will not get | |
525 | ;; set, which is what we want. | |
526 | (setq bookmark-alist-modification-count 0)) | |
527 | ||
528 | (defun bookmark-write-file (file) | |
529 | (save-excursion | |
530 | (message (format "Saving bookmarks to file %s." file)) | |
531 | (set-buffer (find-file-noselect file)) | |
532 | (goto-char (point-min)) | |
533 | (delete-region (point-min) (point-max)) | |
534 | (print bookmark-alist (current-buffer)) | |
535 | (write-file file) | |
536 | (kill-buffer (current-buffer)))) | |
537 | ||
538 | (defun bookmark-load (file &optional revert no-msg) | |
539 | "Loads bookmarks from FILE, appending loaded bookmarks to the front | |
540 | of the list of bookmarks. If optional second argument REVERT is | |
541 | non-nil, existing bookmarks are destroyed. Optional third arg NO-MSG | |
542 | means don't display any messages while loading. | |
543 | ||
544 | If you load a file that doesn't contain a proper bookmark alist, you | |
545 | will corrupt Emacs\' bookmark list. Generally, you should only load | |
546 | in files that were created with the bookmark functions in the first | |
547 | place. If the bookmark alist does become corrupted, just delete all | |
548 | bookmarks and your master bookmark-file will be automatically loaded | |
549 | next time you try to go to a bookmark \(assuming that your bookmark | |
550 | file itself is not corrupt, this will solve the problem\)." | |
551 | (interactive | |
552 | (list (read-file-name | |
553 | (format "Load bookmarks from: (%s) " | |
554 | bookmark-file) | |
555 | ;;Default might not be used often, | |
556 | ;;but there's no better default, and | |
557 | ;;I guess it's better than none at all. | |
558 | "~/" bookmark-file 'confirm))) | |
559 | (setq file (expand-file-name file)) | |
560 | (if (file-readable-p file) | |
561 | (save-excursion | |
562 | (if (null no-msg) | |
563 | (message (format "Loading bookmarks from %s..." file))) | |
564 | (set-buffer (find-file-noselect file)) | |
565 | (goto-char (point-min)) | |
566 | (let ((blist (car (read-from-string | |
567 | (buffer-substring (point-min) (point-max)))))) | |
568 | (if (listp blist) | |
569 | (progn | |
570 | (if (not revert) | |
571 | (setq bookmark-alist-modification-count | |
572 | (1+ bookmark-alist-modification-count)) | |
573 | (setq bookmark-alist-modification-count 0)) | |
574 | (setq bookmark-alist | |
575 | (append blist (if (not revert) bookmark-alist)))) | |
576 | (error (format "Invalid bookmark list in %s." file)))) | |
577 | (kill-buffer (current-buffer)) | |
578 | (if (null no-msg) | |
579 | (message (format "Loading bookmarks from %s... done" file)))) | |
580 | (error (format "Cannot read bookmark file %s." file)))) | |
581 | ||
582 | ;;;; bookmark menu stuff ;;;; | |
583 | ||
584 | (defvar bookmark-enable-menus t | |
585 | "*Non-nil means put a bookmark menu on the menu bar \(assuming that | |
586 | you are running Emacs under a windowing system, such as X\).") | |
587 | ||
588 | (defvar bookmark-menu-length 70 "*Maximum length of a bookmark name | |
589 | displayed on a menu.") | |
590 | ||
591 | (defun bookmark-make-menu-alist () | |
592 | (if (not bookmark-alist) | |
593 | (if (file-readable-p bookmark-file) | |
594 | (bookmark-load bookmark-file))) | |
595 | (if bookmark-alist | |
596 | (mapcar (lambda (cell) | |
597 | (let ((str (car cell))) | |
598 | (cons | |
599 | (if (> (length str) bookmark-menu-length) | |
600 | (substring str 0 bookmark-menu-length) | |
601 | str) | |
602 | str))) | |
603 | bookmark-alist) | |
604 | (error "No bookmarks currently set."))) | |
605 | ||
606 | (defun bookmark-make-menu-with-function (func-sym menu-label menu-str event) | |
607 | ;; help function for making menus that need to apply a bookmark | |
608 | ;; function to a string. | |
609 | (let* ((menu (bookmark-make-menu-alist)) | |
610 | (str (x-popup-menu event | |
611 | (list menu-label | |
612 | (cons menu-str | |
613 | menu))))) | |
614 | (if str | |
615 | (apply func-sym (list str))))) | |
616 | ||
617 | (defun bookmark-menu-insert (event) | |
618 | "Insert the text of the file pointed to by bookmark BOOKMARK. You | |
619 | may have a problem using this function if the value of variable | |
620 | bookmark-alist is nil. If that happens, you need to load in some | |
621 | bookmarks. See help on function bookmark-load for more about this." | |
622 | (interactive "e") | |
623 | (bookmark-make-menu-with-function 'bookmark-insert | |
624 | "Bookmark Insert Menu" | |
625 | "--- Insert Contents ---" | |
626 | event)) | |
627 | ||
628 | (defun bookmark-menu-jump (event) | |
629 | "Go to the location saved in the bookmark BOOKMARK. You may have a | |
630 | problem using this function if the value of variable bookmark-alist | |
631 | is nil. If that happens, you need to load in some bookmarks. See | |
632 | help on function bookmark-load for more about this." | |
633 | (interactive "e") | |
634 | (bookmark-make-menu-with-function 'bookmark-jump | |
635 | "Bookmark Jump Menu" | |
636 | "--- Jump to Bookmark ---" | |
637 | event)) | |
638 | ||
639 | (defun bookmark-menu-locate (event) | |
640 | "Insert the name of the file associated with BOOKMARK \(as opposed | |
641 | to the contents of that file\)." | |
642 | (interactive "e") | |
643 | (bookmark-make-menu-with-function 'bookmark-locate | |
644 | "Bookmark Locate Menu" | |
645 | "--- Insert Location ---" | |
646 | event)) | |
647 | ||
648 | (defun bookmark-menu-rename (event) | |
649 | "Change the name of BOOKMARK to NEWNAME. While you are entering | |
650 | the new name, consecutive C-w\'s will insert consectutive words from | |
651 | the text of the buffer into the new bookmark name, and C-v will insert | |
652 | the name of the file." | |
653 | (interactive "e") | |
654 | (bookmark-make-menu-with-function 'bookmark-rename | |
655 | "Bookmark Rename Menu" | |
656 | "--- Rename Bookmark ---" | |
657 | event)) | |
658 | ||
659 | (defun bookmark-menu-delete (event) | |
660 | "Delete the bookmark named NAME from the bookmark list. Removes only | |
661 | the first instance of a bookmark with that name. If there is another | |
662 | bookmark with the same name, it will become \"current\" as soon as the | |
663 | old one is removed from the bookmark list." | |
664 | (interactive "e") | |
665 | (bookmark-make-menu-with-function 'bookmark-delete | |
666 | "Bookmark Delete Menu" | |
667 | "--- Delete Bookmark ---" | |
668 | event)) | |
669 | ||
670 | (defun bookmark-menu-delete-all () | |
671 | (interactive) | |
672 | (let ((current-prefix-arg t)) | |
673 | (bookmark-delete nil))) | |
674 | ||
675 | (if (and bookmark-enable-menus window-system) | |
676 | (progn | |
677 | (defvar menu-bar-bookmark-map | |
678 | (make-sparse-keymap "Bookmark functions")) | |
679 | ||
680 | ;; make bookmarks appear toward the right side of the menu. | |
681 | (if (boundp 'menu-bar-final-items) | |
682 | (if menu-bar-final-items | |
683 | (setq menu-bar-final-items | |
684 | (cons 'bookmark menu-bar-final-items))) | |
685 | (setq menu-bar-final-items '(bookmark))) | |
686 | ||
687 | (define-key global-map [menu-bar bookmark] | |
688 | (cons "Bookmarks" menu-bar-bookmark-map)) | |
689 | ||
690 | (define-key menu-bar-bookmark-map [load] | |
691 | '(" Load a bookmark file" . bookmark-load)) | |
692 | ||
693 | (define-key menu-bar-bookmark-map [write] | |
694 | '("Write \(to another file\)" . bookmark-write)) | |
695 | ||
696 | (define-key menu-bar-bookmark-map [save] | |
697 | '("Save \(in default file\)" . bookmark-save)) | |
698 | ||
699 | (define-key menu-bar-bookmark-map [delete-all] | |
700 | '(" Delete all bookmarks" . bookmark-menu-delete-all)) | |
701 | ||
702 | (define-key menu-bar-bookmark-map [delete] | |
703 | '(" Delete a bookmark" . bookmark-menu-delete)) | |
704 | ||
705 | (define-key menu-bar-bookmark-map [rename] | |
706 | '(" Rename bookmark" . bookmark-menu-rename)) | |
707 | ||
708 | (define-key menu-bar-bookmark-map [locate] | |
709 | '(" Insert location" . bookmark-menu-locate)) | |
710 | ||
711 | (define-key menu-bar-bookmark-map [insert] | |
712 | '(" Insert contents" . bookmark-menu-insert)) | |
713 | ||
714 | (define-key menu-bar-bookmark-map [set] | |
715 | '(" Set bookmark" . bookmark-set)) | |
716 | ||
717 | (define-key menu-bar-bookmark-map [jump] | |
718 | '(" Go to bookmark" . bookmark-menu-jump)))) | |
719 | ||
720 | ;; not using properties because they make the menu sluggish in coming | |
721 | ;; up -- too many tests to make. Instead, choosing a useless menu | |
722 | ;; item just gets you an error now (see | |
723 | ;; bookmark-make-menu-with-function) | |
724 | ;; | |
725 | ;; (put 'bookmark-menu-jump 'menu-enable | |
726 | ;; '(or bookmark-alist | |
727 | ;; (and (file-readable-p bookmark-file) | |
728 | ;; (progn (bookmark-load bookmark-file) | |
729 | ;; bookmark-alist)))) | |
730 | ;; | |
731 | ;; (put 'bookmark-menu-insert 'menu-enable | |
732 | ;; '(or bookmark-alist | |
733 | ;; (and (file-readable-p bookmark-file) | |
734 | ;; (progn (bookmark-load bookmark-file) | |
735 | ;; bookmark-alist)))) | |
736 | ;; | |
737 | ;; (put 'bookmark-menu-locate 'menu-enable | |
738 | ;; '(or bookmark-alist | |
739 | ;; (and (file-readable-p bookmark-file) | |
740 | ;; (progn (bookmark-load bookmark-file) | |
741 | ;; bookmark-alist)))) | |
742 | ;; | |
743 | ;; (put 'bookmark-menu-rename 'menu-enable | |
744 | ;; '(or bookmark-alist | |
745 | ;; (and (file-readable-p bookmark-file) | |
746 | ;; (progn (bookmark-load bookmark-file) | |
747 | ;; bookmark-alist)))) | |
748 | ;; | |
749 | ;; (put 'bookmark-menu-delete 'menu-enable | |
750 | ;; '(or bookmark-alist | |
751 | ;; (and (file-readable-p bookmark-file) | |
752 | ;; (progn (bookmark-load bookmark-file) | |
753 | ;; bookmark-alist)))) | |
754 | ;; | |
755 | ;; (put 'bookmark-menu-save 'menu-enable | |
756 | ;; '(or bookmark-alist | |
757 | ;; (and (file-readable-p bookmark-file) | |
758 | ;; (progn (bookmark-load bookmark-file) | |
759 | ;; bookmark-alist)))) | |
760 | ;; | |
761 | ;; (put 'bookmark-menu-write 'menu-enable | |
762 | ;; '(or bookmark-alist | |
763 | ;; (and (file-readable-p bookmark-file) | |
764 | ;; (progn (bookmark-load bookmark-file) | |
765 | ;; bookmark-alist)))) | |
766 | ||
767 | ;;;; end bookmark menu stuff ;;;; | |
768 | ||
769 | ;; load the default bookmark file, if it exists, and the | |
770 | ;; bookmark-alist is nil: | |
771 | (bookmark-try-default-file) | |
772 | ||
773 | ||
774 | (provide 'bookmark) | |
775 | ||
776 | ;;; bookmark.el ends here ;;; |