; Twm Style Window Frame (hacked up from simple-ed-win.gwm) ; =========================================================================== ; This file is derived from the simple-ed-win.gwm distributed with gwm 1.4.1.30 ; The original file was written by Colas Nahaboo, BULL Research, France. ; ; Modifications [Dec 1989] for twm emulation by Arup Mukherjee ; (arup@grasp.cis.upenn.edu) ; ; Within the restrictions of the GWM copyright, you may do whatever you ; want with this code. It would be nice, however, if my name were to remain ; in it somewhere. (df twm-titled-win-setup () (if (= 0 gwm-quiet) (? screen)) (if (not (boundp 'twm-borderwidth)) (: twm-borderwidth 2)) (setq icon-pixmap (pixmap-make title-background (+ bitmaps-dir "iconify.xbm") title-foreground)) (setq resize-pixmap (pixmap-make title-background (+ bitmaps-dir "resize.xbm") title-foreground)) (setq hilite-pixmap (pixmap-make title-background (+ bitmaps-dir "hilite.xbm") title-foreground)) (setq no-hilite-pixmap (with (foreground title-background) (pixmap-make 20 20)))) (: iconify-fsm (fsm-make (: original-state (state-make (on (buttonpress 2 any) (with (pos-x (current-event-x) pos-y (current-event-y)) (iconify-window) (if (not show-icon-mgr) (progn (move-window pos-x pos-y) (move-window) (raise-window)))) iconify-state) (on (buttonpress any any) (progn (iconify-window) (raise-window)) original-state))) (: iconify-state (state-make (on (buttonpress 2 any) (move-window)) (on (buttonpress any any) (iconify-window) original-state))))) (: icon-plug '(with (borderwidth 0 background white borderpixel white fsm iconify-fsm) (plug-make icon-pixmap))) (: resize-fsm (fsm-make (: only-state (state-make (on (buttonpress any any) (resize-window)))))) (: resize-plug '(with (borderwidth 0 background title-background fsm resize-fsm) (plug-make resize-pixmap))) (: edit-fsm (fsm-make (: sed.edit-fsm.normal (state-make (on (double-button any any) (progn (set-focus wob) (wob-background black) (with (foreground white) (wob-tile (active-label-make (# 'title wob) name-font)))) sed.edit-fsm.editable) (on (button any (together with-alt with-control)) (progn (set-focus wob) (wob-background black) (with (foreground white label-vertical-margin 1) (wob-tile (active-label-make (# 'title wob) name-font)))) sed.edit-fsm.editable) (on (user-event 'name-change) (progn (## 'title wob (: s window-name)) (with (foreground title-foreground label-vertical-margin 1) (wob-tile (active-label-make s name-font))) (send-user-event 'get-s (window-icon)) (if show-icon-mgr (send-user-event 'icon-mgr-rethink icon-mgr-wob)) )) standard-title-behavior )) (: sed.edit-fsm.editable (state-make (on (keypress (key-make "Return") any) (sed.edit-fsm.de-edit) sed.edit-fsm.normal) (on (double-button any any) (sed.edit-fsm.de-edit) sed.edit-fsm.normal) (on (keypress "BackSpace" any) (progn (## 'title wob (: s (match "\\(.*\\)." (# 'title wob) 1))) (with (foreground title-foreground label-vertical-margin 1) (wob-tile (active-label-make s name-font))) (send-user-event 'get-s (window-icon)) )) (on (keypress "Delete" any) (progn (## 'title wob (: s "")) (with (foreground title-foreground label-vertical-margin 1) (wob-tile (active-label-make s name-font))) (send-user-event 'get-s (window-icon)) )) (on (keypress any any) (progn (## 'title wob (: s (+ (# 'title wob) (last-key)))) (with (foreground title-foreground label-vertical-margin 1) (wob-tile (active-label-make s name-font))) (send-user-event 'get-s (window-icon)) )) (on (user-event 'name-change) (progn (## 'title wob (: s window-name)) (with (foreground title-foreground label-vertical-margin 1) (wob-tile (active-label-make s name-font))) (if show-icon-mgr (send-user-event 'icon-mgr-rethink icon-mgr-wob)) )) (on focus-out (wob-tile (label-make (# 'title wob) name-font)) sed.edit-fsm.normal) standard-title-behavior )) )))) (de sed.edit-fsm.de-edit () (with (foreground title-foreground background title-background font name-font label-horizontal-margin 6 label-vertical-margin 1 borderwidth 0) (wob-tile (label-make (# 'title wob) name-font)) (window-name (# 'title wob)) (set-focus) (process-events) (if show-icon-mgr (send-user-event 'icon-mgr-rethink icon-mgr-wob))) ) (: titlebar-fsm (fsm-make (state-make (on (user-event 'focus-in) (wob-tile hilite-pixmap)) (on (user-event 'focus-out) (wob-tile no-hilite-pixmap)) standard-title-behavior))) (: editable-plug '(with ( borderwidth 1 background title-background foreground title-foreground font name-font property (list 'title window-name) fsm edit-fsm) (with (borderwidth 0 label-horizontal-margin 6 label-vertical-margin 1) (plug-make (label-make window-name))))) (: space '(with (foreground title-background borderwidth 0) (plug-make (pixmap-make 5 16)))) (: titlebar '(with (borderwidth 2 background title-background fsm titlebar-fsm plug-separator 0 borderpixel title-background bar-min-width 1 bar-max-width 30) (bar-make icon-plug space editable-plug space () space resize-plug)))) (: sed-window-fsm (fsm-make (state-make (on focus-in (progn (if autoraise (raise-window)) (send-user-event 'focus-in) (wob-borderpixel hilite-color))) (on focus-out (progn (send-user-event 'focus-out) (wob-borderpixel border-foreground))) (if (and (boundp 'emacs-mouse-loaded) emacs-mouse-loaded) (state-make (on (button 1 with-control) (emacs-click 1)) (on (button 2 with-control) (emacs-click 2)) (on (buttonpress 3 with-control) (pop-menu emacs-pop)))) window-behavior ))) (setq twm-titled-win.result '(with (inner-borderwidth 1 fsm sed-window-fsm borderwidth twm-borderwidth borderpixel border-foreground grabs (+ grabs (if (and (boundp 'emacs-mouse-loaded) emacs-mouse-loaded) (list (button any with-control))))) (window-make titlebar () () () ()))) ; (: twm-titled-win.data result) ; (df twm-titled-win () twm-titled-win.data) (if (not (= screen. (namespace-of 'twm-titled-win.data))) (defname 'twm-titled-win.data screen.)) ; (defname-in-screen-to () twm-titled-win.data twm-titled-win)) (df twm-titled-win () (if (boundp 'twm-titled-win.data) twm-titled-win.data (progn (twm-titled-win-setup) (: twm-titled-win.data (eval twm-titled-win.result)))))