Re: Browse skeleton positions

[Ian Zimmerman]

;;; 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.")

(defvar skeleton-position-carpal-mode-prefix [?\C-c ?+]
  "*Prefix key sequence for commands in Skeleton Position Carpal mode.")

(defconst skeleton-position-carpal-mode-map
  (let ((kmap (make-sparse-keymap)))
    (define-key kmap skeleton-position-carpal-mode-prefix 
skeleton-position-mode-map)
    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.")



;;;###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))



;;;###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 Carpal minor mode."
  (interactive)
  (skeleton-position-carpal-mode 1))

(defun turn-off-skeleton-position-carpal-mode ()
  "Turn off the Skeleton Position Carpal 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))


;;;###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