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