; This is an attempt to re-create the buffer-edit package, which
; was missing from the distribution supplied to us.   MKC Paisley

(setq-default &be-name "")

(defun
    (buffer-edit bn
	(setq bn (current-buffer-name))
;	(message "sorting buffer list ...")
;	(sit-for 0)
	(save-window-excursion
	    (list-buffers)
	    (temp-use-buffer "*buffedit*")
	    (setq needs-checkpointing 0)
	    (erase-buffer)
	    (pop-to-buffer "Buffer list")
	    (setq mode-line-format "Buffer edit in progress")
	    (setq needs-checkpointing 0)
	    (next-line) (next-line)
;	    (set-mark)
;	    (end-of-file)
;	    (filter-region "sort -r +.10 -")
;	    (beginning-of-file) (next-line) (next-line)
	    (search-forward bn) (beginning-of-line)
	    (message "Type ? for Buffer-edit commands")
	    (sit-for 0)
	    (setq needs-checkpointing 0)
	    (setq-default c 0)
	    (define-keymap "buffer-keymap")
	    (use-global-map "buffer-keymap")
	    (while (<= c 0177)
	       (bind-to-key "#be-illegal" c)
	       (setq c (+ c 1))
	    )
	    (bind-to-key "next-line" "n")
	    (bind-to-key "previous-line" "p")
	    (bind-to-key "#be-command" "d")
	    (bind-to-key "#be-command" "c")
	    (bind-to-key "#be-command" "r")
	    (bind-to-key "#be-command" "s")
	    (bind-to-key "#be-command" "m")
	    (bind-to-key "#be-unmark" "u")
	    (bind-to-key "#be-edit" "e")
	    (bind-to-key "#be-quit" "q")
	    (bind-to-key "#be-goto" "g")
	    (bind-to-key "#be-help" "?")
	    (save-excursion (recursive-edit))
	    (use-global-map "default-global-keymap")
	)
        (if (!= &be-name "")
	    (progn (switch-to-buffer &be-name)(delete-other-windows))
	)
    )

    (#be-illegal
	(message "Type ? for help with buffer edit")
	(illegal-operation)
    )

    (#be-command c
	    (setq c (last-key-struck))
	    (#be-buffer)
	    (insert-character c)
	    (switch-to-buffer "Buffer list")
	    (delete-next-character)
	    (insert-character (- c 32))
	    (backward-character)
    )

    (#be-unmark
	(#be-buffer)
	(insert-character 'u')
	(switch-to-buffer "Buffer list")
	(delete-next-character)
	(insert-character ' ')
	(backward-character)
    )

    (#be-edit m
	(save-excursion
		(pop-to-buffer (#be-get-name))
		(use-global-map "default-global-keymap")
		(recursive-edit)
		(setq m buffer-is-modified)
		(use-global-map "buffer-keymap")
	)
	(if m
	    (progn
		(while (!= 16 (current-column)) (forward-character))
		(delete-previous-character) (insert-string "M")
		(beginning-of-line)
	    )
	)
    )

    (#be-quit
	(setq &be-name "")
	(exit-emacs)
    )

    (#be-goto
	(setq &be-name (#be-get-name))
	(#be-execute)
	(exit-emacs)
    )

    (#be-get-name n
	(save-excursion
	    (while (!= 17 (current-column)) (forward-character))
	    (set-mark)
	    (while (!= 31 (current-column)) (forward-character))
	    (while (= ' ' (preceding-char)) (backward-character))
	    (setq n (region-to-string))
	)
	n
    )

    (#be-buffer bn
	    (setq bn (concat (#be-get-name) "\001"))
	    (temp-use-buffer "*buffedit*")
	    (beginning-of-file)
	    (if (error-occured (search-forward bn))
		(progn
		    (end-of-file)
		    (insert-string bn) (insert-string "\001")
		    (backward-character)
		)
	    )
    )

    (#be-execute bn cc
	    (switch-to-buffer "*buffedit*")
	    (beginning-of-file)
	    (while (! (eobp))
		(set-mark)
		(search-forward "\001")
		(backward-character)
		(setq bn (region-to-string))
		(forward-character)
		(setq cc (following-char))
		(#be-perform bn cc)
		(search-forward "\001")
	    )
    )

    (#be-perform action fname
	(setq action (char-to-string (arg 2)))
	(save-excursion
	    (if (= action "d") (delete-buffer (arg 1)))
	    (if (= action "c")
		(progn
		    (switch-to-buffer (arg 1))
		    (if (!= "" (current-file-name))
			(write-current-file))
		    (switch-to-buffer "*buffedit*")
		    (delete-buffer (arg 1))
		)
	    )
	    (if (= action "r")
		(progn
		    (switch-to-buffer (arg 1))
		    (if (!= "" (current-file-name))
			(read-file (current-file-name))
		    )
		)
	    )
	    (if (= action "s")
		(progn
		    (switch-to-buffer (arg 1))
		    (if (!= (current-file-name ""))
			(write-current-file))
		)
	    )
	    (if (= action "m")
		(progn
		    (switch-to-buffer (arg 1))
		    (setq buffer-is-modified 0)
	        )
	    )
	)
    )

    (#be-help
	(save-excursion
		(pop-to-buffer "Help")
		(setq needs-checkpointing 0)
		(erase-buffer)
		(insert-string (concat
" Use 'p' and 'n' to move up and down the buffer list.\n"
"  The following marks are executed when you use the 'g' command:\n"
"	d	this buffer to be deleted\n"
"	c	this buffer to be closed (written out and deleted)\n"
"	r	this buffer to be reverted (contents replaced by file)\n"
"	s	this buffer to be saved\n"
"	m	this buffer to be treated as unmodified (not to be saved)\n"
"	u	remove mark		   e	recursively edit the buffer\n"
"	q	quit without processing	   ?	print this help text\n"
"	g	process the buffer marks and go to this buffer\n"
		))
		(beginning-of-file)
	)
    )
)

(bind-to-key "buffer-edit" "\^X\^B")
