🚀 go-pugleaf

A few bug fixes and improvements.

-------------------------------------------------  Thierry CAMBON
Phone : (1) 30.80.69.34 		BULL.S.A
Fax   : (1) 30.80.74.79                 Rue Jean Jaures       B.P.68
Email : T.Cambon@frcl.bull.fr	        78340 Les Clayes sous Bois     FRANCE


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; File:         file-menu.el
;; Description:  provide a menu of files for selection with the mouse (epoch only). 
;; Author:       Thierry Cambon (T.Cambon@frcl.bull.fr)
;; Created:      FRI Aug 6 1993
;; Modified:     WED Aug 11 1993 
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

;; Installation:
;;
;; Byte-compile file-menu.el to file-menu.elc and put them both in a directory
;; on your load-path.  Load the package from your .emacs file with:
;;
;;   (require 'file-menu).
;;

;; Usage: click control-mouse-left in your current editing screen to pop up an epoch screen
;; named "File Menu" and containing the names of the files you are editing. To switch to the 
;; buffer you want to edit, just click (mouse-left) on its name. 
;; To delete the file menu screen, click ctrl-mouse-left on it.
;;
;; customization:
;; Define your own switch-to-buffer and kill-buffer so that they call fmenu-update-file-menu
;; find-file is redefined at the end of this file.
;; Change font, foreground and background color, cursor glyph of the file menu screen
;; by setting the appropriate variables (see below).

;; Please send me your enhancements, bugs, or fixes.

(provide 'file-menu)

(defvar fmenu-screen-font "7x13bold"
  "Font of the file menu screen.")
(defvar fmenu-screen-foreground "brown"
  "Foreground color of the file menu screen.")
(defvar fmenu-screen-background "wheat"
  "Background color of the file menu screen.")
(defvar fmenu-screen-cursor-glyph 68
  "X cursor glyph number of the file menu screen.")

;; Create a list of buffer names that don't begin with a space or a star.
(defun fmenu-make-file-list ()
  (let ((tail (buffer-list))
	head)
    (while tail
      (let ((elt (car tail)))
	(if (not (string-match "^ \\|^*"
			       (buffer-name elt)))
	    (setq head (cons
			(format
			 "%s"
			 (buffer-name elt))
			head))))
      (setq tail (cdr tail)))
    (setq fmenu-screen-height (if epoch::nonlocal-minibuffer 
				  (+ 1 (length head))
				(+ 2 (length head))))
    (reverse head)))

(defun fmenu-insert-file-name-in-menu-buffer (buffer-name)
  (if (> (length buffer-name) fmenu-screen-width)
      (setq fmenu-screen-width (length buffer-name)))
  (insert buffer-name)
  (terpri fmenu-file-menu-buffer))

(defun fmenu-insert-list-in-menu-buffer ()
  (mapcar 'fmenu-insert-file-name-in-menu-buffer 
	  (setq fmenu-file-list (fmenu-make-file-list))))

(defun fmenu-switch-to-selected-buffer (args)
  (epoch::ungrab-pointer)
  (mouse::set-point args)
  (let* ((start (progn
		 (beginning-of-line)
		 (point)))
	 (end (progn
		(end-of-line)
		(point)))
	 (buffer (buffer-substring start end)))
    (epoch::select-screen fmenu-current-screen)
    (switch-to-buffer buffer) 
;;    (buffer-title-screen) ;; if scr-title is loaded
    (fmenu-update-file-menu)
))

(defun fmenu-delete-file-menu-screen (args)
  (interactive)
  (epoch::ungrab-pointer)
  (epoch::select-screen fmenu-file-menu-screen)
  (if (and (boundp 'fmenu-file-menu-screen)
	   fmenu-file-menu-screen
	   fmenu-file-menu-buffer)
      (progn
	(set-buffer fmenu-file-menu-buffer)
	(setq buffer-read-only nil)
	(kill-buffer fmenu-file-menu-buffer)
	(epoch::delete-screen fmenu-file-menu-screen)
	(setq fmenu-file-menu-screen nil)
	(setq fmenu-file-menu-buffer nil)
)))

(defun fmenu-update-file-menu ()
  "Update the file menu. This function can be called after a switch-to-buffer
or kill-buffer command. Add it to your find-file-hooks."
  (interactive)
  (if (and (boundp 'fmenu-file-menu-screen)
	   fmenu-file-menu-screen
	   fmenu-file-menu-buffer)
      (progn
	(setq fmenu-screen-width 0)
	(setq fmenu-screen-height 0)
	(epoch::select-screen fmenu-file-menu-screen)
	(switch-to-buffer fmenu-file-menu-buffer)
	(setq buffer-read-only nil)
	(erase-buffer)
	(fmenu-insert-list-in-menu-buffer)
	(fmenu-set-mode-line)
	(setq buffer-read-only t)
	(epoch::change-screen-size (1+ fmenu-screen-width) 
				   fmenu-screen-height 
				   fmenu-file-menu-screen)
	(goto-line 0)
	(epoch::select-screen fmenu-current-screen))))

(defun fmenu-set-mode-line ()
  (let* ((style (make-style))
	 (title "File Menu")
	 (padding (/ (- (1+ fmenu-screen-width) (length title)) 2)))
    (set-style-foreground style fmenu-screen-background)
    (set-style-background style fmenu-screen-foreground)
    (set-style-font style fmenu-screen-font)
    (setq mode-line-format
	  (list
	   style (cons padding "") title style
	   ))))

(defun fmenu-make-file-menu (args)
  "Create an epoch screen containing a list of the files currently edited.
Press mouse-left on a file name to switch to its buffer. Press Ctrl-mouse-left 
in that screen to have it deleted."
  (interactive)
  (epoch::ungrab-pointer)
  (if (and (boundp 'fmenu-file-menu-screen)
	   fmenu-file-menu-screen
	   fmenu-file-menu-buffer)
      (progn
	(set-buffer fmenu-file-menu-buffer)
	(setq buffer-read-only nil)
	(kill-buffer fmenu-file-menu-buffer)
	(epoch::delete-screen fmenu-file-menu-screen)
	(setq fmenu-file-menu-screen nil)
	(setq fmenu-file-menu-buffer nil)))
  (setq fmenu-screen-width 0)
  (setq fmenu-screen-height 0)
  (setq fmenu-current-screen (epoch::current-screen))
  (setq fmenu-current-buffer (window-buffer 
			      (epoch::selected-window fmenu-current-screen)))
  (setq fmenu-file-menu-buffer (get-buffer-create "*File Menu*"))
  (setq fmenu-file-menu-screen (epoch::create-screen 
				(set-buffer fmenu-file-menu-buffer)))
  (epoch::font fmenu-screen-font fmenu-file-menu-screen)
  (fmenu-insert-list-in-menu-buffer)
  (fmenu-set-mode-line)
  (epoch::change-screen-size (1+ fmenu-screen-width) 
			     fmenu-screen-height 
			     fmenu-file-menu-screen)
  (epoch::title "File Menu" fmenu-file-menu-screen)
  (epoch::cursor-glyph fmenu-screen-cursor-glyph fmenu-file-menu-screen)
  (epoch::foreground fmenu-screen-foreground fmenu-file-menu-screen)
  (epoch::background fmenu-screen-background fmenu-file-menu-screen)
  (epoch::cursor-foreground fmenu-screen-foreground fmenu-file-menu-screen)
  (epoch::cursor-background fmenu-screen-background fmenu-file-menu-screen)
  (local-set-mouse mouse-left mouse-down 'fmenu-switch-to-selected-buffer)
  (local-set-mouse mouse-left mouse-control 'fmenu-delete-file-menu-screen)
  (setq buffer-read-only t)
  (epoch::mapraised-screen fmenu-file-menu-screen)
  (epoch::select-screen fmenu-current-screen)
  (set-buffer fmenu-current-buffer))

(global-set-mouse mouse-left mouse-control 'fmenu-make-file-menu)


;; If I use find-file-hooks the new buffer name is at the last position of the
;; buffers list, so I redefine find-file to have the new name at the first position.
(defun find-file (filename)
  (interactive "FFind File: ")
  (switch-to-buffer (find-file-noselect filename))
  (fmenu-update-file-menu))