🚀 go-pugleaf

Colas' GWM menu support looked so neat (and was much faster than
xmenu-based stuff) that I decided to use it for something else.
Unfortunately, the original version was a bit inflexible...  Here is
the result: 

#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 02/28/1991 17:18 UTC by pierson@xenna
# Source directory /usr/lisp/pierson/bin/elisp
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   1277 -rw-rw-rw- epoch.gwm
#   1992 -rw-rw-rw- gwm-menus.el
#
# ============= epoch.gwm ==============
if test -f 'epoch.gwm' -a X"$1" != X"-c"; then
	echo 'x - skipping epoch.gwm (File already exists)'
else
echo 'x - extracting epoch.gwm (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'epoch.gwm' &&
;;; Code to communicate with epoch
;;; Colas 1991-02-18
;;; Heavily hacked by Dan Pierson, Encore Computer Corp, 2/28/91
;;; 	Explicity specify all Epoch commands in list passed to GWM (as
;;; 	a string)
;;; 	Gratuitously reformat
;;;
;;; this needs the epoch code "gwm-menus.el" loaded into epoch
X
;;; routine to send a string to be executed by epoch, supposed to be the 
;;; current window 
X
(defun send-epoch (code)
X  (set-x-property "EPOCH_EXEC"
X		  (+ "(let ((protect epoch::event-handler)) (unwind-protect "
X		     code
X		     "(setq epoch::event-handler protect))))"
X		     )))
X
;;; Menu package:
;;; How to make a menu of arbitrary Epoch commands
X
(defunq list-menu-make (args)
X  (pop-menu (menu-make-from-list
X	     (+ (list (list 'pop-label-make (# 0 args)))
X		(mapfor s (sublist 1 (length args) args)
X			(list 'item-make (# 0 s)
X			      (list 'send-epoch-command
X				    (sublist 1 (length s) s))))))))
X
(defun stringify (args)
X  (with (t (type args))
X    (cond ((eq t 'string) args)
X	  ((eq t 'list)
X	   (with (s "(")
X	     (for i args (setq s (+ s (stringify i) " ")))
X	     (+ s ")")))
X	  ((or (eq t 'atom)
X	       (eq t 'number))
X	   (+ "" args))
X	  (t ""))))
X
(defunq send-epoch-command (args)
X  (send-epoch (stringify args)))
X
;;; All done
X
(provide 'epoch)
X
SHAR_EOF
chmod 0666 epoch.gwm ||
echo 'restore of epoch.gwm failed'
Wc_c="`wc -c < 'epoch.gwm'`"
test 1277 -eq "$Wc_c" ||
	echo 'epoch.gwm: original size 1277, current size' "$Wc_c"
fi
# ============= gwm-menus.el ==============
if test -f 'gwm-menus.el' -a X"$1" != X"-c"; then
	echo 'x - skipping gwm-menus.el (File already exists)'
else
echo 'x - extracting gwm-menus.el (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'gwm-menus.el' &&
;;; gwm-menus.el -*- emacs-lisp -*- Epoch support for simple GWM menus
;;; Original code by Colas 1991-02-18
;;; Heavily hacked by Dan Pierson, Encore Computer Corp, 2/28/91
;;; 	Explicity specify all Epoch commands in string passed to GWM
;;; 	Gratuitously reformat
X
;;;============================================================================
;;;                    Sane EPOCH_EXEC
;;;============================================================================
X
;;; here we add a handler to read code from X properties without trashing
;;; epoch in case of errors in sent code.
X
(defun epoch-exec::property-init ()
X  "private property to avoid handler lost from external error"
X  (push-property "EPOCH_EXEC"
X		 (function (lambda (type prop screen)
X		   (let ((cw (selected-window))
X			 (action (get-property prop screen)))
X		     (unwind-protect
X			  (progn
X			    (select-window (epoch::selected-window screen))
X			    (and (stringp action)
X				 (eval (read action))))
X		       (select-window cw)))))))
X
(epoch-exec::property-init)
X
;;; use by sending to X property EPOCH_EXEC the code:
;;;      (let ((protect epoch::event-handler))
;;;        (unwind-protect
;;; 	     (progn 
;;; 
;;; 	       ... [code to excecute via the property] ...
;;; 
;;; 	       (setq epoch::event-handler protect))))
;;; 
X
;;; General menu popper, expects a list of the form:
;;; 	'("Title"
;;;       ("Item" epoch-code)
;;;       ...)
X
(defun gwm-pop-menu (items)
X  (epoch::set-property "GWM_EXECUTE"
X			 (concat "(progn (require 'epoch)(list-menu-make "
X				 (prin1-to-string items)
X				 "))"
X				 )))
X
;;; Application: pop a menu with epoch buffers:
X
(defun gwm-choose-buffer (arg)
X  (let ((buflist (cons "Epoch Screens"
X		       (mapcar (function (lambda (buf)
X				 (let ((name (buffer-name buf)))
X				   (list name
X					 'switch-to-buffer
X					 (concat "\"" name "\"")))))
X			       (buffer-list)))))
X    (gwm-pop-menu buflist)))
X
(global-set-mouse mouse-right mouse-control-shift 'gwm-choose-buffer)
SHAR_EOF
chmod 0666 gwm-menus.el ||
echo 'restore of gwm-menus.el failed'
Wc_c="`wc -c < 'gwm-menus.el'`"
test 1992 -eq "$Wc_c" ||
	echo 'gwm-menus.el: original size 1992, current size' "$Wc_c"
fi
exit 0
--

                                            dan

In real life: Dan Pierson, Encore Computer Corporation, Research
UUCP: {talcott,linus,necis,decvax}!encore!pierson
Internet: pierson@encore.com