;;; buffers.el -- extra buffer-list handling functions
;;; Time-stamp: <2006-03-09 15:10:06 john>
;;; old time stamp was <89/09/15 19:49:28 jcgs>

(provide 'buffers)

;; Oddments to do with buffers. Some of them provide parameterized versions
;; of things that GNUemacs only provides for the current buffer. There are
;; some commands here for massive excision of buffers by regular expression
;; match on buffer or mode names.

(defun any-buffer-size (buffer)
  "Return the size of BUFFER."
  (set-buffer buffer)
  (buffer-size))

(defun total-size ()
  "Count up how many characters are stored in all the buffers."
  (interactive)
  (let ((total
         (apply (symbol-function '+)
                (mapcar (symbol-function 'any-buffer-size) (buffer-list)))))
    (if (interactive-p)
        (message "You have %d characters stored in the buffers." total))
    total))

(defun list-matching-buffers (buffers regexp accessor)
  "Return a list of all buffers in BUFFERS which match REGEXP.
The match is done on the (string) property returned by the function bound
to the symbol ACCESSOR."
  (cond
   ((null buffers)
    nil)
   ((string-match regexp
                  (funcall accessor (car buffers)))
    (cons (car buffers) (list-matching-buffers
                         (cdr buffers)
                         regexp
                         accessor)))
   ('else
    (list-matching-buffers
     (cdr buffers)
     regexp
     accessor))))

(defun apply-to-buffers-matching-on-field (regexp field-accessor fn)
  "To buffers for which REGEXP matches the result of FIELD-ACCESSOR, apply FN."
  (let ((buffers-to-kill (list-matching-buffers
                          (buffer-list)
                          regexp field-accessor)))
    (length (mapcar (symbol-function fn)
		    buffers-to-kill))))

(defun kill-matching-buffers (regexp)
  "Kill buffers whose names match REGEXP. Returns how many buffers it
killed."
  (interactive "sKill buffers matching (regexp): ")
  (apply-to-buffers-matching-on-field regexp 'buffer-name 'kill-buffer))

(defun bury-matching-buffers (regexp)
  "Bury buffers whose names match REGEXP. Returns how many buffers it
buryed."
  (interactive "sBury buffers matching (regexp): ")
  (apply-to-buffers-matching-on-field regexp 'buffer-name 'bury-buffer))

(defun kill-mode-buffers (regexp)
  "Kill buffers whose mode names match REGEXP. Returns how many
buffers it killed."
  (interactive "sKill buffers with mode matching (regexp): ")
  (apply-to-buffers-matching-on-field regexp 'buffer-mode-name 'kill-buffer))

(defun safe-buffer-file-name (buffer)
  "Return the file name of BUFFER, or \"\" if it is not visiting a file."
  (let ((x (buffer-file-name buffer)))
    (if (zerop (length x)) "" x)))

(defun kill-buffers-matching-file (regexp)
  "Kill buffers whose names match REGEXP. Returns how many buffers it
killed."
  (interactive "sKill buffers for files matching (regexp): ")
  (let ((n (apply-to-buffers-matching-on-field regexp 'safe-buffer-file-name 'kill-buffer)))
    (if (interactive-p) (message "%d down, %d to go" n (length (buffer-list))))
    n))

(defun bring-up-buffers-matching-file (regexp)
  "Bring up buffers whose names match REGEXP. Returns how many buffers it
brought up."
  (interactive "sBring up buffers for files matching (regexp): ")
  (apply-to-buffers-matching-on-field regexp
				      'safe-buffer-file-name
				      'switch-to-buffer))

(defun bury-buffers-matching-file (regexp)
  "Bury buffers whose names match REGEXP. Returns how many buffers it
buried."
  (interactive "sBury buffers for files matching (regexp): ")
  (apply-to-buffers-matching-on-field regexp
				      'safe-buffer-file-name
				      'bury-buffer))

(defun buffer-mode (buffer)
  "Return the major mode of BUFFER, as a symbol. BUFFER may be a
buffer, or a string naming a buffer."
  (let ((buf (get-buffer buffer)))
    (if (bufferp buf)
        (progn
          (set-buffer buf)
          major-mode)
      nil)))

(defun buffer-mode-name (buffer)
  "Return the major mode of BUFFER, as a string. BUFFER may be a
buffer, or a string naming a buffer."
  (symbol-name (buffer-mode buffer)))

(defun switch-to-first-buffer-matching (regexp)
  "Switch to the most recently used buffer matching REGEXP."
  (interactive "sSwitch to first buffer matching (regexp): ")
  (let ((bl (buffer-list)))
    (while bl
      (if (string-match regexp (buffer-name (car bl)))
	  (progn
	    (switch-to-buffer (car bl))
	    (setq bl nil))
	(setq bl (cdr bl))))))

(defun lines-per-second (rate)
  "Scroll the screen up at RATE lines per second."
  (interactive "p")
  (message "Type any key to stop")
  (while (not (or (eobp) (input-pending-p)))
    (scroll-up rate)
    (sit-for 1))
  (if (eobp)
      (message "Done")
    (progn
      (message "Stopped")
      (read-char))))                    ; throw away stopping character

(defun rec-bury-n-bufs (how-many buf-list)
  "Bury the top HOW-MANY buffers in BUF-LIST."
  (if (or (< how-many 0) (not (null buf-list)))
      (progn
        (bury-buffer (car buf-list))
        (rec-bury-n-bufs (1- how-many) (cdr buf-list)))))

(defun bury-n-buffers (how-many)
  "Bury the top HOW-MANY buffers."
  (interactive "p")
  (rec-bury-n-bufs how-many (buffer-list)))

(defun kill-buffer-if-ordinary (buffer)
  "Kill BUFFER if its name does not begin with a space."
  (if (not (string= " " (substring (buffer-name buffer) 0 1)))
      (kill-buffer buffer)))

(defun trim-buffer-list (how-many)
  "Trim the buffer list leaving HOW-MANY ordinary buffers. Special
buffers (distinguished by their names beginning with a space, not
listed by most buffer listing user commands) are not killed. (This
is important; killing certain buffers can crash GNUemacs.)"
  (interactive "nLeave how many buffers: ")
  (save-some-buffers)
  (mapcar (symbol-function 'kill-buffer-if-ordinary)
          (nthcdr how-many (buffer-list))))

(defun kill-buffer-if-too-large (buffer)
  "Kill BUFFER if it is larger than the fluid variable  size ."
  (if (> (any-buffer-size buffer) size)
      (kill-buffer buffer)))

(defun trim-big-buffers (size)
  "Remove any buffers larger than SIZE."
  (interactive "nKill buffers above how many bytes long: ")
  (save-some-buffers)
  (mapcar (symbol-function 'kill-buffer-if-too-large)
          (buffer-list)))

(defun bury-this-buffer (buffer)
  "Bury the given buffer - like bury-buffer, but callable interactively."
  (interactive "bBury buffer: ")
  (let ((b (current-buffer)))
    (bury-buffer buffer)
    (if t ; (equal buffer b)
        (switch-to-buffer (other-buffer buffer)))))

(defun swap-windows ()
  "Swap the buffer in the current window with the buffer in the next window."
  (interactive)
  (let* ((buffer-a (current-buffer))
         (buffer-b (progn (other-window 1) (current-buffer))))
    (switch-to-buffer buffer-a)         ; in the second window
    (other-window -1)
    (switch-to-buffer buffer-b)))       ; in the first window

(defun normal-buffers-uppermost ()
  "Send unusual (probably non-file) buffers to the bottom of the list."
  (interactive)
  (bury-matching-buffers "^[ *]"))

(defun reverse-buffer-list ()
  "Reverse the order of the buffer list. Useful if you've just brought
up a lot of buffers that you don't really want (eg with a
tags-loop-continue) and want to bring up your old favourites before
doing a trim-buffer-list."
  (interactive)
  (mapcar (symbol-function 'bury-buffer) (reverse (buffer-list))))

(defun check-file-time (buffer)
  "Check the file/buffer times for BUFFER."
  (if (and (buffer-file-name buffer)
           (verify-visited-file-modtime buffer))
      (if auto-update
          (progn
            (erase-buffer)
            (insert-file-contents (buffer-file-name buffer)))
        (recover-file (buffer-file-name buffer)))))

(defun check-file-changes (&optional auto)
  "Check that all buffers visiting files are up to date w.r.t. their files.
With a prefix argument, update them automatically; without one, query the
user."
  (interactive "p")
  (let ((auto-update auto))
    (mapcar (symbol-function 'check-file-time) (buffer-list))))

;;; end of buffers.el