Re: Browse skeleton positions

[Ian Zimmerman <bayard@newsguy.com>]

Stefan> Well, then.  Maybe the "many markers" will not be a real problem
Stefan> (it typically only shows up once you have hundreds of markers in
Stefan> the current buffer, so maybe it won't affect your code in
Stefan> practice).  Otherwise, you might want to put an upper-limit,
Stefan> maybe using a ring.

Stefan> How about a less in-your-face mode that lets you edit the text
Stefan> at the same time as you navigate between the different markers ?

Ian> But then you'd need more complicated, harder to type (and to
Ian> retype, in particular) keybindings.  This is a general dilemma
Ian> which I have resolved for myself in favor of special modes like
Ian> this one.  See also wmanip.el which I have posted some time ago,
Ian> similar idea.

Stefan> You could maybe have an alternate minor mode, providing the same
Stefan> bindings but under a prefix key, so users can choose between the
Stefan> two styles.

OK, here's the latest - does it address some of the concerns?

;;; skelposn.el --- browse skeleton positions after insertion
;; Copyright (C) Ian Zimmerman, October 2003
;; Terms: GNU General Public License, Version 2

(defconst skeleton-position-mode-map
  (let ((kmap (make-sparse-keymap)))
    (suppress-keymap kmap)
    (define-key kmap "q" 'turn-off-skeleton-position-mode)
    (define-key kmap "\C-m" 'skeleton-position-exit)
    (define-key kmap "n" 'skeleton-position-next)
    (define-key kmap "p" 'skeleton-position-prev)
    (define-key kmap "a" 'skeleton-position-first)
    (define-key kmap "z" 'skeleton-position-last)
    kmap)
  "Keymap used in Skeleton Position mode.")

(defconst skeleton-position-carpal-mode-map
  (let ((kmap (make-sparse-keymap)))
    (define-key kmap "\C-c+q" 'turn-off-skeleton-position-carpal-mode)
    (define-key kmap "\C-c+\C-m" 'skeleton-position-carpal-exit)
    (define-key kmap "\C-c+n" 'skeleton-position-carpal-next)
    (define-key kmap "\C-c+p" 'skeleton-position-carpal-prev)
    (define-key kmap "\C-c+a" 'skeleton-position-carpal-first)
    (define-key kmap "\C-c+z" 'skeleton-position-carpal-last)
    kmap)
  "Keymap used in Skeleton Position Carpal mode.")

(defvar skeleton-position-max-list-length 50
  "*How many markers per buffer to keep in skeleton position mode.
If nil or negative, the lists of markers are allowed to grow
without limit, which can slow down Emacs dramatically.")

\f

;;;###autoload
(define-minor-mode skeleton-position-mode
  "Set or toggle the Skeleton Position minor mode.
\\<skeleton-position-mode-map>  This mode provides an interface to
browse the list of interesting position after a skeleton is inserted.

\\[skeleton-position-next] - Move to the next marker in `skeleton-position-marker-list'.
\\[skeleton-position-prev] - Move to the previous marker in `skeleton-position-marker-list'.
\\[skeleton-position-first] - Move to the first marker in `skeleton-position-marker-list'.
\\[skeleton-position-last] - Move to the last marker in `skeleton-position-marker-list'.
\\[skeleton-position-exit] - Clean up old skeleton positions and exit Skeleton Position mode."
  nil " SkelPosn" skeleton-position-mode-map)

;;;###autoload
(defun turn-on-skeleton-position-mode ()
  "Turn on the Skeleton Position minor mode."
  (interactive)
  (skeleton-position-mode 1))

(defun turn-off-skeleton-position-mode ()
  "Turn off the Skeleton Position minor mode."
  (interactive)
  (skeleton-position-mode 0))

(defvar skeleton-position-marker-list nil
  "List of markers pointing to skeleton positions in a buffer.")

(make-variable-buffer-local 'skeleton-position-marker-list)

(defvar skeleton-position-push-mark nil
  "\\<skeleton-position-mode-map>\
When set, causes \\[skeleton-position-next] and \\[skeleton-position-prev] \
in Skeleton Position mode to push a mark at point.")

(make-variable-buffer-local 'skeleton-position-push-mark)

(defvar skeleton-position-current nil
  "\\<skeleton-position-mode-map>\
The last position visited by \\[skeleton-position-next] or \\[skeleton-position-prev] \
in Skeleton Position mode, as a pointer into `skeleton-position-marker-list'.")

(make-variable-buffer-local 'skeleton-position-current)

(defun skeleton-end-hook-skelposn ()
  (setq skeleton-position-marker-list
        (append
         (nreverse
          (mapcar
           (lambda (p) (copy-marker p t))
           skeleton-positions))
         skeleton-position-marker-list))
  (let ((l (length skeleton-position-marker-list)))
    (when (and (integerp skeleton-position-max-list-length)
               (>= skeleton-position-max-list-length 0)
               (< skeleton-position-max-list-length l))
      (let* ((rest-length (- l skeleton-position-max-list-length))
             (rest
              (nthcdr
               skeleton-position-max-list-length
               skeleton-position-marker-list))
             (head (nbutlast skeleton-position-marker-list rest-length)))
        (when (and (consp skeleton-position-current)
                   (memq (car skeleton-position-current) rest))
          (setq skeleton-position-current nil))
        (mapcar (lambda (m) (set-marker m nil)) rest)
        (setq skeleton-position-marker-list head))))
  (when (and skeleton-position-marker-list
             (null skeleton-position-current))
    (setq skeleton-position-push-mark t)))  

(unless (featurep 'skelposn)
  (add-hook 'skeleton-end-hook 'skeleton-end-hook-skelposn))

(defun skeleton-position-next (&optional n)
  "Move to the next marker in `skeleton-position-marker-list'.

With an argument N, move to the Nth next marker on the list,
after `skeleton-position-current' instead.
If N is zero or negative, move to the Nth previous marker on the list.
The first call after a skeleton is inserted pushes a mark before moving."
  (interactive "p")
  (if (< n 0) (skeleton-position-prev n)
    (unless skeleton-position-current
      (setq skeleton-position-current (last skeleton-position-marker-list)))
    (while (> n 0)
      (while (and skeleton-position-current
                  (cdr skeleton-position-current)
                  (> n 0))
        (setq skeleton-position-current (cdr skeleton-position-current)
              n (1- n)))
      (when (> n 0)
        (setq n (1- n)
              skeleton-position-current skeleton-position-marker-list)))
    (when (null skeleton-position-current) (error "No more skeleton positions"))
    (when skeleton-position-push-mark
      (when (/= (point) (car skeleton-position-current)) (push-mark))
      (setq skeleton-position-push-mark nil))
    (goto-char (car skeleton-position-current))))

(defun skeleton-position-prev (&optional n)
  "Move to the previous marker in `skeleton-position-marker-list'.

With an argument N, move to the Nth previous marker on the list,
before `skeleton-position-current' instead.
If N is zero or negative, move to the Nth next marker on the list.
The first call after a skeleton is inserted pushes a mark before moving."
  (interactive "p")
  (if (< n 0) (skeleton-position-next n)
    (unless skeleton-position-current
      (setq skeleton-position-current skeleton-position-marker-list))
    (setq skeleton-position-marker-list (nreverse skeleton-position-marker-list))
    (unwind-protect
        (while (> n 0)
          (while (and skeleton-position-current
                      (cdr skeleton-position-current)
                      (> n 0))
            (setq skeleton-position-current (cdr skeleton-position-current)
                  n (1- n)))
          (when (> n 0)
            (setq n (1- n)
                  skeleton-position-current skeleton-position-marker-list)))
      (setq skeleton-position-marker-list (nreverse skeleton-position-marker-list)))
    (when (null skeleton-position-current) (error "No more skeleton positions"))
    (when skeleton-position-push-mark
      (when (/= (point) (car skeleton-position-current)) (push-mark))
      (setq skeleton-position-push-mark nil))
    (goto-char (car skeleton-position-current))))

(defun skeleton-position-first ()
  "Move to the first marker in `skeleton-position-marker-list'."
  (interactive)
  (setq skeleton-position-current skeleton-position-marker-list)
  (when (null skeleton-position-current) (error "No more skeleton positions"))
  (when skeleton-position-push-mark
    (when (/= (point) (car skeleton-position-current)) (push-mark))
    (setq skeleton-position-push-mark nil))
  (goto-char (car skeleton-position-current)))  

(defun skeleton-position-last ()
  "Move to the last marker in `skeleton-position-marker-list'."
  (interactive)
  (setq skeleton-position-current (last skeleton-position-marker-list))
  (when (null skeleton-position-current) (error "No more skeleton positions"))
  (when skeleton-position-push-mark
    (when (/= (point) (car skeleton-position-current)) (push-mark))
    (setq skeleton-position-push-mark nil))
  (goto-char (car skeleton-position-current)))  

(defun skeleton-position-cleanup ()
  (when skeleton-position-current
    (let ((rest (cdr skeleton-position-current)))
      (setcdr skeleton-position-current nil)
      (setq skeleton-position-current nil)
      (mapcar (lambda (m) (set-marker m nil)) skeleton-position-marker-list)
      (setq skeleton-position-marker-list rest))))  

(defun skeleton-position-exit ()
  "Clean up old skeleton positions and exit Skeleton Position mode."
  (interactive)
  (skeleton-position-cleanup)
  (turn-off-skeleton-position-mode))

\f

;;;###autoload
(define-minor-mode skeleton-position-carpal-mode
  "Set or toggle the Skeleton Position Carpal minor mode.
\\<skeleton-position-carpal-mode-map> This mode provides an interface to
browse the list of interesting position after a skeleton is inserted.
It is like `skeleton-position-mode', but does not rebind any normal
editing keystrokes.

\\[skeleton-position-carpal-next] - Move to the next marker in `skeleton-position-marker-list'.
\\[skeleton-position-carpal-prev] - Move to the previous marker in `skeleton-position-marker-list'.
\\[skeleton-position-carpal-first] - Move to the first marker in `skeleton-position-marker-list'.
\\[skeleton-position-carpal-last] - Move to the last marker in `skeleton-position-marker-list'.
\\[skeleton-position-carpal-exit] - Clean up old skeleton positions and exit Skeleton Position Carpal mode."
  nil " SkelCarp" skeleton-position-carpal-mode-map)

(defalias 'skeleton-position-carpal-next 'skeleton-position-next)
(defalias 'skeleton-position-carpal-prev 'skeleton-position-prev)
(defalias 'skeleton-position-carpal-first 'skeleton-position-first)
(defalias 'skeleton-position-carpal-last 'skeleton-position-last)

;;;###autoload
(defun turn-on-skeleton-position-carpal-mode ()
  "Turn on the Skeleton Position minor mode."
  (interactive)
  (skeleton-position-carpal-mode 1))

(defun turn-off-skeleton-position-carpal-mode ()
  "Turn off the Skeleton Position minor mode."
  (interactive)
  (skeleton-position-carpal-mode 0))

(defun skeleton-position-carpal-exit ()
  "Clean up old skeleton positions and exit Skeleton Position Carpal mode."
  (interactive)
  (skeleton-position-cleanup)
  (turn-off-skeleton-position-carpal-mode))

\f
;;;###autoload
(defun skeleton-position-reset ()
  "Clean up all saved skeleton positions."
  (interactive)
  (mapcar (lambda (m) (set-marker m nil)) skeleton-position-marker-list)
  (setq skeleton-position-marker-list nil)
  (setq skeleton-position-current nil))

(provide 'skelposn)

;;; skelposn.el ends here


-- 
"Rap music is our punishment for neglecting music education."
An anonymous teacher