auto-install/bookmark+-mac.el

   1 ;;; bookmark+-mac.el --- Macros for Bookmark+.
   2 ;;
   3 ;; Filename: bookmark+-mac.el
   4 ;; Description: Macros for Bookmark+.
   5 ;; Author: Drew Adams
   6 ;; Maintainer: Drew Adams
   7 ;; Copyright (C) 2000-2011, Drew Adams, all rights reserved.
   8 ;; Created: Sun Aug 15 11:12:30 2010 (-0700)
   9 ;; Last-Updated: Fri Apr  1 16:24:04 2011 (-0700)
  10 ;;           By: dradams
  11 ;;     Update #: 78
  12 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/bookmark+-mac.el
  13 ;; Keywords: bookmarks, bookmark+, placeholders, annotations, search, info, url, w3m, gnus
  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'.
  19 ;;
  20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21 ;;
  22 ;;; Commentary:
  23 ;;
  24 ;;    Macros for Bookmark+.
  25 ;;
  26 ;;    The Bookmark+ libraries are these:
  27 ;;
  28 ;;    `bookmark+.el'     - main (driver) library
  29 ;;    `bookmark+-mac.el' - Lisp macros (this file)
  30 ;;    `bookmark+-bmu.el' - code for the `*Bookmark List*' (bmenu)
  31 ;;    `bookmark+-1.el'   - other (non-bmenu) required code
  32 ;;    `bookmark+-lit.el' - (optional) code for highlighting bookmarks
  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 ;;    The documentation (in `bookmark+-doc.el') includes how to
  39 ;;    byte-compile and install Bookmark+.  The documentation is also
  40 ;;    available in these ways:
  41 ;;
  42 ;;    1. From the bookmark list (`C-x r l'):
  43 ;;       Use `?' to show the current bookmark-list status and general
  44 ;;       help, then click link `Doc in Commentary' or link `Doc on the
  45 ;;       Web'.
  46 ;;
  47 ;;    2. From the Emacs-Wiki Web site:
  48 ;;       http://www.emacswiki.org/cgi-bin/wiki/BookmarkPlus.
  49 ;;
  50 ;;    3. From the Bookmark+ group customization buffer:
  51 ;;       `M-x customize-group bookmark-plus', then click link
  52 ;;       `Commentary'.
  53 ;;
  54 ;;    (The commentary links in #1 and #3 work only if you have library
  55 ;;    `bookmark+-doc.el' in your `load-path'.)
  56
  57 ;;(@> "Index")
  58 ;;
  59 ;;  If you have library `linkd.el' and Emacs 22 or later, load
  60 ;;  `linkd.el' and turn on `linkd-mode' now.  It lets you easily
  61 ;;  navigate around the sections of this doc.  Linkd mode will
  62 ;;  highlight this Index, as well as the cross-references and section
  63 ;;  headings throughout this file.  You can get `linkd.el' here:
  64 ;;  http://dto.freeshell.org/notebook/Linkd.html.
  65 ;;
  66 ;;  (@> "Things Defined Here")
  67 ;;  (@> "Functions")
  68 ;;  (@> "Macros")
  69
  70 ;;(@* "Things Defined Here")
  71 ;;
  72 ;;  Things Defined Here
  73 ;;  -------------------
  74 ;;
  75 ;;  Macros defined here:
  76 ;;
  77 ;;    `bmkp-define-cycle-command',
  78 ;;    `bmkp-define-next+prev-cycle-commands',
  79 ;;    `bmkp-define-sort-command', `bmkp-define-file-sort-predicate',
  80 ;;    `bmkp-menu-bar-make-toggle'.
  81 ;;
  82 ;;  Non-interactive functions defined here:
  83 ;;
  84 ;;    `bmkp-assoc-delete-all', `bmkp-replace-regexp-in-string'.
  85 ;;
  86 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  87 ;;
  88 ;; This program is free software; you can redistribute it and/or
  89 ;; modify it under the terms of the GNU General Public License as
  90 ;; published by the Free Software Foundation; either version 3, or
  91 ;; (at your option) any later version.
  92 ;;
  93 ;; This program is distributed in the hope that it will be useful,
  94 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  95 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  96 ;; General Public License for more details.
  97 ;;
  98 ;; You should have received a copy of the GNU General Public License
  99 ;; along with this program; see the file COPYING.  If not, write to
 100 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
 101 ;; Floor, Boston, MA 02110-1301, USA.
 102 ;;
 103 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 104 ;;
 105 ;;; Code:
 106
 107 ;;;;;;;;;;;;;;;;;;;;;;;
 108
 109 (require 'bookmark)
 110 ;; bookmark-bmenu-bookmark, bookmark-bmenu-ensure-position,
 111 ;; bookmark-bmenu-surreptitiously-rebuild-list, bookmark-get-bookmark,
 112 ;; bookmark-get-filename
 113
 114 ;; (eval-when-compile (require 'bookmark+-bmu))
 115 ;; bmkp-bmenu-barf-if-not-in-menu-list,
 116 ;; bmkp-bmenu-goto-bookmark-named, bmkp-sort-orders-alist
 117
 118 ;; (eval-when-compile (require 'bookmark+-1))
 119 ;; bmkp-file-bookmark-p, bmkp-float-time, bmkp-local-file-bookmark-p,
 120 ;; bmkp-msg-about-sort-order, bmkp-reverse-sort-p, bmkp-sort-comparer
 121
 122 ;;(@* "Functions")
 123
 124 ;;; Functions --------------------------------------------------------
 125
 126 ;;; These functions are general functions.  They are here because they are used in macro
 127 ;;; `bmkp-define-sort-command'.  That macro is in this file because it is used only to create
 128 ;;; bmenu commands.
 129
 130 ;; Used in `bmkp-define-sort-command'.
 131 (defun bmkp-assoc-delete-all (key alist)
 132   "Delete from ALIST all elements whose car is `equal' to KEY.
 133 Return the modified alist.
 134 Elements of ALIST that are not conses are ignored."
 135   (while (and (consp (car alist)) (equal (car (car alist)) key))  (setq alist  (cdr alist)))
 136   (let ((tail  alist)
 137         tail-cdr)
 138     (while (setq tail-cdr  (cdr tail))
 139       (if (and (consp (car tail-cdr))  (equal (car (car tail-cdr)) key))
 140           (setcdr tail (cdr tail-cdr))
 141         (setq tail  tail-cdr))))
 142   alist)
 143
 144 ;; Used in `bmkp-define-sort-command'.
 145 (defun bmkp-replace-regexp-in-string (regexp rep string &optional fixedcase literal subexp start)
 146   "Replace all matches for REGEXP with REP in STRING and return STRING."
 147   (if (fboundp 'replace-regexp-in-string) ; Emacs > 20.
 148       (replace-regexp-in-string regexp rep string fixedcase literal subexp start)
 149     (if (string-match regexp string) (replace-match rep nil nil string) string))) ; Emacs 20
 150
 151 ;;(@* "Macros")
 152
 153 ;;; Macros -----------------------------------------------------------
 154
 155 ;;;###autoload
 156 (defmacro bmkp-define-cycle-command (type &optional otherp)
 157   "Define a cycling command for bookmarks of type TYPE.
 158 Non-nil OTHERP means define a command that cycles in another window."
 159   `(defun ,(intern (format "bmkp-cycle-%s%s" type (if otherp "-other-window" "")))
 160     (increment &optional startoverp)
 161     ,(if otherp
 162          (format "Same as `bmkp-cycle-%s', but use other window." type)
 163          (format "Cycle through %s bookmarks by INCREMENT (default: 1).
 164 Positive INCREMENT cycles forward.  Negative INCREMENT cycles backward.
 165 Interactively, the prefix arg determines INCREMENT:
 166  Plain `C-u': 1
 167  otherwise: the numeric prefix arg value
 168
 169 Plain `C-u' also means start over at first bookmark.
 170
 171 In Lisp code:
 172  Non-nil STARTOVERP means reset `bmkp-current-nav-bookmark' to the
 173  first bookmark in the navlist." type))
 174     (interactive (let ((startovr  (consp current-prefix-arg)))
 175                    (list (if startovr 1 (prefix-numeric-value current-prefix-arg))
 176                          startovr)))
 177     (let ((bmkp-nav-alist  (bmkp-sort-and-remove-dups
 178                             (,(intern (format "bmkp-%s-alist-only" type))))))
 179       (bmkp-cycle increment ,otherp startoverp))))
 180
 181 ;;;###autoload
 182 (defmacro bmkp-define-next+prev-cycle-commands (type)
 183   "Define `next' and `previous' commands for bookmarks of type TYPE."
 184   `(progn
 185     ;; `next' command.
 186     (defun ,(intern (format "bmkp-next-%s-bookmark" type)) (n &optional startoverp)
 187       ,(format "Jump to the Nth-next %s bookmark.
 188 N defaults to 1, meaning the next one.
 189 Plain `C-u' means start over at the first one.
 190 See also `bmkp-cycle-%s'." type type)
 191       (interactive (let ((startovr  (consp current-prefix-arg)))
 192                      (list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
 193       (,(intern (format "bmkp-cycle-%s" type)) n startoverp))
 194
 195     ;; `previous' command.
 196     (defun ,(intern (format "bmkp-previous-%s-bookmark" type)) (n &optional startoverp)
 197       ,(format "Jump to the Nth-previous %s bookmark.
 198 See `bmkp-next-%s-bookmark'." type type)
 199       (interactive (let ((startovr  (consp current-prefix-arg)))
 200                      (list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
 201       (,(intern (format "bmkp-cycle-%s" type)) (- n) startoverp))
 202
 203     ;; `next' repeating command.
 204     (defun ,(intern (format "bmkp-next-%s-bookmark-repeat" type)) (arg)
 205       ,(format "Jump to the Nth-next %s bookmark.
 206 This is a repeatable version of `bmkp-next-%s-bookmark'.
 207 N defaults to 1, meaning the next one.
 208 Plain `C-u' means start over at the first one (and no repeat)." type type)
 209       (interactive "P")
 210       (require 'repeat)
 211       (bmkp-repeat-command ',(intern (format "bmkp-next-%s-bookmark" type))))
 212
 213     ;; `previous repeating command.
 214     (defun ,(intern (format "bmkp-previous-%s-bookmark-repeat" type)) (arg)
 215       ,(format "Jump to the Nth-previous %s bookmark.
 216 See `bmkp-next-%s-bookmark-repeat'." type type)
 217       (interactive "P")
 218       (require 'repeat)
 219       (bmkp-repeat-command ',(intern (format "bmkp-previous-%s-bookmark" type))))))
 220
 221 ;;;###autoload
 222 (defmacro bmkp-define-sort-command (sort-order comparer doc-string)
 223   "Define a command to sort bookmarks in the bookmark list by SORT-ORDER.
 224 SORT-ORDER is a short string or symbol describing the sorting method.
 225 Examples: \"by last access time\", \"by bookmark name\".
 226
 227 The new command is named by replacing any spaces in SORT-ORDER with
 228 hyphens (`-') and then adding the prefix `bmkp-bmenu-sort-'.  Example:
 229 `bmkp-bmenu-sort-by-bookmark-name', for SORT-ORDER `by bookmark name'.
 230
 231 COMPARER compares two bookmarks, returning non-nil if and only if the
 232 first bookmark sorts before the second.  It must be acceptable as a
 233 value of `bmkp-sort-comparer'.  That is, it is either nil, a
 234 predicate, or a list ((PRED...) FINAL-PRED).  See the doc for
 235 `bmkp-sort-comparer'.
 236
 237 DOC-STRING is the doc string of the new command."
 238   (unless (stringp sort-order) (setq sort-order  (symbol-name sort-order)))
 239   (let ((command  (intern (concat "bmkp-bmenu-sort-" (bmkp-replace-regexp-in-string
 240                                                       "\\s-+" "-" sort-order)))))
 241     `(progn
 242       (setq bmkp-sort-orders-alist  (bmkp-assoc-delete-all ,sort-order (copy-sequence
 243                                                                         bmkp-sort-orders-alist)))
 244       (push (cons ,sort-order ',comparer) bmkp-sort-orders-alist)
 245       (defun ,command ()
 246         ,(concat doc-string "\nRepeating this command cycles among normal sort, reversed \
 247 sort, and unsorted.")
 248         (interactive)
 249         (bmkp-bmenu-barf-if-not-in-menu-list)
 250         (cond (;; Not this sort order - make it this sort order.
 251                (not (equal bmkp-sort-comparer ',comparer))
 252                (setq bmkp-sort-comparer   ',comparer
 253                      bmkp-reverse-sort-p  nil))
 254               (;; This sort order reversed.  Change to unsorted.
 255                bmkp-reverse-sort-p
 256                (setq bmkp-sort-comparer   nil))
 257               (t;; This sort order - reverse it.
 258                (setq bmkp-reverse-sort-p  t)))
 259         (message "Sorting...")
 260         (bookmark-bmenu-ensure-position)
 261         (let ((current-bmk  (bookmark-bmenu-bookmark)))
 262           (bookmark-bmenu-surreptitiously-rebuild-list)
 263           (bmkp-bmenu-goto-bookmark-named current-bmk)) ; Put cursor back on right line.
 264         (when (interactive-p)
 265           (bmkp-msg-about-sort-order
 266            ,sort-order
 267            nil
 268            (cond ((and (not bmkp-reverse-sort-p)
 269                        (equal bmkp-sort-comparer ',comparer)) "(Repeat: reverse)")
 270                  ((equal bmkp-sort-comparer ',comparer)       "(Repeat: unsorted)")
 271                  (t                                           "(Repeat: sort)"))))))))
 272
 273 ;;;###autoload
 274 (defmacro bmkp-define-file-sort-predicate (att-nb)
 275   "Define a predicate for sorting bookmarks by file attribute ATT-NB.
 276 See function `file-attributes' for the meanings of the various file
 277 attribute numbers.
 278
 279 String attribute values sort alphabetically; numerical values sort
 280 numerically; nil sorts before t.
 281
 282 For ATT-NB 0 (file type), a file sorts before a symlink, which sorts
 283 before a directory.
 284
 285 For ATT-NB 2 or 3 (uid, gid), a numerical value sorts before a string
 286 value.
 287
 288 A bookmark that has file attributes sorts before a bookmark that does
 289 not.  A file bookmark sorts before a non-file bookmark.  Only local
 290 files are tested for attributes - remote-file bookmarks are treated
 291 here like non-file bookmarks."
 292   `(defun ,(intern (format "bmkp-file-attribute-%d-cp" att-nb)) (b1 b2)
 293     ,(format "Sort file bookmarks by attribute %d.
 294 B1 and B2 are bookmarks or bookmark names.
 295 Sort bookmarks with file attributes before those without attributes
 296 Sort file bookmarks before non-file bookmarks.
 297 Treat remote file bookmarks like non-file bookmarks."
 298              att-nb)
 299     (setq b1  (bookmark-get-bookmark b1))
 300     (setq b2  (bookmark-get-bookmark b2))
 301     (let (a1 a2)
 302       (cond (;; Both are file bookmarks.
 303              (and (bmkp-file-bookmark-p b1) (bmkp-file-bookmark-p b2))
 304              (setq a1  (file-attributes (bookmark-get-filename b1))
 305                    a2  (file-attributes (bookmark-get-filename b2)))
 306              (cond (;; Both have attributes.
 307                     (and a1 a2)
 308                     (setq a1  (nth ,att-nb a1)
 309                           a2  (nth ,att-nb a2))
 310                     ;; Convert times and maybe inode number to floats.
 311                     ;; The inode conversion is kludgy, but is probably OK in practice.
 312                     (when (consp a1) (setq a1  (bmkp-float-time a1)))
 313                     (when (consp a2) (setq a2  (bmkp-float-time a2)))
 314                     (cond (;; (1) links, (2) maybe uid, (3) maybe gid, (4, 5, 6) times
 315                            ;; (7) size, (10) inode, (11) device.
 316                            (numberp a1)
 317                            (cond ((< a1 a2)  '(t))
 318                                  ((> a1 a2)  '(nil))
 319                                  (t          nil)))
 320                           ((= 0 ,att-nb) ; (0) file (nil) < symlink (string) < dir (t)
 321                            (cond ((and a2 (not a1))               '(t)) ; file vs (symlink or dir)
 322                                  ((and a1 (not a2))               '(nil))
 323                                  ((and (eq t a2) (not (eq t a1))) '(t)) ; symlink vs dir
 324                                  ((and (eq t a1) (not (eq t a2))) '(t))
 325                                  ((and (stringp a1) (stringp a2))
 326                                   (if (string< a1 a2) '(t) '(nil)))
 327                                  (t                               nil)))
 328                           ((stringp a1) ; (2, 3) string uid/gid, (8) modes
 329                            (cond ((string< a1 a2)  '(t))
 330                                  ((string< a2 a1)  '(nil))
 331                                  (t                nil)))
 332                           ((eq ,att-nb 9) ; (9) gid would change if re-created. nil < t
 333                            (cond ((and a2 (not a1))  '(t))
 334                                  ((and a1 (not a2))  '(nil))
 335                                  (t                  nil)))))
 336                    (;; First has attributes, but not second.
 337                     a1
 338                     '(t))
 339                    (;; Second has attributes, but not first.
 340                     a2
 341                     '(nil))
 342                    (;; Neither has attributes.
 343                     t
 344                     nil)))
 345             (;; First is a file, second is not.
 346              (bmkp-local-file-bookmark-p b1)
 347              '(t))
 348             (;; Second is a file, first is not.
 349              (bmkp-local-file-bookmark-p b2)
 350              '(nil))
 351             (t;; Neither is a file.
 352              nil)))))
 353
 354 ;;;###autoload
 355 (defmacro bmkp-menu-bar-make-toggle (name variable doc message help &rest body)
 356   "Return a valid `menu-bar-make-toggle' call in Emacs 20 or later.
 357 NAME is the name of the toggle command to define.
 358 VARIABLE is the variable to set.
 359 DOC is the menu-item name.
 360 MESSAGE is the toggle message, minus status.
 361 HELP is `:help' string.
 362 BODY is the function body to use.  If present, it is responsible for
 363 setting the variable and displaying a status message (not MESSAGE)."
 364   (if (< emacs-major-version 21)
 365       `(menu-bar-make-toggle ,name ,variable ,doc ,message ,@body)
 366     `(menu-bar-make-toggle ,name ,variable ,doc ,message ,help ,@body)))
 367
 368 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 369
 370 (provide 'bookmark+-mac)
 371
 372 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 373 ;;; bookmark+-mac.el ends here