;;; buc --- move between buffers based on category

;;; Commentary:
;;;
;;; Move between similar buffers. So far, I have only
;;; found use for this for accessing man-pages; see:
;;; ~/.emacs.d/emacs-init/man-my.el
;;;
;;; The principle behind the interface is similar to
;;; that of a computer hardware cache: proximity in
;;; space and time, with updates after every access.
;;;
;;; It is especially useful for setups when you can't
;;; have that many buffers around (otherwise you can
;;; just have all manpages on top, simultaneously, for
;;; example).
;;;
;;; This interface is an interesting hybrid between
;;; the GUI and CLI style (with the "icons" here being
;;; words, which is the way humans read, by the way).
;;; Note that though the interface adds functionality
;;; compared to the default for manpages, there is no
;;; trade-off because you can still ignore the
;;; information offered and just type, like you would
;;; `M-x man RET manpage RET'.
;;;
;;; A screenshot to exemplify:
;;;
;;;     http://user.it.uu.se/~embe8573/dumps/buc.png

;;; Code:

(require 'cl-macs)

(defvar nav-keys     nil "The keys used to select buffers.")
(defvar nav-keys-str nil "Descriptions of the buffer-select keys.")
(progn
  (setq nav-keys     '(?\r ?\s ?\t ?\d ?\C-j ?\C-k ?\C-l ?\C-u ?\C-o ?\C-p))
  (setq nav-keys-str  (split-string (key-description nav-keys))) ) ; reset

(defun extract-strings (strings match)
  "From STRINGS, get a list with the parts that MATCH."
  (remove nil
    (mapcar
     (lambda (string)
       (when (string-match match string) (match-string 1 string) ))
     strings) ))

(defun buffer-names ()
  "Get a list of all `buffer-name's."
  (mapcar #'buffer-name (buffer-list)) )

(defun get-ps (names)
  "Make the prompt-string, with NAMES."
  (let ((k -1)
        (s " ["))
    (dolist (e names (concat s "] "))
      (setq s (format "%s %s:%s "
                      s (nth (cl-incf k) nav-keys-str) e) ))))

(defun navigate-buffer-category (prefix &optional bad-key &rest args)
  "Display all buffers that start with PREFIX.
If none of the offered buffers are chosen by the user's keystroke,
evaluate (BAD-KEY ARGS)."
  (let ((pages (extract-strings
                (buffer-names)
                (format "%s%s" prefix "\\(.*\\)\\*") )))
    (if pages
        (let*((ps (get-ps pages))
              (key (read-key ps))
              (page-index    (cl-position key nav-keys))
              (page          (when page-index (nth page-index pages))) )
          (if (= key 7) (message "Quit")
            (if page (switch-to-buffer (format "%s%s*" prefix page))
              (when bad-key (apply bad-key `(,@args ,key)) ))))
      (if bad-key (apply bad-key args)
        (message "Empty category, and no fallback function.") ))))

(defun switch-to-type (ps fun &optional key)
  "Ask for a string with the prompt-string PS.
Use the string as input to FUN.
If KEY, it'll be the first KEY of the string, auto-inserted."
  (apply fun `(,(read-string ps (when key (char-to-string key)) nil))) )

(defun article-buc ()
  "Show articles.  If you type, nothing will happen."
  (interactive)
  (navigate-buffer-category "*Article ") )

(defun man-buc ()
  "Show manpages.  If you type, you get the common prompt."
  (interactive)
  (navigate-buffer-category "*Man "
                            #'switch-to-type "Man page: " 'man) )

(provide 'buc)
;;; buc.el ends here