New org capture template
[emacs.git] / .emacs.d / elisp / icicle / bookmark+-lit.el
1 ;;; bookmark+-lit.el --- Bookmark highlighting for Bookmark+.
2 ;;
3 ;; Filename: bookmark+-lit.el
4 ;; Description: Bookmark highlighting for Bookmark+.
5 ;; Author: Drew Adams
6 ;; Maintainer: Drew Adams
7 ;; Copyright (C) 2010-2112, Drew Adams, all rights reserved.
8 ;; Created: Wed Jun 23 07:49:32 2010 (-0700)
9 ;; Last-Updated: Sat Apr 28 16:41:38 2012 (-0700)
10 ;; By: dradams
11 ;; Update #: 779
12 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/bookmark+-lit.el
13 ;; Keywords: bookmarks, highlighting, bookmark+
14 ;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x
15 ;;
16 ;; Features that might be required by this library:
17 ;;
18 ;; `bookmark', `pp', `pp+'.
19 ;;
20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
21 ;;
22 ;;; Commentary:
23 ;;
24 ;; Bookmark highlighting for Bookmark+ (library `bookmark+.el').
25 ;;
26 ;; The Bookmark+ libraries are:
27 ;;
28 ;; `bookmark+.el' - main code library
29 ;; `bookmark+-mac.el' - Lisp macros
30 ;; `bookmark+-lit.el' - code for highlighting bookmarks (this file)
31 ;; `bookmark+-bmu.el' - code for the `*Bookmark List*'
32 ;; `bookmark+-1.el' - other required code (non-bmenu)
33 ;; `bookmark+-key.el' - key and menu bindings
34 ;;
35 ;; `bookmark+-doc.el' - documentation (comment-only file)
36 ;; `bookmark+-chg.el' - change log (comment-only file)
37 ;;
38 ;; This library (`bookmark+-lit.el') is a Bookmark+ option. If you
39 ;; want to use it then load it before loading `bookmark+.el', so
40 ;; that its commands can be bound to keys and menu items.
41 ;;
42 ;; The documentation (in `bookmark+-doc.el') includes how to
43 ;; byte-compile and install Bookmark+. The documentation is also
44 ;; available in these ways:
45 ;;
46 ;; 1. From the bookmark list (`C-x r l'):
47 ;; Use `?' to show the current bookmark-list status and general
48 ;; help, then click link `Doc in Commentary' or link `Doc on the
49 ;; Web'.
50 ;;
51 ;; 2. From the Emacs-Wiki Web site:
52 ;; http://www.emacswiki.org/cgi-bin/wiki/BookmarkPlus.
53 ;;
54 ;; 3. From the Bookmark+ group customization buffer:
55 ;; `M-x customize-group bookmark-plus', then click link
56 ;; `Commentary'.
57 ;;
58 ;; (The commentary links in #1 and #3 work only if you have library
59 ;; `bookmark+-doc.el' in your `load-path'.)
60
61 ;;(@> "Index")
62 ;;
63 ;; Index
64 ;; -----
65 ;;
66 ;; If you have library `linkd.el' and Emacs 22 or later, load
67 ;; `linkd.el' and turn on `linkd-mode' now. It lets you easily
68 ;; navigate around the sections of this doc. Linkd mode will
69 ;; highlight this Index, as well as the cross-references and section
70 ;; headings throughout this file. You can get `linkd.el' here:
71 ;; http://dto.freeshell.org/notebook/Linkd.html.
72 ;;
73 ;; (@> "Things Defined Here")
74 ;; (@> "Faces (Customizable)")
75 ;; (@> "User Options (Customizable)")
76 ;; (@> "Internal Variables")
77 ;; (@> "Functions")
78 ;; (@> "Menu-List (`*-bmenu-*') Commands")
79 ;; (@> "General Highlight Commands")
80 ;; (@> "Other Functions")
81
82 ;;(@* "Things Defined Here")
83 ;;
84 ;; Things Defined Here
85 ;; -------------------
86 ;;
87 ;; Commands defined here:
88 ;;
89 ;;
90 ;; `bmkp-bmenu-light', `bmkp-bmenu-light-marked',
91 ;; `bmkp-bmenu-set-lighting', `bmkp-bmenu-set-lighting-for-marked',
92 ;; `bmkp-bmenu-show-only-lighted', `bmkp-bmenu-unlight',
93 ;; `bmkp-bmenu-unlight-marked', `bmkp-bookmarks-lighted-at-point',
94 ;; `bmkp-cycle-lighted-this-buffer',
95 ;; `bmkp-cycle-lighted-this-buffer-other-window',
96 ;; `bmkp-light-autonamed-this-buffer', `bmkp-light-bookmark',
97 ;; `bmkp-light-bookmark-this-buffer', `bmkp-light-bookmarks',
98 ;; `bmkp-light-bookmarks-in-region',
99 ;; `bmkp-light-navlist-bookmarks',
100 ;; `bmkp-light-non-autonamed-this-buffer',
101 ;; `bmkp-light-this-buffer', `bmkp-lighted-jump',
102 ;; `bmkp-lighted-jump-other-window',
103 ;; `bmkp-next-lighted-this-buffer',
104 ;; `bmkp-next-lighted-this-buffer-repeat',
105 ;; `bmkp-previous-lighted-this-buffer',
106 ;; `bmkp-previous-lighted-this-buffer-repeat',
107 ;; `bmkp-set-lighting-for-bookmark',
108 ;; `bmkp-set-lighting-for-buffer',
109 ;; `bmkp-set-lighting-for-this-buffer',
110 ;; `bmkp-unlight-autonamed-this-buffer', `bmkp-unlight-bookmark',
111 ;; `bmkp-unlight-bookmark-here',
112 ;; `bmkp-unlight-bookmark-this-buffer', `bmkp-unlight-bookmarks',
113 ;; `bmkp-unlight-non-autonamed-this-buffer',
114 ;; `bmkp-unlight-this-buffer'.
115 ;;
116 ;; User options defined here:
117 ;;
118 ;; `bmkp-auto-light-relocate-when-jump-flag',
119 ;; `bmkp-auto-light-when-jump', `bmkp-auto-light-when-set',
120 ;; `bmkp-light-left-fringe-bitmap' (Emacs 22+),
121 ;; `bmkp-light-priorities', `bmkp-light-right-fringe-bitmap' (Emacs
122 ;; 22+), `bmkp-light-style-autonamed',
123 ;; `bmkp-light-style-non-autonamed', `bmkp-light-threshold'.
124 ;;
125 ;; Faces defined here:
126 ;;
127 ;; `bmkp-light-autonamed', `bmkp-light-fringe-autonamed' (Emacs
128 ;; 22+), `bmkp-light-fringe-non-autonamed' (Emacs 22+),
129 ;; `bmkp-light-mark', `bmkp-light-non-autonamed'.
130 ;;
131 ;; Non-interactive functions defined here:
132 ;;
133 ;; `bmkp-a-bookmark-lighted-at-pos',
134 ;; `bmkp-a-bookmark-lighted-on-this-line',
135 ;; `bmkp-bookmark-overlay-p', `bmkp-default-lighted',
136 ;; `bmkp-fringe-string' (Emacs 22+), `bmkp-get-lighting',
137 ;; `bmkp-lighted-p', `bmkp-light-face', `bmkp-light-style',
138 ;; `bmkp-light-style-choices', `bmkp-light-when',
139 ;; `bmkp-lighted-alist-only', `bmkp-lighting-attribute',
140 ;; `bmkp-lighting-face', `bmkp-lighting-style',
141 ;; `bmkp-lighting-when', `bmkp-make/move-fringe' (Emacs 22+),
142 ;; `bmkp-make/move-overlay-of-style', `bmkp-number-lighted',
143 ;; `bmkp-overlay-of-bookmark', `bmkp-read-set-lighting-args',
144 ;; `bmkp-set-lighting-for-bookmarks',
145 ;; `bmkp-this-buffer-lighted-alist-only'.
146 ;;
147 ;; Internal variables defined here:
148 ;;
149 ;; `bmkp-autonamed-overlays', `bmkp-light-styles-alist',
150 ;; `bmkp-non-autonamed-overlays'.
151 ;;
152 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
153 ;;
154 ;; This program is free software; you can redistribute it and/or
155 ;; modify it under the terms of the GNU General Public License as
156 ;; published by the Free Software Foundation; either version 3, or
157 ;; (at your option) any later version.
158 ;;
159 ;; This program is distributed in the hope that it will be useful,
160 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
161 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
162 ;; General Public License for more details.
163 ;;
164 ;; You should have received a copy of the GNU General Public License
165 ;; along with this program; see the file COPYING. If not, write to
166 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
167 ;; Floor, Boston, MA 02110-1301, USA.
168 ;;
169 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
170 ;;
171 ;;; Code:
172
173 ;;;;;;;;;;;;;;;;;;;;;;;
174
175 (eval-when-compile (require 'cl)) ;; case
176
177 (require 'bookmark)
178 ;; bookmark-alist, bookmark-bmenu-bookmark, bookmark-completing-read,
179 ;; bookmark-get-bookmark, bookmark-get-position,
180 ;; bookmark-handle-bookmark, bookmark-maybe-load-default-file,
181 ;; bookmark-name-from-full-record, bookmark-name-from-record, bookmark-prop-get,
182 ;; bookmark-prop-set
183
184
185 ;; Some general Renamings.
186 ;;
187 ;; 1. Fix incompatibility introduced by gratuitous Emacs name change.
188 ;;
189 (cond ((and (fboundp 'bookmark-name-from-record) (not (fboundp 'bookmark-name-from-full-record)))
190 (defalias 'bookmark-name-from-full-record 'bookmark-name-from-record))
191 ((and (fboundp 'bookmark-name-from-full-record) (not (fboundp 'bookmark-name-from-record)))
192 (defalias 'bookmark-name-from-record 'bookmark-name-from-full-record)))
193
194 ;; 2. The vanilla name of the first is misleading, as it returns only the cdr of the record.
195 ;; The second is for consistency.
196 ;;
197 (defalias 'bmkp-bookmark-data-from-record 'bookmark-get-bookmark-record)
198 (defalias 'bmkp-bookmark-name-from-record 'bookmark-name-from-full-record)
199
200
201 ;; (eval-when-compile (require 'bookmark+-bmu))
202 ;; bmkp-bmenu-barf-if-not-in-menu-list, bmkp-bmenu-filter-function,
203 ;; bmkp-bmenu-title
204
205 ;; (eval-when-compile (require 'bookmark+-1))
206 ;; bmkp-autonamed-bookmark-p, bmkp-autonamed-this-buffer-alist-only,
207 ;; bmkp-autoname-format, bmkp-current-nav-bookmark,
208 ;; bmkp-current-sort-order, bmkp-cycle-1, bmkp-default-bookmark-name,
209 ;; bmkp-function-bookmark-p, bmkp-get-bookmark-in-alist, bmkp-get-buffer-name, bmkp-jump-1,
210 ;; bmkp-latest-bookmark-alist, bmkp-marked-bookmarks-only,
211 ;; bmkp-msg-about-sort-order, bmkp-nav-alist, bmkp-refresh-menu-list,
212 ;; bmkp-remove-if, bmkp-remove-if-not, bmkp-repeat-command,
213 ;; bmkp-sequence-bookmark-p, bmkp-sort-omit,
214 ;; bmkp-specific-buffers-alist-only, bmkp-this-buffer-alist-only,
215 ;; bmkp-this-file/buffer-cycle-sort-comparer, bmkp-this-buffer-p
216
217 (require 'pp+ nil t) ;; pp-read-expression-map
218
219 ;;;;;;;;;;;;;;;;;;;;;;;
220
221 ;; Quiet the byte-compiler
222 (defvar bmkp-light-left-fringe-bitmap) ; Defined in this file for Emacs 22+.
223 (defvar bmkp-light-right-fringe-bitmap) ; Defined in this file for Emacs 22+.
224 (defvar fringe-bitmaps) ; Built-in for Emacs 22+.
225
226
227 ;;(@* "Faces (Customizable)")
228 ;;; Faces (Customizable) ---------------------------------------------
229
230 (defface bmkp-light-autonamed
231 '((((background dark)) (:background "#00004AA652F1")) ; a dark cyan
232 (t (:background "misty rose"))) ; a light pink
233 "*Face used to highlight an autonamed bookmark (except in the fringe)."
234 :group 'bookmark-plus :group 'faces)
235
236 (when (fboundp 'fringe-columns)
237 (defface bmkp-light-fringe-autonamed
238 '((((background dark)) (:background "#B19E6A64B19E")) ; a dark magenta
239 (t (:background "#691DC8A2691D"))) ; a medium green
240 "*Face used to highlight an autonamed bookmark in the fringe."
241 :group 'bookmark-plus :group 'faces)
242 (defface bmkp-light-fringe-non-autonamed
243 '((((background dark)) (:background "#691DC8A2691D")) ; a medium green
244 (t (:foreground "Black" :background "Plum"))) ; a light magenta
245 "*Face used to highlight a non-autonamed bookmark in the fringe."
246 :group 'bookmark-plus :group 'faces))
247
248 (defface bmkp-light-mark '((t (:background "Plum")))
249 "*Face used to mark highlighted bookmarks in the bookmark list.
250 This face must be combinable with face `bmkp-t-mark'."
251 :group 'bookmark-plus :group 'faces)
252
253 (defface bmkp-light-non-autonamed
254 '((((background dark)) (:background "#B19E6A64B19E")) ; a dark magenta
255 (t (:background "DarkSeaGreen1"))) ; a light green
256 "*Face used to highlight a non-autonamed bookmark (except in the fringe)."
257 :group 'bookmark-plus :group 'faces)
258
259 ;;(@* "User Options (Customizable)")
260 ;;; User Options (Customizable) --------------------------------------
261
262 ;;;###autoload
263 (defcustom bmkp-auto-light-relocate-when-jump-flag t
264 "*Non-nil means highlight the relocated, instead of the recorded, position.
265 This has an effect only when the highlighting style for the bookmark
266 is `point'."
267 :type 'boolean :group 'bookmark-plus)
268
269 ;;;###autoload
270 (defcustom bmkp-auto-light-when-jump nil
271 "*Which bookmarks to automatically highlight when jumped to.
272 NOTE: The values that specify highlighting in the current buffer
273 highlight bookmarks in the buffer that is current after jumping. If
274 the bookmark does not really have an associated buffer, for example a
275 bookmark with a handler such as `w32-browser' that just invokes a
276 separate, non-Emacs program, then the current buffer after jumping
277 will be the buffer before jumping."
278 :type '(choice
279 (const :tag "Autonamed bookmark" autonamed-bookmark)
280 (const :tag "Non-autonamed bookmark" non-autonamed-bookmark)
281 (const :tag "Any bookmark" any-bookmark)
282 (const :tag "Autonamed bookmarks in buffer" autonamed-in-buffer)
283 (const :tag "Non-autonamed bookmarks in buffer" non-autonamed-in-buffer)
284 (const :tag "All bookmarks in buffer" all-in-buffer)
285 (const :tag "None (no automatic highlighting)" nil))
286 :group 'bookmark-plus)
287
288 ;;;###autoload
289 (defcustom bmkp-auto-light-when-set nil
290 "*Which bookmarks to automatically highlight when set."
291 :type '(choice
292 (const :tag "Autonamed bookmark" autonamed-bookmark)
293 (const :tag "Non-autonamed bookmark" non-autonamed-bookmark)
294 (const :tag "Any bookmark" any-bookmark)
295 (const :tag "Autonamed bookmarks in buffer" autonamed-in-buffer)
296 (const :tag "Non-autonamed bookmarks in buffer" non-autonamed-in-buffer)
297 (const :tag "All bookmarks in buffer" all-in-buffer)
298 (const :tag "None (no automatic highlighting)" nil))
299 :group 'bookmark-plus)
300
301 ;;;###autoload
302 (defcustom bmkp-light-priorities '((bmkp-autonamed-overlays . 160)
303 (bmkp-non-autonamed-overlays . 150))
304 "*Priorities of bookmark highlighting overlay types.
305 As an idea, `ediff' uses 100+, `isearch' uses 1001."
306 :group 'bookmark-plus :type '(alist :key-type symbol :value-type integer))
307
308 ;; Not used for Emacs 20-21.
309 (when (fboundp 'fringe-columns)
310 (defcustom bmkp-light-left-fringe-bitmap 'left-triangle
311 "*Symbol for the left fringe bitmap to use to highlight a bookmark.
312 This option is not used for Emacs versions before Emacs 22."
313 :type (cons 'choice (mapcar (lambda (bb) (list 'const bb)) fringe-bitmaps))
314 :group 'bookmark-plus)
315
316 ;; Not used for Emacs 20-21.
317 (defcustom bmkp-light-right-fringe-bitmap 'right-triangle
318 "*Symbol for the right fringe bitmap to use to highlight a bookmark.
319 This option is not used for Emacs versions before Emacs 22."
320 :type (cons 'choice (mapcar (lambda (bb) (list 'const bb)) fringe-bitmaps))
321 :group 'bookmark-plus))
322
323 ;; Must be before any options that use it.
324 (defvar bmkp-light-styles-alist (append '(("Line Beginning" . bol)
325 ("Position" . point)
326 ("Line" . line)
327 ("None" . none))
328 (and (fboundp 'fringe-columns)
329 '(("Left Fringe" . lfringe)
330 ("Right Fringe" . rfringe)
331 ("Left Fringe + Line" . line+lfringe)
332 ("Right Fringe + Line" . line+rfringe))))
333 "Alist of highlighting styles. Key: string description. Value: symbol.")
334
335 ;; Must be before options that use it.
336 (defun bmkp-light-style-choices ()
337 "Return custom `:type' used for bookmark highlighting style choices."
338 (cons 'choice
339 (mapcar (lambda (xx) (list 'const :tag (car xx) (cdr xx))) bmkp-light-styles-alist)))
340
341 ;;;###autoload
342 (defcustom bmkp-light-style-autonamed (if (not (fboundp 'fringe-columns)) ; Emacs 20-21.
343 'line
344 'line+lfringe)
345 "*Default highlight style for autonamed bookmarks."
346 :group 'bookmark-plus :type (bmkp-light-style-choices))
347
348 ;;;###autoload
349 (defcustom bmkp-light-style-non-autonamed (if (not (fboundp 'fringe-columns)) ; Emacs 20-21.
350 'line
351 'line+rfringe)
352 "*Default highlight style for non-autonamed bookmarks."
353 :group 'bookmark-plus :type (bmkp-light-style-choices))
354
355 ;;;###autoload
356 (defcustom bmkp-light-threshold 100000
357 "*Maximum number of bookmarks to highlight."
358 :type 'integer :group 'bookmark-plus)
359
360 ;;(@* "Internal Variables")
361 ;;; Internal Variables -----------------------------------------------
362
363 (defvar bmkp-autonamed-overlays nil
364 "Overlays used to highlight autonamed bookmarks.")
365
366 (defvar bmkp-non-autonamed-overlays nil
367 "Overlays used to highlight non-autonamed bookmarks.")
368
369 ;;(@* "Functions")
370 ;;; Functions --------------------------------------------------------
371
372
373 ;;(@* "Menu-List (`*-bmenu-*') Commands")
374 ;; *** Menu-List (`*-bmenu-*') Commands ***
375
376 ;;;###autoload
377 (defun bmkp-bmenu-show-only-lighted () ; `H S' in bookmark list
378 "Display a list of highlighted bookmarks (only)."
379 (interactive)
380 (bmkp-bmenu-barf-if-not-in-menu-list)
381 (setq bmkp-bmenu-filter-function 'bmkp-lighted-alist-only
382 bmkp-bmenu-title "Highlighted Bookmarks")
383 (let ((bookmark-alist (funcall bmkp-bmenu-filter-function)))
384 (setq bmkp-latest-bookmark-alist bookmark-alist)
385 (bookmark-bmenu-list 'filteredp))
386 (when (interactive-p)
387 (bmkp-msg-about-sort-order (bmkp-current-sort-order) "Only highlighted bookmarks are shown")))
388
389 ;;;###autoload
390 (defun bmkp-bmenu-light () ; `H H' in bookmark list
391 "Highlight the location of this line's bookmark."
392 (interactive)
393 (bmkp-bmenu-barf-if-not-in-menu-list)
394 (bmkp-light-bookmark (bookmark-bmenu-bookmark) nil nil 'MSG))
395
396 ;;;###autoload
397 (defun bmkp-bmenu-light-marked (&optional parg msgp) ; `H > H' in bookmark list
398 "Highlight the marked bookmarks."
399 (interactive (list 'MSG))
400 (bmkp-bmenu-barf-if-not-in-menu-list)
401 (when msgp (message "Highlighting marked bookmarks..."))
402 (let ((marked (bmkp-marked-bookmarks-only)))
403 (unless marked (error "No marked bookmarks"))
404 (dolist (bmk marked) (bmkp-light-bookmark bmk)))
405 (when msgp (message "Highlighting marked bookmarks...done")))
406
407 ;;;###autoload
408 (defun bmkp-bmenu-unlight () ; `H U' in bookmark list
409 "Unhighlight the location of this line's bookmark."
410 (interactive)
411 (bmkp-bmenu-barf-if-not-in-menu-list)
412 (bmkp-unlight-bookmark (bookmark-bmenu-bookmark) 'NOERROR))
413
414 ;;;###autoload
415 (defun bmkp-bmenu-unlight-marked (&optional parg msgp) ; `H > U' in bookmark list
416 "Unhighlight the marked bookmarks."
417 (interactive (list 'MSG))
418 (bmkp-bmenu-barf-if-not-in-menu-list)
419 (when msgp (message "Unhighlighting marked bookmarks..."))
420 (let ((marked (bmkp-marked-bookmarks-only)))
421 (unless marked (error "No marked bookmarks"))
422 (dolist (bmk marked) (bmkp-unlight-bookmark bmk t)))
423 (when msgp (message "Unhighlighting marked bookmarks...done")))
424
425 ;;;###autoload
426 (defun bmkp-bmenu-set-lighting (style face when &optional msgp) ; `H +' in bookmark list
427 "Set the `lighting' property for this line's bookmark.
428 You are prompted for the highlight style, face, and condition (when)."
429 (interactive
430 (let* ((bmk (bookmark-bmenu-bookmark))
431 (bmk-style (bmkp-lighting-style bmk))
432 (bmk-face (bmkp-lighting-face bmk))
433 (bmk-when (bmkp-lighting-when bmk)))
434 (append (bmkp-read-set-lighting-args
435 (and bmk-style (format "%s" (car (rassq bmk-style bmkp-light-styles-alist))))
436 (and bmk-face (format "%S" bmk-face))
437 (and bmk-when (format "%S" bmk-when)))
438 '(MSG))))
439 (bmkp-bmenu-barf-if-not-in-menu-list)
440 (bmkp-set-lighting-for-bookmark (bookmark-bmenu-bookmark) style face when 'MSG))
441
442 ;;;###autoload
443 (defun bmkp-bmenu-set-lighting-for-marked (style face when &optional msgp) ; `H > +' in bookmark list
444 "Set the `lighting' property for the marked bookmarks.
445 You are prompted for the highlight style, face, and condition (when)."
446 (interactive (append (bmkp-read-set-lighting-args) '(MSG)))
447 (bmkp-bmenu-barf-if-not-in-menu-list)
448 (when msgp (message "Setting highlighting..."))
449 (let ((marked (bmkp-marked-bookmarks-only))
450 (curr-bmk (bookmark-bmenu-bookmark)))
451 (unless marked (error "No marked bookmarks"))
452 (dolist (bmk marked)
453 (if (or face style when)
454 (bookmark-prop-set bmk 'lighting
455 `(,@(and face (not (eq face 'auto)) `(:face ,face))
456 ,@(and style (not (eq style 'none)) `(:style ,style))
457 ,@(and when (not (eq when 'auto)) `(:when ,when))))
458 (bookmark-prop-set bmk 'lighting nil)))
459 (when (get-buffer-create "*Bookmark List*") (bmkp-refresh-menu-list curr-bmk)))
460 (when msgp (message "Setting highlighting...done")))
461
462
463 ;;(@* "General Highlight Commands")
464 ;; *** General Highlight Commands ***
465
466 ;;;###autoload
467 (defun bmkp-bookmarks-lighted-at-point (&optional position fullp msgp) ; `C-x p ='
468 "Return a list of the bookmarks highlighted at point.
469 Include only those in the current bookmark list (`bookmark-alist').
470 With no prefix arg, return the bookmark names.
471 With a prefix arg, return the full bookmark data.
472 Interactively, display the info.
473 Non-interactively:
474 Use the bookmarks at optional arg POSITION (default: point).
475 Optional arg FULLP means return full bookmark data.
476 Optional arg MSGP means display the info."
477 (interactive (list (point) current-prefix-arg 'MSG))
478 (unless position (setq position (point)))
479 (let ((bmks ())
480 bmk)
481 (dolist (ov (overlays-at position))
482 (when (setq bmk (overlay-get ov 'bookmark))
483 (when (setq bmk (bmkp-get-bookmark-in-alist bmk 'NOERROR)) ; Ensure it's in current bookmark list.
484 (push (if fullp bmk (bmkp-bookmark-name-from-record bmk)) bmks))))
485 (if (not fullp)
486 (when msgp (message "%s" bmks))
487 (setq bmks (mapcar #'bookmark-get-bookmark bmks))
488 (when msgp (pp-eval-expression 'bmks)))
489 bmks))
490
491 ;;;###autoload
492 (defun bmkp-lighted-jump (bookmark-name &optional use-region-p) ; `C-x j h'
493 "Jump to a highlighted bookmark.
494 This is a specialization of `bookmark-jump' - see that, in particular
495 for info about using a prefix argument."
496 (interactive
497 (let ((alist (bmkp-lighted-alist-only)))
498 (unless alist (error "No highlighted bookmarks"))
499 (list (bookmark-completing-read "Jump to highlighted bookmark" nil alist) current-prefix-arg)))
500 (bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
501
502 ;;;###autoload
503 (defun bmkp-lighted-jump-other-window (bookmark-name &optional use-region-p) ; `C-x 4 j h'
504 "Jump to a highlighted bookmark in another window.
505 See `bmkp-lighted-jump'."
506 (interactive
507 (let ((alist (bmkp-lighted-alist-only)))
508 (unless alist (error "No highlighted bookmarks"))
509 (list (bookmark-completing-read "Jump to highlighted bookmark in another window" nil alist)
510 current-prefix-arg)))
511 (bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
512
513 ;;;###autoload
514 (defun bmkp-unlight-bookmark (bookmark &optional noerrorp msgp)
515 "Unhighlight BOOKMARK.
516 BOOKMARK is a bookmark name or a bookmark record."
517 (interactive
518 (let ((lighted-bmks (bmkp-lighted-alist-only)))
519 (unless lighted-bmks (error "No highlighted bookmarks"))
520 (list (bookmark-completing-read "UNhighlight bookmark" (bmkp-default-lighted) lighted-bmks)
521 nil
522 'MSG)))
523 (let* ((bmk (bookmark-get-bookmark bookmark 'NOERROR))
524 (bmk-name (bmkp-bookmark-name-from-record bmk))
525 (autonamedp (and bmk (bmkp-autonamed-bookmark-p bmk))))
526 (when bmk ; Skip bad bookmark, but not already highlighted bookmark.
527 (unless (or noerrorp (bmkp-lighted-p bmk-name))
528 (error "Bookmark `%s' is not highlighted" bmk-name))
529 (dolist (ov (if autonamedp bmkp-autonamed-overlays bmkp-non-autonamed-overlays))
530 (when (equal bmk-name (overlay-get ov 'bookmark)) (delete-overlay ov))))
531 (when msgp (message "UNhighlighted bookmark `%s'" bmk-name))))
532
533 ;;;###autoload
534 (defun bmkp-unlight-bookmark-here (&optional noerrorp msgp) ; `C-x p C-u'
535 "Unhighlight a bookmark at point or the same line (in that order)."
536 (interactive (list nil 'MSG))
537 (let ((bmk (or (bmkp-a-bookmark-lighted-at-pos) (bmkp-a-bookmark-lighted-on-this-line))))
538 (unless bmk (error "No highlighted bookmark on this line"))
539 (bmkp-unlight-bookmark bmk noerrorp msgp)))
540
541 ;;;###autoload
542 (defun bmkp-unlight-bookmark-this-buffer (bookmark &optional noerrorp msgp) ; `C-x p u'
543 "Unhighlight a BOOKMARK in this buffer.
544 BOOKMARK is a bookmark name or a bookmark record.
545 With a prefix arg, choose from all bookmarks, not just those in this
546 buffer."
547 (interactive
548 (let ((lighted-bmks (if current-prefix-arg
549 (bmkp-lighted-alist-only)
550 (bmkp-this-buffer-lighted-alist-only)))
551 (msg-suffix (if current-prefix-arg "" " in this buffer")))
552 (unless lighted-bmks (error "No highlighted bookmarks%s" msg-suffix))
553 (list (bookmark-completing-read (format "UNhighlight bookmark%s in this buffer" msg-suffix)
554 (bmkp-default-lighted)
555 lighted-bmks)
556 nil
557 'MSG)))
558 (bmkp-unlight-bookmark bookmark noerrorp msgp))
559
560 ;;;###autoload
561 (defun bmkp-unlight-bookmarks (&optional overlays-symbols this-buffer-p msgp) ; `C-x p U'
562 "Unhighlight bookmarks.
563 A prefix argument determines which bookmarks to unhighlight:
564 none - Current buffer, all bookmarks.
565 >= 0 - Current buffer, autonamed bookmarks only.
566 < 0 - Current buffer, non-autonamed bookmarks only.
567 C-u - All buffers (all bookmarks)."
568 (interactive (list (cond ((or (not current-prefix-arg) (consp current-prefix-arg))
569 '(bmkp-autonamed-overlays bmkp-non-autonamed-overlays))
570 ((natnump current-prefix-arg) '(bmkp-autonamed-overlays))
571 (current-prefix-arg '(bmkp-non-autonamed-overlays)))
572 (or (not current-prefix-arg) (atom current-prefix-arg))
573 'MSG))
574 (unless overlays-symbols
575 (setq overlays-symbols '(bmkp-autonamed-overlays bmkp-non-autonamed-overlays)))
576 (let ((count 0)
577 (count-auto 0)
578 (count-non-auto 0)
579 (this-buf (current-buffer)))
580 (dolist (ov-symb overlays-symbols)
581 (dolist (ov (symbol-value ov-symb))
582 (let ((ov-buf (overlay-buffer ov)))
583 (when (and ov-buf (or (not this-buffer-p) (eq ov-buf this-buf)))
584 (when (eq 'bmkp-autonamed-overlays ov-symb)
585 (setq count-auto (1+ count-auto)
586 count (1+ count)))
587 (when (eq 'bmkp-non-autonamed-overlays ov-symb)
588 (setq count-non-auto (1+ count-non-auto)
589 count (1+ count)))
590 (delete-overlay ov)))))
591 (when msgp (message "UNhighlighted %d bookmarks %s: %d autonamed, %d other"
592 count (if this-buffer-p "in this buffer" "(all buffers)")
593 count-auto count-non-auto))))
594
595 ;;;###autoload
596 (defun bmkp-unlight-autonamed-this-buffer (&optional everywherep)
597 "Unhighlight autonamed bookmarks.
598 No prefix arg: unhighlight them only in the current buffer.
599 Prefix arg, unhighlight them everywhere."
600 (interactive "P")
601 (bmkp-unlight-bookmarks '(bmkp-autonamed-overlays) (not everywherep)))
602
603 ;;;###autoload
604 (defun bmkp-unlight-non-autonamed-this-buffer (&optional everywherep)
605 "Unhighlight non-autonamed bookmarks.
606 No prefix arg: unhighlight them only in the current buffer.
607 Prefix arg, unhighlight them everywhere."
608 (interactive "P")
609 (bmkp-unlight-bookmarks '(bmkp-non-autonamed-overlays) (not everywherep)))
610
611 ;;;###autoload
612 (defun bmkp-unlight-this-buffer ()
613 "Unhighlight all bookmarks in the current buffer."
614 (interactive)
615 (bmkp-unlight-bookmarks))
616
617 ;;;###autoload
618 (defun bmkp-set-lighting-for-bookmark (bookmark-name style face when &optional msgp light-now-p)
619 "Set the `lighting' property for bookmark BOOKMARK-NAME.
620 You are prompted for the bookmark, highlight style, face, and condition.
621 With a prefix argument, do not highlight now.
622
623 Non-interactively:
624 STYLE, FACE, and WHEN are as for a bookmark's `lighting' property
625 entries, or nil if no such entry.
626 Non-nil MSGP means display a highlighting progress message.
627 Non-nil LIGHT-NOW-P means apply the highlighting now."
628 (interactive
629 (let* ((bmk (bookmark-completing-read "Highlight bookmark"
630 (or (bmkp-default-lighted)
631 (bmkp-default-bookmark-name))))
632 (bmk-style (bmkp-lighting-style bmk))
633 (bmk-face (bmkp-lighting-face bmk))
634 (bmk-when (bmkp-lighting-when bmk)))
635 (append (list bmk)
636 (bmkp-read-set-lighting-args
637 (and bmk-style (format "%s" (car (rassq bmk-style bmkp-light-styles-alist))))
638 (and bmk-face (format "%S" bmk-face))
639 (and bmk-when (format "%S" bmk-when)))
640 (list 'MSGP (not current-prefix-arg)))))
641 (when msgp (message "Setting highlighting..."))
642 (if (or face style when)
643 (bookmark-prop-set bookmark-name
644 'lighting `(,@(and face (not (eq face 'auto)) `(:face ,face))
645 ,@(and style (not (eq style 'none)) `(:style ,style))
646 ,@(and when (not (eq when 'auto)) `(:when ,when))))
647 (bookmark-prop-set bookmark-name 'lighting nil))
648 (when (get-buffer-create "*Bookmark List*") (bmkp-refresh-menu-list bookmark-name))
649 (when msgp (message "Setting highlighting...done"))
650 (when light-now-p (bmkp-light-bookmark bookmark-name nil nil msgp))) ; This msg is more informative.
651
652 ;;;###autoload
653 (defun bmkp-set-lighting-for-buffer (buffer style face when &optional msgp light-now-p)
654 "Set the `lighting' property for each of the bookmarks for BUFFER.
655 You are prompted for the highlight style, face, and condition (when).
656 With a prefix argument, do not highlight now.
657
658 Non-interactively:
659 STYLE, FACE, and WHEN are as for a bookmark's `lighting' property
660 entries, or nil if no such entry.
661 Non-nil MSGP means display a highlighting progress message.
662 Non-nil LIGHT-NOW-P means apply the highlighting now."
663 (interactive (append (list (bmkp-completing-read-buffer-name))
664 (bmkp-read-set-lighting-args)
665 (list 'MSGP (not current-prefix-arg))))
666 (bmkp-set-lighting-for-bookmarks
667 (let ((bmkp-last-specific-buffer buffer)) (bmkp-last-specific-buffer-alist-only))
668 style face when msgp light-now-p))
669
670 ;;;###autoload
671 (defun bmkp-set-lighting-for-this-buffer (style face when &optional msgp light-now-p)
672 "Set the `lighting' property for each of the bookmarks for this buffer.
673 You are prompted for the highlight style, face, and condition (when).
674 With a prefix argument, do not highlight now.
675
676 Non-interactively:
677 STYLE, FACE, and WHEN are as for a bookmark's `lighting' property
678 entries, or nil if no such entry.
679 Non-nil MSGP means display a highlighting progress message.
680 Non-nil LIGHT-NOW-P means apply the highlighting now."
681 (interactive (append (bmkp-read-set-lighting-args) (list 'MSGP (not current-prefix-arg))))
682 (bmkp-set-lighting-for-bookmarks (bmkp-this-buffer-alist-only) style face when msgp light-now-p))
683
684 (defun bmkp-set-lighting-for-bookmarks (alist style face when &optional msgp light-now-p)
685 "Set the `lighting' property for each of the bookmarks in ALIST.
686 STYLE, FACE, and WHEN are as for a bookmark's `lighting' property
687 entries, or nil if no such entry.
688 Non-nil MSGP means display a highlighting progress message.
689 Non-nil LIGHT-NOW-P means apply the highlighting now."
690 (when msgp (message "Setting highlighting..."))
691 (dolist (bmk alist) (bmkp-set-lighting-for-bookmark bmk style face when)) ; No MSGP arg here.
692 (when msgp (message "Setting highlighting...done"))
693 (when light-now-p (bmkp-light-bookmarks alist nil msgp))) ; Do separately so we get its message.
694
695 ;;;###autoload
696 (defun bmkp-light-bookmark (bookmark &optional style face msgp pointp)
697 "Highlight BOOKMARK.
698 With a prefix arg you are prompted for the style and/or face to use:
699 Plain prefix arg (`C-u'): prompt for both style and face.
700 Numeric non-negative arg: prompt for face.
701 Numeric negative arg: prompt for style.
702
703 Non-interactively:
704 BOOKMARK is a bookmark name or a bookmark record, or it is ignored.
705 STYLE and FACE override the defaults.
706 POINT-P non-nil means highlight point rather than the recorded
707 bookmark `position."
708 (interactive
709 (let* ((bmk (bookmark-completing-read "Highlight bookmark" (bmkp-default-bookmark-name)))
710 (sty (and current-prefix-arg (or (consp current-prefix-arg)
711 (<= (prefix-numeric-value current-prefix-arg) 0))
712 (cdr (assoc (let ((completion-ignore-case t))
713 (completing-read
714 "Style: " bmkp-light-styles-alist nil t nil nil
715 (and (bmkp-lighting-style bmk)
716 (format "%s" (car (rassq (bmkp-lighting-style bmk)
717 bmkp-light-styles-alist))))))
718 bmkp-light-styles-alist))))
719 (fac (and current-prefix-arg (or (consp current-prefix-arg)
720 (natnump (prefix-numeric-value current-prefix-arg)))
721 (not (member sty '(lfringe rfringe none))) ; No face possible for these.
722 (condition-case nil ; Emacs 22+ accepts a default.
723 (read-face-name "Face: " (format "%S" (bmkp-lighting-face bmk)))
724 (wrong-number-of-arguments (read-face-name "Face: "))))))
725 (list bmk sty fac 'MSG)))
726 (let* ((bmkp-use-region nil) ; Inhibit region handling.
727 (bmk (bookmark-get-bookmark bookmark (not msgp))) ; Error if interactive.
728 (bmk-name (bmkp-bookmark-name-from-record bmk))
729 (pos (and bmk (bookmark-get-position bmk)))
730 (buf (and bmk (bmkp-get-buffer-name bmk)))
731 (autonamedp (and bmk (bmkp-autonamed-bookmark-p bmk)))
732 (styl (or style (and bmk (bmkp-light-style bmk))))
733 (fac (or face (and bmk (not (member styl '(lfringe rfringe none)))
734 (bmkp-light-face bmk))))
735 (passes-when-p (and bmk (or face style ; Always highlight if changed face or style.
736 (bmkp-light-when bmk))))
737 (nb-lit (bmkp-number-lighted))
738 bmk-ov)
739 (catch 'bmkp-light-bookmark
740 (when bmk ; Just skip bad bookmark if not interactive.
741 (cond ((setq bmk-ov (bmkp-overlay-of-bookmark bmk))
742 (if (not (or style face))
743 (when msgp ; No-op batch.
744 (error "Already highlighted - use prefix arg to change"))
745 (when style (bmkp-make/move-overlay-of-style style pos autonamedp bmk-ov))
746 (when (and face (not (memq styl '(lfringe rfringe none))))
747 (overlay-put bmk-ov 'face face)))
748 (when msgp (message "%sighlighted bookmark `%s'" (if bmk-ov "H" "UNh") bmk-name)))
749 (passes-when-p
750 (save-excursion
751
752 ;; See note in comments of `bmkp-light-bookmarks' - same considerations here.
753 ;; (let ((bmkp-jump-display-function nil)) (bookmark-handle-bookmark bmk))
754 ;;
755 (with-current-buffer (or (and buf (get-buffer buf)) (current-buffer))
756
757 ;; POINTP is non-nil when `bmkp-light-bookmark' is called from
758 ;; `bookmark--jump-via'.
759 (when (and pointp bmkp-auto-light-relocate-when-jump-flag)
760 (setq pos (point)))
761 (when (and pos (< pos (point-max)))
762 (let ((ov (bmkp-make/move-overlay-of-style styl pos autonamedp)))
763 (when ov ; nil means `none' style.
764 (let ((ovs (if autonamedp
765 'bmkp-autonamed-overlays
766 'bmkp-non-autonamed-overlays)))
767 (push ov (symbol-value ovs)))
768 (when (and (not (bmkp-lighted-p bmk))
769 (> (setq nb-lit (1+ nb-lit)) bmkp-light-threshold))
770 (setq nb-lit (1- nb-lit))
771 (throw 'bmkp-light-bookmark bmk))
772 (overlay-put ov 'priority
773 (or (cdr (assoc (if autonamedp
774 'bmkp-autonamed-overlays
775 'bmkp-non-autonamed-overlays)
776 bmkp-light-priorities))
777 (apply #'min (mapcar #'cdr bmkp-light-priorities))))
778 (unless (memq styl '(lfringe rfringe none)) (overlay-put ov 'face fac))
779 (overlay-put ov 'evaporate t)
780 (overlay-put ov 'category 'bookmark-plus)
781 (overlay-put ov 'bookmark bmk-name))
782 (when msgp
783 (message "%sighlighted bookmark `%s'" (if ov "H" "UNh") bmk-name)))))))
784 (t
785 (when msgp (message "Bookmark's condition canceled highlighting"))))))))
786
787 ;;;###autoload
788 (defun bmkp-light-bookmark-this-buffer (bookmark &optional style face msgp) ; `C-x p h'
789 "Highlight a BOOKMARK in the current buffer.
790 With a prefix arg you are prompted for the style and/or face to use:
791 Plain prefix arg (`C-u'): prompt for both style and face.
792 Numeric non-negative arg: prompt for face.
793 Numeric negative arg: prompt for style.
794 See `bmkp-light-boookmark' for argument descriptions."
795 (interactive
796 (let* ((bmk (bookmark-completing-read "Highlight bookmark" nil (bmkp-this-buffer-alist-only)))
797 (sty (and current-prefix-arg (or (consp current-prefix-arg)
798 (<= (prefix-numeric-value current-prefix-arg) 0))
799 (cdr (assoc (let ((completion-ignore-case t))
800 (completing-read
801 "Style: " bmkp-light-styles-alist nil t nil nil
802 (and (bmkp-lighting-style bmk)
803 (format "%s" (car (rassq (bmkp-lighting-style bmk)
804 bmkp-light-styles-alist))))))
805 bmkp-light-styles-alist))))
806 (fac (and current-prefix-arg (or (consp current-prefix-arg)
807 (natnump (prefix-numeric-value current-prefix-arg)))
808 (not (member sty '(lfringe rfringe none))) ; No face possible for these.
809 (condition-case nil ; Emacs 22+ accepts a default.
810 (read-face-name "Face: " (format "%S" (bmkp-lighting-face bmk)))
811 (wrong-number-of-arguments (read-face-name "Face: "))))))
812 (list bmk sty fac 'MSG)))
813 (bmkp-light-bookmark bookmark style face msgp))
814
815 ;;;###autoload
816 (defun bmkp-light-bookmarks (&optional alist overlays-symbols msgp) ; `C-x p H'
817 "Highlight bookmarks.
818 A prefix argument determines which bookmarks to highlight:
819 none - Current buffer, all bookmarks.
820 = 0 - Current buffer, highlighted bookmarks only (rehighlight).
821 > 0 - Current buffer, autonamed bookmarks only.
822 < 0 - Current buffer, non-autonamed bookmarks only.
823 C-u - All buffers (all bookmarks) - after confirmation.
824 C-u C-u - Navlist (all bookmarks).
825
826 Non-interactively, ALIST is the alist of bookmarks to highlight."
827 (interactive
828 (list (cond ((not current-prefix-arg) (bmkp-this-buffer-alist-only))
829 ((consp current-prefix-arg) (if (> (prefix-numeric-value current-prefix-arg) 4)
830 bmkp-nav-alist
831 (unless
832 (y-or-n-p
833 "Confirm highlighting bookmarks in ALL buffers ")
834 (error "Canceled highlighting"))
835 (bmkp-specific-buffers-alist-only
836 (mapcar #'buffer-name (buffer-list)))))
837 ((> current-prefix-arg 0) (bmkp-autonamed-this-buffer-alist-only))
838 ((< current-prefix-arg 0) (bmkp-remove-if #'bmkp-autonamed-bookmark-p
839 (bmkp-this-buffer-alist-only)))
840 ((= current-prefix-arg 0) (bmkp-this-buffer-lighted-alist-only)))
841 (cond ((or (not current-prefix-arg) (consp current-prefix-arg))
842 '(bmkp-autonamed-overlays bmkp-non-autonamed-overlays))
843 ((natnump current-prefix-arg) '(bmkp-autonamed-overlays))
844 (current-prefix-arg '(bmkp-non-autonamed-overlays)))
845 'MSG))
846 (unless overlays-symbols
847 (setq overlays-symbols '(bmkp-autonamed-overlays bmkp-non-autonamed-overlays)))
848 (let ((bmkp-use-region nil) ; Inhibit region handling.
849 (total 0)
850 (nb-auto 0)
851 (nb-non-auto 0)
852 (new-auto 0)
853 (new-non-auto 0)
854 (nb-lit (bmkp-number-lighted))
855 bmk bmk-name autonamedp face style pos buf bmk-ov passes-when-p)
856 (catch 'bmkp-light-bookmarks
857 (dolist (bookmark alist)
858 (setq bmk (bookmark-get-bookmark bookmark 'NOERROR)
859 bmk-name (and bmk (bmkp-bookmark-name-from-record bmk))
860 autonamedp (and bmk (bmkp-autonamed-bookmark-p bmk-name))
861 face (and bmk (bmkp-light-face bmk))
862 style (and bmk (bmkp-light-style bmk))
863 bmk-ov (bmkp-overlay-of-bookmark bmk)
864 passes-when-p (and bmk (or bmk-ov ; Always highlight if already highlighted.
865 (bmkp-light-when bmk))))
866 (when (and bmk passes-when-p) ; Skip bad bookmark and respect `:when' (unless highlighted).
867 (setq pos (bookmark-get-position bmk)
868 buf (bmkp-get-buffer-name bmk))
869 (save-excursion
870 ;; An alternative here would be to call the handler at let it do the highlighting.
871 ;; In that case, we would need at least to bind the display function to nil while
872 ;; handling, so we don't also do the jump. In particular, we don't want to pop to
873 ;; the bookmark in a new window or frame.
874 ;; Calling the handler would be good for some cases, such as Info, where the
875 ;; highlighting is not really specific to the buffer but to a narrowed part of it.
876 ;;
877 ;; (let ((bmkp-jump-display-function nil)) (bookmark-handle-bookmark bmk))
878 ;;
879 ;; But calling the handler is in general the wrong thing. We don't want highlighting
880 ;; all Dired bookmarks in a given directory to also do all the file marking and
881 ;; subdir hiding associated with each of the bookmarks. So we do just the
882 ;; highlighting, no handling, putting the code in side `with-current-buffer'.
883 (with-current-buffer (or (and buf (get-buffer buf)) (current-buffer))
884 (when (and pos (< pos (point-max)))
885 (dolist (ov-symb overlays-symbols)
886 (when (or (and (eq 'bmkp-autonamed-overlays ov-symb) autonamedp)
887 (and (eq 'bmkp-non-autonamed-overlays ov-symb) (not autonamedp)))
888 (let ((ov (bmkp-make/move-overlay-of-style style pos autonamedp bmk-ov)))
889 (when ov ; nil means `none' style.
890 (set ov-symb (cons ov (symbol-value ov-symb)))
891 (when (eq 'bmkp-autonamed-overlays ov-symb)
892 (unless bmk-ov (setq new-auto (1+ new-auto)))
893 (setq nb-auto (1+ nb-auto)))
894 (when (eq 'bmkp-non-autonamed-overlays ov-symb)
895 (unless bmk-ov (setq new-non-auto (1+ new-non-auto)))
896 (setq nb-non-auto (1+ nb-non-auto)))
897 (when (and (not bmk-ov) (> (setq nb-lit (1+ nb-lit)) bmkp-light-threshold))
898 (setq nb-lit (1- nb-lit))
899 (throw 'bmkp-light-bookmarks bmk))
900 (setq total (1+ total))
901 (overlay-put ov 'priority ; > ediff's 100+, < isearch-overlay's 1001.
902 (or (cdr (assoc ov-symb bmkp-light-priorities))
903 (apply #'min (mapcar #'cdr bmkp-light-priorities))))
904 (unless (memq style '(lfringe rfringe none)) (overlay-put ov 'face face))
905 (overlay-put ov 'evaporate t)
906 (overlay-put ov 'category 'bookmark-plus)
907 (overlay-put ov 'bookmark bmk-name)))))))))))
908 (when msgp (message "%s New: %d auto + %d other, Total: %d auto + %d other = %d"
909 (if (consp current-prefix-arg)
910 (if (> (prefix-numeric-value current-prefix-arg) 4)
911 "[Navlist]"
912 "[All buffers]")
913 "[This buffer]")
914 new-auto new-non-auto nb-auto nb-non-auto total))))
915
916 ;;;###autoload
917 (defun bmkp-light-navlist-bookmarks (&optional overlays-symbols msgp)
918 "Highlight bookmarks in the navigation list.
919 No prefix arg: all bookmarks.
920 Prefix arg >= 0: autonamed bookmarks only.
921 Prefix arg < 0: non-autonamed bookmarks only."
922 (interactive
923 (list (cond ((not current-prefix-arg) '(bmkp-autonamed-overlays bmkp-non-autonamed-overlays))
924 ((natnump (prefix-numeric-value current-prefix-arg)) '(bmkp-autonamed-overlays))
925 (current-prefix-arg '(bmkp-non-autonamed-overlays)))
926 'MSG))
927 (bmkp-light-bookmarks bmkp-nav-alist overlays-symbols msgp))
928
929 ;;;###autoload
930 (defun bmkp-light-this-buffer (&optional overlays-symbols msgp)
931 "Highlight bookmarks in the current buffer.
932 No prefix arg: all bookmarks.
933 Prefix arg >= 0: autonamed bookmarks only.
934 Prefix arg < 0: non-autonamed bookmarks only."
935 (interactive
936 (list (cond ((not current-prefix-arg) '(bmkp-autonamed-overlays bmkp-non-autonamed-overlays))
937 ((natnump (prefix-numeric-value current-prefix-arg)) '(bmkp-autonamed-overlays))
938 (current-prefix-arg '(bmkp-non-autonamed-overlays)))
939 'MSG))
940 (bmkp-light-bookmarks (bmkp-this-buffer-alist-only) overlays-symbols msgp))
941
942 ;;;###autoload
943 (defun bmkp-light-bookmarks-in-region (start end &optional overlays-symbols msgp)
944 "Highlight bookmarks in the region.
945 No prefix arg: all bookmarks.
946 Prefix arg >= 0: autonamed bookmarks only.
947 Prefix arg < 0: non-autonamed bookmarks only."
948 (interactive
949 (list (region-beginning)
950 (region-end)
951 (cond ((not current-prefix-arg) '(bmkp-autonamed-overlays bmkp-non-autonamed-overlays))
952 ((natnump (prefix-numeric-value current-prefix-arg)) '(bmkp-autonamed-overlays))
953 (current-prefix-arg '(bmkp-non-autonamed-overlays)))
954 'MSG))
955 (bmkp-light-bookmarks (bmkp-remove-if-not (lambda (bmk) (let ((pos (bookmark-get-position bmk)))
956 (and (>= pos start) (<= pos end))))
957 (bmkp-this-buffer-alist-only))
958 overlays-symbols msgp))
959
960 ;;;###autoload
961 (defun bmkp-light-autonamed-this-buffer (&optional msgp)
962 "Highlight all autonamed bookmarks."
963 (interactive (list 'MSG))
964 (bmkp-light-bookmarks (bmkp-autonamed-this-buffer-alist-only) '(bmkp-autonamed-overlays) msgp))
965
966 ;;;###autoload
967 (defun bmkp-light-non-autonamed-this-buffer (&optional msgp)
968 "Highlight all non-autonamed bookmarks."
969 (interactive (list 'MSG))
970 (bmkp-light-bookmarks (bmkp-remove-if #'bmkp-autonamed-bookmark-p (bmkp-this-buffer-alist-only))
971 '(bmkp-non-autonamed-overlays) msgp))
972
973 ;;;###autoload
974 (defun bmkp-cycle-lighted-this-buffer (increment &optional other-window startoverp)
975 "Cycle through highlighted bookmarks in this buffer by INCREMENT.
976 Positive INCREMENT cycles forward. Negative INCREMENT cycles backward.
977 Interactively, the prefix arg determines INCREMENT:
978 Plain `C-u': 1
979 otherwise: the numeric prefix arg value
980
981 To change the sort order, you can filter the `*Bookmark List*' to show
982 only highlighted bookmarks for this buffer, sort the bookmarks there,
983 and use `\\[bmkp-choose-navlist-from-bookmark-list]', choosing `CURRENT *Bookmark List*' as the
984 navigation list.
985
986 Then you can cycle the bookmarks using `bookmark-cycle'
987 \(`\\[bmkp-next-bookmark-repeat]' etc.), instead of `bookmark-cycle-lighted-this-buffer'.
988
989 In Lisp code:
990 Non-nil OTHER-WINDOW means jump to the bookmark in another window.
991 Non-nil STARTOVERP means reset `bmkp-current-nav-bookmark' to the
992 first bookmark in the navlist."
993 (interactive (let ((startovr (consp current-prefix-arg)))
994 (list (if startovr 1 (prefix-numeric-value current-prefix-arg)) nil startovr)))
995 (bookmark-maybe-load-default-file)
996 (let ((bmkp-sort-comparer bmkp-this-file/buffer-cycle-sort-comparer))
997 (setq bmkp-nav-alist (bmkp-sort-omit (bmkp-this-buffer-lighted-alist-only))))
998 (unless bmkp-nav-alist (error "No lighted bookmarks for cycling"))
999 (unless (and bmkp-current-nav-bookmark (not startoverp)
1000 (bookmark-get-bookmark bmkp-current-nav-bookmark 'NOERROR)
1001 (bmkp-this-buffer-p bmkp-current-nav-bookmark)) ; Exclude desktops etc.
1002 (setq bmkp-current-nav-bookmark (car bmkp-nav-alist)))
1003 (if (bmkp-cycle-1 increment other-window startoverp)
1004 (unless (or (bmkp-sequence-bookmark-p bmkp-current-nav-bookmark)
1005 (bmkp-function-bookmark-p bmkp-current-nav-bookmark))
1006 (message "Position: %9d, Bookmark: `%s'" (point) (bmkp-bookmark-name-from-record
1007 bmkp-current-nav-bookmark)))
1008 (message "Invalid bookmark: `%s'" (bmkp-bookmark-name-from-record bmkp-current-nav-bookmark))))
1009
1010 ;;;###autoload
1011 (defun bmkp-cycle-lighted-this-buffer-other-window (increment &optional startoverp)
1012 "Same as `bmkp-cycle-lighted-this-buffer' but uses another window."
1013 (interactive (let ((startovr (consp current-prefix-arg)))
1014 (list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
1015 (bmkp-cycle-lighted-this-buffer increment 'OTHER-WINDOW startoverp))
1016
1017 ;;;###autoload
1018 (defun bmkp-next-lighted-this-buffer (n &optional startoverp) ; Repeatable key, e.g. `S-f2'
1019 "Jump to the Nth-next highlighted bookmark in the current buffer.
1020 N defaults to 1, meaning the next one.
1021 Plain `C-u' means start over at the first one.
1022 See also `bmkp-cycle-lighted-this-buffer'."
1023 (interactive (let ((startovr (consp current-prefix-arg)))
1024 (list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
1025 (bmkp-cycle-lighted-this-buffer n nil startoverp))
1026
1027 ;;;###autoload
1028 (defun bmkp-previous-lighted-this-buffer (n &optional startoverp) ; Repeatable key, e.g. `f2'
1029 "Jump to the Nth-previous highlighted bookmark in the current buffer.
1030 See `bmkp-next-lighted-this-buffer'."
1031 (interactive (let ((startovr (consp current-prefix-arg)))
1032 (list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
1033 (bmkp-cycle-lighted-this-buffer (- n) nil startoverp))
1034
1035 ;;;###autoload
1036 (defun bmkp-next-lighted-this-buffer-repeat (arg) ; `C-x p C-down'
1037 "Jump to the Nth next highlighted bookmark in the current buffer.
1038 This is a repeatable version of `bmkp-next-bookmark-this-buffer'.
1039 N defaults to 1, meaning the next one.
1040 Plain `C-u' means start over at the first one (and no repeat)."
1041 (interactive "P")
1042 (require 'repeat)
1043 (bmkp-repeat-command 'bmkp-next-lighted-this-buffer))
1044
1045 ;;;###autoload
1046 (defun bmkp-previous-lighted-this-buffer-repeat (arg) ; `C-x p C-up'
1047 "Jump to the Nth previous highlighted bookmark in the current buffer.
1048 See `bmkp-next-lighted-this-buffer-repeat'."
1049 (interactive "P")
1050 (require 'repeat)
1051 (bmkp-repeat-command 'bmkp-previous-lighted-this-buffer))
1052
1053
1054 ;;(@* "Other Functions")
1055 ;; *** Other Functions ***
1056
1057 (defun bmkp-light-face (bookmark)
1058 "Return the face to use to highlight BOOKMARK.
1059 BOOKMARK is a bookmark name or a bookmark record.
1060 Returns:
1061 nil if BOOKMARK is not a valid bookmark;
1062 the `:face' specified by BOOKMARK's `lighting' property, if any;
1063 `bmkp-light-autonamed' if BOOKMARK is an autonamed bookmark;
1064 or `bmkp-light-non-autonamed' otherwise."
1065 (setq bookmark (bookmark-get-bookmark bookmark 'NOERROR))
1066 (or (bmkp-lighting-face bookmark)
1067 (and bookmark (if (string-match (format bmkp-autoname-format ".*")
1068 (bmkp-bookmark-name-from-record bookmark))
1069 'bmkp-light-autonamed
1070 'bmkp-light-non-autonamed))))
1071
1072 (defun bmkp-light-style (bookmark)
1073 "Return the style to use to highlight BOOKMARK.
1074 BOOKMARK is a bookmark name or a bookmark record.
1075 Returns:
1076 nil if BOOKMARK is not a valid bookmark;
1077 the `:style' specified by BOOKMARK's `lighting' property, if any;
1078 the value of `bmkp-light-style-autonamed' if autonamed;
1079 or the value of `bmkp-light-style-non-autonamed' otherwise."
1080 (setq bookmark (bookmark-get-bookmark bookmark 'NOERROR))
1081 (or (bmkp-lighting-style bookmark)
1082 (and bookmark (if (string-match (format bmkp-autoname-format ".*")
1083 (bmkp-bookmark-name-from-record bookmark))
1084 bmkp-light-style-autonamed
1085 bmkp-light-style-non-autonamed))))
1086
1087 (defun bmkp-light-when (bookmark)
1088 "Return non-nil if BOOKMARK should be highlighted.
1089 BOOKMARK's `:when' condition is used to determine this.
1090 BOOKMARK is a bookmark name or a bookmark record."
1091 (setq bookmark (bookmark-get-bookmark bookmark 'NOERROR))
1092 (let ((this-bookmark bookmark)
1093 (this-bookmark-name (bmkp-bookmark-name-from-record bookmark))
1094 (when-sexp (bmkp-lighting-when bookmark)))
1095 (not (eq :no-light (eval when-sexp)))))
1096
1097 (defun bmkp-lighting-face (bookmark)
1098 "`:face' specified by BOOKMARK's `lighting', or nil if no `:face' entry.
1099 BOOKMARK is a bookmark name or a bookmark record.
1100
1101 The `:face' entry is the face (a symbol) used to highlight BOOKMARK.
1102 Alternatively, it can be `auto' or nil, which both mean the same as
1103 having no `:face' entry: do not override automatic face choice."
1104 (bmkp-lighting-attribute bookmark :face))
1105
1106 (defun bmkp-lighting-style (bookmark)
1107 "`:style' specified by BOOKMARK's `lighting', or nil if no `:style' entry.
1108 BOOKMARK is a bookmark name or a bookmark record.
1109
1110 The `:style' entry is the style used to highlight BOOKMARK.
1111 It is a value acceptable for `bmkp-light-style-non-autonamed'.
1112 Alternatively, it can be `auto' or nil, which both mean the same as
1113 having no `:style' entry: do not override automatic style choice."
1114 (bmkp-lighting-attribute bookmark :style))
1115
1116 (defun bmkp-lighting-when (bookmark)
1117 "`:when' specified by BOOKMARK's `lighting', or nil if no `:when' entry.
1118 BOOKMARK is a bookmark name or a bookmark record.
1119
1120 The `:when' entry is a sexp that is eval'd when you try to highlight
1121 BOOKMARK. If the result is the symbol `:no-light', then do not
1122 highlight. Otherwise, highlight. (Note that highlighting happens if
1123 the value is nil or there is no `:when' entry.)"
1124 (bmkp-lighting-attribute bookmark :when))
1125
1126 (defun bmkp-lighting-attribute (bookmark attribute)
1127 "ATTRIBUTE specified by BOOKMARK's `lighting', or nil if no such attribute.
1128 BOOKMARK is a bookmark name or a bookmark record.
1129 ATTRIBUTE is `:style' or `:face'."
1130 (setq bookmark (bookmark-get-bookmark bookmark 'NOERROR))
1131 (let* ((lighting (and bookmark (bmkp-get-lighting bookmark)))
1132 (attr (and (consp lighting) (plist-get lighting attribute))))
1133 (when (and (eq 'auto attr) (not (eq :when attribute)))
1134 (setq attr nil))
1135 attr))
1136
1137 (defun bmkp-get-lighting (bookmark)
1138 "Return the `lighting' property list for BOOKMARK.
1139 This is the cdr of the `lighting' entry (i.e. with `lighting' removed).
1140 BOOKMARK is a bookmark name or a bookmark record."
1141 (bookmark-prop-get bookmark 'lighting))
1142
1143 (defun bmkp-bookmark-overlay-p (overlay)
1144 "Return non-nil if OVERLAY is a bookmark overlay."
1145 (and (overlayp overlay) (overlay-get overlay 'bookmark)))
1146
1147 (defun bmkp-default-lighted ()
1148 "Return a highlighted bookmark at point or on this line, or nil if none.
1149 For Emacs 23+, if there is a highlighted bookmark at point, return a
1150 list of all such."
1151 (or (if (> emacs-major-version 22)
1152 (bmkp-bookmarks-lighted-at-point)
1153 (bmkp-a-bookmark-lighted-at-pos))
1154 (bmkp-a-bookmark-lighted-on-this-line)))
1155
1156 (defun bmkp-a-bookmark-lighted-on-this-line (&optional fullp msgp)
1157 "Return a bookmark highlighted on the current line or nil if none.
1158 The search for a highlighted bookmark moves left to bol from point,
1159 then right to eol from point.
1160 Return the bookmark name or, if FULLP non-nil, the full bookmark data."
1161 (let ((pos (point))
1162 (bol (1+ (line-beginning-position)))
1163 (eol (1- (line-end-position)))
1164 bmk)
1165 (catch 'bmkp-a-bookmark-lighted-on-this-line
1166 (while (>= pos bol)
1167 (when (setq bmk (bmkp-a-bookmark-lighted-at-pos pos))
1168 (throw 'bmkp-a-bookmark-lighted-on-this-line bmk))
1169 (setq pos (1- pos)))
1170 (while (<= pos eol)
1171 (when (setq bmk (bmkp-a-bookmark-lighted-at-pos pos))
1172 (throw 'bmkp-a-bookmark-lighted-on-this-line bmk))
1173 (setq pos (1+ pos)))
1174 nil)
1175 (when (and bmk fullp) (setq bmk (bookmark-get-bookmark bmk)))
1176 bmk))
1177
1178 (defun bmkp-a-bookmark-lighted-at-pos (&optional position fullp)
1179 "Return a bookmark (in current bookmark list) highlighted at POSITION.
1180 Return nil if there is none such.
1181 POSITION defaults to point.
1182 Return the bookmark name or, if FULLP non-nil, the full bookmark data."
1183 (unless position (setq position (point)))
1184 (let (bname)
1185 (catch 'bmkp-a-bookmark-lighted-at-pos
1186 (dolist (ov (overlays-at position))
1187 (when (setq bname (overlay-get ov 'bookmark))
1188 (throw 'bmkp-a-bookmark-lighted-at-pos bname)))
1189 nil)
1190 (let ((full (bmkp-get-bookmark-in-alist bname 'NOERROR)))
1191 (and full ; Must be in current bookmark list.
1192 (if fullp full bname)))))
1193
1194 (defun bmkp-read-set-lighting-args (&optional default-style default-face default-when)
1195 "Read args STYLE, FACE, and WHEN for commands that set `lighting' prop.
1196 Optional args are the default values (strings) for reading new values."
1197 (let* ((icicle-unpropertize-completion-result-flag t)
1198 (style (cdr (assoc (let ((completion-ignore-case t))
1199 (completing-read "Style: " bmkp-light-styles-alist
1200 nil t nil nil default-style))
1201 bmkp-light-styles-alist)))
1202 (face (and (not (member style '(lfringe rfringe none))) ; No face possible for these.
1203 (y-or-n-p "Change face? ") ; Allow nil, for `auto'.
1204 (condition-case nil ; Emacs 22+ accepts a default.
1205 (read-face-name "Face: " default-face)
1206 (wrong-number-of-arguments (read-face-name "Face: ")))))
1207 (when-cands `(("auto" . nil)
1208 ("conditionally (read sexp)")
1209 ("never" . :no-light)))
1210 (when (completing-read "When: " when-cands nil t nil nil
1211 (if default-when "conditionally (read sexp)" "auto")))
1212 (evald (if (string-match "^con" when)
1213 (read-from-minibuffer "Highlight when (sexp): " nil
1214 (if (boundp 'pp-read-expression-map)
1215 pp-read-expression-map
1216 read-expression-map)
1217 t 'read-expression-history default-when)
1218 (cdr (assoc when when-cands)))))
1219 (list style face evald)))
1220
1221 (defun bmkp-lighted-alist-only ()
1222 "`bookmark-alist', with only highlighted bookmarks.
1223 A new list is returned (no side effects)."
1224 (bookmark-maybe-load-default-file)
1225 (bmkp-remove-if-not (lambda (bmk) (bmkp-lighted-p bmk)) bookmark-alist))
1226
1227 (defun bmkp-this-buffer-lighted-alist-only ()
1228 "`bookmark-alist', with only highlighted bookmarks for the current buffer.
1229 A new list is returned (no side effects)."
1230 (bookmark-maybe-load-default-file)
1231 (bmkp-remove-if-not (lambda (bmk) (and (bmkp-this-buffer-p bmk) (bmkp-lighted-p bmk)))
1232 bookmark-alist))
1233
1234 (defun bmkp-number-lighted (&optional overlays-symbols)
1235 "Number of bookmarks highlighted."
1236 (unless overlays-symbols
1237 (setq overlays-symbols '(bmkp-autonamed-overlays bmkp-non-autonamed-overlays)))
1238 (let ((count 0))
1239 (dolist (ov-symb overlays-symbols)
1240 (dolist (ov (symbol-value ov-symb)) (when (overlay-buffer ov) (setq count (1+ count)))))
1241 count))
1242
1243 (defalias 'bmkp-lighted-p 'bmkp-overlay-of-bookmark)
1244 (defun bmkp-overlay-of-bookmark (bookmark &optional overlays)
1245 "Return the overlay for BOOKMARK in OVERLAYS, or nil if none.
1246 BOOKMARK is a bookmark name or a bookmark record.
1247 Optional arg OVERLAYS is the list of overlays to check.
1248 If nil, check overlays for both autonamed and non-autonamed bookmarks."
1249 (setq bookmark (bookmark-get-bookmark bookmark 'NOERROR))
1250 (and bookmark ; Return nil for no such bookmark.
1251 (setq bookmark (bmkp-bookmark-name-from-record bookmark))
1252 (catch 'bmkp-overlay-of-bookmark
1253 (dolist (ov (if overlays
1254 (apply #'append (mapcar #'symbol-value overlays))
1255 (append bmkp-autonamed-overlays bmkp-non-autonamed-overlays)))
1256 (when (and (overlay-buffer ov) (equal bookmark (overlay-get ov 'bookmark)))
1257 (throw 'bmkp-overlay-of-bookmark ov)))
1258 nil)))
1259
1260 (defun bmkp-make/move-overlay-of-style (style pos autonamedp &optional overlay)
1261 "Return a bookmark overlay of STYLE at bookmark position POS.
1262 AUTONAMEDP non-nil means the bookmark is autonamed.
1263 If OVERLAY is non-nil it is the overlay to use - change to STYLE.
1264 Otherwise, create a new overlay.
1265 If STYLE is `none' then:
1266 If OVERLAY is non-nil, delete it.
1267 Return nil."
1268 (let ((ov overlay))
1269 (when (and (< emacs-major-version 22) (not (rassq style bmkp-light-styles-alist)))
1270 (message "Fringe styles not supported before Emacs 22 - changing to `line' style")
1271 (setq style 'line))
1272 (case style
1273 (line (if (not ov)
1274 (setq ov (save-excursion
1275 (make-overlay
1276 (progn (goto-char pos) (line-beginning-position 1))
1277 (progn (goto-char pos) (line-beginning-position 2))
1278 nil
1279 'FRONT-ADVANCE)))
1280 (overlay-put ov 'before-string nil) ; Remove any fringe highlighting.
1281 (save-excursion
1282 (move-overlay ov
1283 (progn (goto-char pos) (line-beginning-position 1))
1284 (progn (goto-char pos) (line-beginning-position 2))))))
1285 (lfringe (setq ov (bmkp-make/move-fringe 'left pos autonamedp ov)))
1286 (rfringe (setq ov (bmkp-make/move-fringe 'right pos autonamedp ov)))
1287 (line+lfringe (setq ov (bmkp-make/move-fringe 'left pos autonamedp ov 'LINEP)))
1288 (line+rfringe (setq ov (bmkp-make/move-fringe 'right pos autonamedp ov 'LINEP)))
1289 (bol (if (not ov)
1290 (setq ov (save-excursion (goto-char pos)
1291 (make-overlay (line-beginning-position)
1292 (1+ (line-beginning-position))
1293 nil
1294 'FRONT-ADVANCE)))
1295 (overlay-put ov 'before-string nil) ; Remove any fringe highlighting.
1296 (save-excursion (goto-char pos)
1297 (move-overlay ov (line-beginning-position)
1298 (1+ (line-beginning-position))))))
1299 (point (if (not ov)
1300 (setq ov (make-overlay pos (1+ pos) nil 'FRONT-ADVANCE))
1301 (overlay-put ov 'before-string nil) ; Remove any fringe highlighting.
1302 (move-overlay ov pos (1+ pos))))
1303 (none (when ov (delete-overlay ov)) (setq ov nil)))
1304 ov))
1305
1306 ;; Not used for Emacs 20-21.
1307 (defun bmkp-make/move-fringe (side pos autonamedp &optional overlay linep)
1308 "Return an overlay that uses the fringe.
1309 If SIDE is `right' then use the right fringe, otherwise left.
1310 POS is the overlay position.
1311 AUTONAMEDP: non-nil means use face `bmkp-light-fringe-autonamed'.
1312 nil means use face `bmkp-light-fringe-non-autonamed'.
1313 If OVERLAY is non-nil it is the overlay to use.
1314 Otherwise, create a new overlay.
1315 Non-nil LINEP means also highlight the line containing POS."
1316 (unless (> emacs-major-version 21) (error "Fringe styles not supported before Emacs 22"))
1317 (let ((ov overlay))
1318 (if ov
1319 (save-excursion (move-overlay overlay (progn (goto-char pos)
1320 (goto-char (line-beginning-position)))
1321 (1+ (point))))
1322 (setq ov (save-excursion (make-overlay (progn (goto-char pos)
1323 (goto-char (line-beginning-position)))
1324 (1+ (point))
1325 nil
1326 'FRONT-ADVANCE))))
1327 (overlay-put ov 'before-string (bmkp-fringe-string side autonamedp))
1328 (if linep
1329 (move-overlay ov (save-excursion (goto-char pos) (line-beginning-position 1))
1330 (save-excursion (goto-char pos) (line-beginning-position 2)))
1331 (overlay-put ov 'face nil)) ; Remove any non-fringe highlighting.
1332 ov))
1333
1334 ;; Not used for Emacs 20-21.
1335 (defun bmkp-fringe-string (side autonamedp)
1336 "Return a fringe string for a bookmark overlay.
1337 If SIDE is `right' then use the right fringe, otherwise left.
1338 AUTONAMEDP: non-nil means use face `bmkp-light-fringe-autonamed'.
1339 nil means use face `bmkp-light-fringe-non-autonamed'."
1340 (unless (> emacs-major-version 21) (error "Fringe styles not supported before Emacs 22"))
1341 (let ((fringe-string (copy-sequence (if autonamedp "*AUTO*" "*NONAUTO*"))))
1342 (put-text-property 0 (length fringe-string)
1343 'display (if (eq side 'right)
1344 (list 'right-fringe
1345 bmkp-light-right-fringe-bitmap
1346 (if autonamedp
1347 'bmkp-light-fringe-autonamed
1348 'bmkp-light-fringe-non-autonamed))
1349 (list 'left-fringe
1350 bmkp-light-left-fringe-bitmap
1351 (if autonamedp
1352 'bmkp-light-fringe-autonamed
1353 'bmkp-light-fringe-non-autonamed)))
1354 fringe-string)
1355 fringe-string))
1356
1357 ;;;;;;;;;;;;;;;;;;;
1358
1359 (provide 'bookmark+-lit)
1360
1361 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1362 ;;; bookmark+-lit.el ends here