my-buf-menu.l

my-buf-menu.l

;;; -*- Mode: Lisp; Package: EDITOR -*-
;;;
;;; This file is part of xyzzy.
;;;

(provide "buf-menu")

(in-package "editor")

(export '(*buffer-menu-mode-hook* list-buffers buffer-menu
	  buffer-menu-this-window buffer-menu-1-window buffer-menu-save
	  buffer-menu-delete buffer-menu-delete-backward
	  buffer-menu-not-modified buffer-menu-unmark
	  buffer-menu-execute buffer-menu-mode))

(defvar *buffer-menu-mode-hook* nil)

; ウィンドウを分割しない buffer-menu
(defun list-buffers (&optional file-only)
  (interactive "p")
  (let ((selected (selected-buffer)))
    (with-output-to-temp-buffer ("*Buffer List*")
      (let ((tmp (selected-buffer)))
	(princ " MR Buffer            Size    Line  Mode          File\n")
	(princ " -- ------            ----    ----  ----          ----\n")
	(dolist (buffer (buffer-list))
	  (when (not (eq buffer tmp))
	    (let ((bufname (buffer-name buffer))
		  (filename (get-buffer-file-name buffer)))
	      (unless (or (string= bufname " " :end1 1)
			  (and (null filename) file-only))
		(let ((size (buffer-size buffer))
		      (lines (buffer-lines buffer)))
		  (format t "~:[ ~;.~]~:[ ~;*~]~:[ ~;%~] ~A~VT ~D~VT ~D~35T ~A~:[~;~49T ~:*~A~]~%"
			  (eq buffer selected)
			  (buffer-modified-p buffer)
			  (buffer-local-value buffer 'buffer-read-only)
			  bufname
			  (- 24 (if (zerop size) 0 (floor (log size 10)))) size
			  (- 32 (if (zerop lines) 0 (floor (log lines 10)))) lines
			  (buffer-local-value buffer 'mode-name)
			  filename)))))))
      (goto-char (point-min))
      (buffer-menu-mode))))

(defun buffer-menu ()
  (interactive)
  (list-buffers)
  (goto-line 3)
  (buffer-menu-mark-line))

(defun buffer-menu-buffer-exist-p ()
  (goto-column 1)
  (when (or (looking-at "[-M]")
	    (eobp))
    (plain-error "バッファ名がありません"))
  t)

(defun buffer-menu-buffname ()
  (buffer-menu-buffer-exist-p)
  (buffer-substring (progn
		      (goto-column 4)
		      (point))
		    (progn
		      (or (scan-buffer " +[0-9]+ +[0-9]+ +[^ 0-9]"
				       :regexp t
				       :limit (save-excursion (goto-eol) (point)))
			  (scan-buffer " +[0-9]+ +[0-9]+ " :regexp t))
		      (point))))

(defun buffer-menu-this-window ()
  (interactive)
  (set-buffer (buffer-menu-buffname)))

(defun buffer-menu-1-window ()
  (interactive)
  (set-buffer (buffer-menu-buffname))
  (delete-other-windows))

(defun buffer-menu-other-window ()
  (interactive)
  (switch-to-buffer-other-window (buffer-menu-buffname)))

(defun buffer-menu-save ()
  (interactive)
  (buffer-menu-buffer-exist-p)
  (goto-column 1)
  (let ((buffer-read-only nil))
    (declare (special buffer-read-only))
    (insert #\S)
    (delete-char 1))
  (forward-line 1)
  (buffer-menu-mark-line))

(defun buffer-menu-delete ()
  (interactive)
  (buffer-menu-buffer-exist-p)
  (goto-column 2)
  (let ((buffer-read-only nil))
    (declare (special buffer-read-only))
    (insert #\D)
    (delete-char 1))
  (forward-line 1)
  (buffer-menu-mark-line))

(defun buffer-menu-delete-backward ()
  (interactive)
  (buffer-menu-delete)
  (forward-line -2)
  (when (looking-at " [-M]")
    (forward-line 1))
  (buffer-menu-mark-line)
  t)

(defun buffer-menu-not-modified ()
  (interactive)
  (set-buffer-modified-p nil (buffer-menu-buffname))
  (goto-column 1)
  (let ((buffer-read-only nil))
    (declare (special buffer-read-only))
    (insert #\SPC)
    (delete-char 1))
  (forward-line 1)
  (buffer-menu-mark-line))

(defun buffer-menu-unmark ()
  (interactive)
  (let* ((buffer (buffer-menu-buffname))
	 (read-only (buffer-local-value buffer 'buffer-read-only)))
    (goto-column 1)
    (let ((buffer-read-only nil))
      (declare (special buffer-read-only))
      (insert (if (buffer-modified-p buffer) #\* #\SPC))
      (insert (if read-only #\% #\SPC))
      (delete-char 2))
    (forward-line 1)
    (buffer-menu-mark-line)))

(defun buffer-menu-execute ()
  (interactive)
  (goto-char (point-min))
  (while (scan-buffer "^.S" :regexp t)
    (save-excursion
      (set-buffer (buffer-menu-buffname))
      (save-buffer))
    (forward-line 1))
  (goto-char (point-min))
  (while (scan-buffer "^..D" :regexp t)
    (delete-buffer (buffer-menu-buffname))
    (forward-line 1))
  (buffer-menu-mark-line)
  (buffer-menu))

; 次のウィンドウのバッファを指定する（カーソルはもとのウィンドウにとどまる）
(defun set-buffer-other-window (buffer &optional nowarn)
  (interactive "BSwitch to buffer other window: " :default0 (other-buffer))
  (setq buffer (save-excursion (switch-to-buffer buffer nowarn)))
  (when (minibuffer-window-p (selected-window))
    (other-window))
  (when (= (count-windows) 1)
    (split-window))
  (let ((current-window (selected-window)))
    (set-window (next-window (selected-window) 'foo))
    (set-buffer buffer)
    (set-window current-window))
  buffer)

; 他のウィンドウのバッファを切り替えてバッファリストはそのまま
(defun buffer-menu-other-window-nofocus ()
  (interactive)
  (set-buffer-other-window (buffer-menu-buffname)))

; カーソル行にアンダーライン
(defun buffer-menu-mark-line ()
  (interactive)
  (let ((point-bol)
        (point-eol)
        (point-current (point)))
    (goto-bol)
    (setq point-bol (point))
    (goto-eol)
    (setq point-eol (point))
    (goto-char point-current)
    (delete-text-attributes 'line-marker)
    (set-text-attribute point-bol point-eol 'line-marker :underline 1)
    ))

(defun buffer-menu-next-line ()
  (interactive)
  (next-line)
  (buffer-menu-mark-line))

(defun buffer-menu-previous-line ()
  (interactive)
  (previous-line)
  (buffer-menu-mark-line))


(defun buffer-menu-mode ()
  (interactive)
  (kill-all-local-variables)
  (setq buffer-mode 'buffer-menu-mode)
  (setq mode-name "Buffer menu")
  (use-keymap *buffer-menu-mode-map*)
  (setq buffer-read-only t)
  (set-buffer-fold-width nil)
  (make-local-variable 'kept-undo-information)
  (setq kept-undo-information nil)
  (make-local-variable 'need-not-save)
  (setq need-not-save t)
  (make-local-variable 'auto-save)
  (setq auto-save nil)
  (make-local-variable 'revert-buffer-function)
  (setq revert-buffer-function #'list-buffers)
  (run-hooks '*buffer-menu-mode-hook*))

(defvar *buffer-menu-mode-map* nil)
(unless *buffer-menu-mode-map*
  (setq *buffer-menu-mode-map* (make-sparse-keymap)))

(define-key *buffer-menu-mode-map* #\q 'buffer-menu-1-window)
(define-key *buffer-menu-mode-map* #\1 'buffer-menu-1-window)
(define-key *buffer-menu-mode-map* #\f 'buffer-menu-this-window)
(define-key *buffer-menu-mode-map* #\s 'buffer-menu-save)
(define-key *buffer-menu-mode-map* #\d 'buffer-menu-delete)
(define-key *buffer-menu-mode-map* #\k 'buffer-menu-delete)
(define-key *buffer-menu-mode-map* #\o 'buffer-menu-other-window)
(define-key *buffer-menu-mode-map* #\C-d 'buffer-menu-delete-backward)
(define-key *buffer-menu-mode-map* #\C-k 'buffer-menu-delete)
(define-key *buffer-menu-mode-map* #\x 'buffer-menu-execute)
(define-key *buffer-menu-mode-map* #\~ 'buffer-menu-not-modified)
(define-key *buffer-menu-mode-map* #\u 'buffer-menu-unmark)

; v はファイラの W と同じような動作にする
(define-key *buffer-menu-mode-map* #\v 'buffer-menu-other-window-nofocus)

; vi 風のカーソル移動
(define-key *buffer-menu-mode-map* #\j 'buffer-menu-next-line)
(define-key *buffer-menu-mode-map* #\k 'buffer-menu-previous-line)

(define-key ed::*buffer-menu-mode-map* #\SPC 'ed::buffer-menu-next-line)
(define-key ed::*buffer-menu-mode-map* #\C-n 'ed::buffer-menu-next-line)
(define-key ed::*buffer-menu-mode-map* #\C-p 'ed::buffer-menu-previous-line)
(define-key ed::*buffer-menu-mode-map* #\Down 'ed::buffer-menu-next-line)
(define-key ed::*buffer-menu-mode-map* #\Up 'ed::buffer-menu-previous-line)

; q で閉じる
(define-key *buffer-menu-mode-map* #\q 'kill-selected-buffer)

; Enter で開く
(define-key *buffer-menu-mode-map* #\RET 'buffer-menu-this-window)

(define-key ctl-x-map #\C-b 'buffer-menu)