1385 lines
52 KiB
Plaintext
1385 lines
52 KiB
Plaintext
;; fvwm-window.gwm --- FVWM style windows.
|
|
;;
|
|
;; Author: Anders Holst (aho@sans.kth.se)
|
|
;; Copyright (C) 1996 Anders Holst
|
|
;; Last change: 14/8 1996
|
|
;;
|
|
;; This file is copyrighted under the same terms as the rest of GWM
|
|
;; (see the X Inc license for details). There is no warranty that it
|
|
;; works.
|
|
;;
|
|
;; ---------------------------------------------------------------------
|
|
;;
|
|
;; This file defines a FVWM style window that should work together with
|
|
;; (at least) the standard profile and the VTWM profile in GWM.
|
|
;;
|
|
;; It may not be a complete FVWM window, but I think it is quite close.
|
|
;;
|
|
;; This window style cooperates with (but does not require) the virtual
|
|
;; screen package. If you use a specific color for "nailed" ("sticky")
|
|
;; windows, you should call 'fvwm-nail-window', 'fvwm-unnail-window' and
|
|
;; 'fvwm-toggle-nail-window' instead of the corresponding functions in
|
|
;; the virtual package.
|
|
;; In general, since it is possible to specify any strange conditions on
|
|
;; what colors a window should have, the function `fvwm-update-color'
|
|
;; could be called for a window whenever these conditions have changed
|
|
;; for it.
|
|
;;
|
|
;; NOTE: This window style consumes bitmaps. There is a huge number of
|
|
;; bitmaps involved for each window, and since each window can have its
|
|
;; own proportions and colors, bitmaps are not shared between windows.
|
|
;;
|
|
;; You probably want to change the variables under "USER CUSTOMIZABLE
|
|
;; VARIABLES", so copy them to your own profile and set them there.
|
|
;;
|
|
|
|
(declare-screen-dependent
|
|
fvwm-left-plugs
|
|
fvwm-right-plugs
|
|
fvwm-corner-action
|
|
fvwm-side-action
|
|
fvwm-border-action
|
|
fvwm-title-action
|
|
fvwm-color
|
|
fvwm-active-color
|
|
fvwm-title-color
|
|
fvwm-active-title-color
|
|
fvwm-title-font
|
|
fvwm-title-width
|
|
fvwm-frame-width
|
|
fvwm-corner-size
|
|
fvwm-inner-border
|
|
fvwm-outer-border
|
|
fvwm-has-frame
|
|
fvwm-has-resize
|
|
fvwm-has-title
|
|
fvwm-wide-shadow
|
|
fvwm-color-styles
|
|
fvwm-window-styles
|
|
fvwm-virtual-colors
|
|
)
|
|
|
|
;;
|
|
;; USER CUSTOMIZABLE VARIABLES
|
|
;; ---------------------------
|
|
;; Adjust these in your own profile
|
|
;;
|
|
(with (wob wob)
|
|
(for screen (list-of-screens)
|
|
(defaults-to
|
|
fvwm-color "tan" ; Main color of window
|
|
fvwm-active-color "palevioletred" ; Color when in focus, as above if ()
|
|
fvwm-title-color "black" ; Color of title text
|
|
fvwm-active-title-color () ; Color of text when in focus
|
|
fvwm-title-font (font-make "6x13bold") ; Font of title text
|
|
fvwm-title-width () ; Title width. If (), set from font.
|
|
fvwm-frame-width 6 ; Frame width.
|
|
fvwm-corner-size () ; Resize corner size. If (), set automatic.
|
|
fvwm-has-frame t ; Window has border or resize handles
|
|
fvwm-has-resize t ; Window has resize handles
|
|
fvwm-has-title t ; Window has title bar
|
|
fvwm-wide-shadow () ; Slightly wider shadows around title bar
|
|
fvwm-inner-border -1 ; Use of inner border
|
|
fvwm-outer-border () ; Use of outer border
|
|
fvwm-left-plugs '((horizontal-rectangle (fvwm-pop-menu window-pop) press))
|
|
fvwm-right-plugs '((up-triangle (zoom-window))
|
|
(down-triangle (iconify-window) release))
|
|
; Left and right plugs in the titlebar, a list of pairs
|
|
; or triplets: ( <button-graphic> <action> [<action-type>] )
|
|
; The optional third element <action-type> can be `press' or
|
|
; `release', if the action should be all done on the button press
|
|
; (good for menus) or executed on the button release (good for
|
|
; eg. iconification and deletion of the window).
|
|
; Possible graphics are: small-square, medium-square,
|
|
; large-square, horizontal-rectangle, vertical-rectangle,
|
|
; medium-circle, medium-diamond, down-triangle, and up-triangle.
|
|
; Check how these are defined if you like to do your own.
|
|
fvwm-border-action '(move-window)
|
|
fvwm-corner-action '(fvwm-resize-window)
|
|
fvwm-side-action '(fvwm-resize-window)
|
|
fvwm-title-action '(raise-lower-move-window)
|
|
; Actions to execute when pressing the border, the resize corner,
|
|
; the resize side, or the title bar.
|
|
; These actions, and the <action> components for the left and right
|
|
; plugs above, can actually also be lists of pairs or triplets:
|
|
; ( <button-spec> <action> [<action-type>] ), where <button-spec>
|
|
; is a mouse button number or a list with a mouse button number
|
|
; followed by any number of modifiers.
|
|
fvwm-color-styles '(((virtual-nailed) "palegreen")
|
|
(XTerm "grey")
|
|
(Emacs "lightblue"))
|
|
; List of (<win-spec> <color> <active-color> <title-color>
|
|
; <active-title-color>) specifications, to get different colors
|
|
; on different windows. <win-spec> can be an atom (matching the
|
|
; client class), a string (regexp matching title), or an
|
|
; arbitrary expression (giving nil or non-nil).
|
|
fvwm-window-styles '(((matches-list '(XClock XLoad XBiff Gwm))
|
|
resize () title () color "tan" active-color ()
|
|
frame-width 5 inner-border ()))
|
|
; List of (<win-spec> <prop1> <val1> ...) specifications, to
|
|
; get individual appearances on windows. The possible <prop_i>
|
|
; for which individual values can be specified are:
|
|
; color, active-color, title-color, active-title-color,
|
|
; title-font, title-width, frame-width, corner-size, frame,
|
|
; resize, title, wide-shadow, inner-border, outer-border,
|
|
; left-plugs, right-plugs, border-action, corner-action,
|
|
; side-action, title-action.
|
|
; A window can match several of the <win-spec> in the list (unlike
|
|
; `fvwm-color-styles' where only the first hit applies).
|
|
fvwm-virtual-colors t ; Affect colors in virtual map.
|
|
)))
|
|
|
|
;;--------------------------------------------------------------------------
|
|
;; End of user customizable things. Here starts the real code.
|
|
;;--------------------------------------------------------------------------
|
|
|
|
(setq fvwm-resize-cursors t)
|
|
(declare-screen-dependent fvwm-frame-cursor)
|
|
(with (wob wob)
|
|
(for screen (list-of-screens)
|
|
(progn
|
|
(setq cursor-NW (cursor-make 134))
|
|
(setq cursor-NE (cursor-make 136))
|
|
(setq cursor-SW (cursor-make 12))
|
|
(setq cursor-SE (cursor-make 14))
|
|
(setq cursor-N (cursor-make 138))
|
|
(setq cursor-S (cursor-make 16))
|
|
(setq cursor-W (cursor-make 70))
|
|
(setq cursor-E (cursor-make 96))
|
|
(setq fvwm-frame-cursor (cursor-make 68)))))
|
|
|
|
|
|
;; First some prerequisites from other places.
|
|
|
|
(if (not (boundp 'deltabutton))
|
|
(load "deltabutton"))
|
|
|
|
(if (or (not (boundp 'raise-lower-move-window))
|
|
(not (boundp 'window-obscured))
|
|
(not (boundp 'windows-overlap)))
|
|
(progn
|
|
|
|
(defun windows-overlap (w1 w2)
|
|
(with (window w1
|
|
w1l window-x
|
|
w1t window-y
|
|
w1r (+ window-width w1l)
|
|
w1b (+ window-height w1t)
|
|
window w2
|
|
w2l window-x
|
|
w2t window-y
|
|
w2r (+ window-width w2l)
|
|
w2b (+ window-height w2t))
|
|
(and (< w2l w1r)
|
|
(< w2t w1b)
|
|
(> w2b w1t)
|
|
(> w2r w1l))))
|
|
|
|
(defun window-obscured ()
|
|
(with (unobscured t
|
|
might-obscure ())
|
|
(for w (list-of-windows 'stacking-order 'mapped)
|
|
(if (and might-obscure
|
|
(not (= (# 'float w) 'up)) ; ignore floating windows
|
|
(windows-overlap window w))
|
|
(setq unobscured ()))
|
|
(if (= w window) (setq might-obscure t)))
|
|
(not unobscured)))
|
|
|
|
(defun raiselower-window ()
|
|
(if (window-obscured)
|
|
(raise-window)
|
|
(lower-window)))
|
|
|
|
(defun raise-lower-move-window ()
|
|
(set-focus)
|
|
(if (deltabutton)
|
|
(move-window)
|
|
(window-obscured)
|
|
(raise-window)
|
|
(lower-window)))
|
|
|
|
))
|
|
|
|
(if (not (boundp 'zoom-window))
|
|
(progn
|
|
|
|
(if (not (boundp 'virtual-nailed))
|
|
(progn
|
|
(defun virtual-nailed () ())
|
|
(defun virtual-x (x) x)
|
|
(defun virtual-y (y) y)
|
|
))
|
|
|
|
(if (not (boundp 'pop-to-window))
|
|
(setq pop-to-window raise-window))
|
|
|
|
(load "vtwm-zoom")
|
|
|
|
(setq zoom-window-method-list '((XTerm zoom-window-vert)
|
|
(XVroot zoom-window-prop)
|
|
(t zoom-window-full)))
|
|
))
|
|
|
|
;; Specific menus are not written yet. Find some good alternative.
|
|
(setq fvwm-pop-menu (or (eval (boundp 'std-pop-menu))
|
|
(eval (boundp 'vtwm-pop-menu))
|
|
pop-menu))
|
|
|
|
;; Redefinition to make colors in the virtual map follow the windows
|
|
(defun virt-get-color ()
|
|
(with (res (if (= window root-window)
|
|
(with (ele (# 0 virtual-fancy-colors))
|
|
(if (and ele
|
|
(or (not (# 0 ele))
|
|
(= (type (# 0 ele)) 'number)))
|
|
ele))
|
|
(and fvwm-virtual-colors
|
|
(# 'virt-col window))
|
|
(list () (# 'virt-col window))
|
|
(matches-cond virtual-fancy-colors)))
|
|
(if (not res)
|
|
(list virtual-foreground
|
|
(if virtual-show-filled
|
|
virtual-background
|
|
()))
|
|
(not (# 0 res))
|
|
(list virtual-foreground
|
|
(# 1 res))
|
|
res)))
|
|
|
|
|
|
;; COLORS
|
|
;; =======
|
|
|
|
(defun darken-color (col)
|
|
(with (rgb (color-components col))
|
|
(color-make-rgb (/ (* (# 0 rgb) 2) 3)
|
|
(/ (* (# 1 rgb) 2) 3)
|
|
(/ (* (# 2 rgb) 2) 3))))
|
|
|
|
(defun lighten-color (col)
|
|
(with (rgb (color-components col)
|
|
wht (color-components white))
|
|
(color-make-rgb (/ (+ (# 0 wht) (# 0 rgb)) 2)
|
|
(/ (+ (# 1 wht) (# 1 rgb)) 2)
|
|
(/ (+ (# 2 wht) (# 2 rgb)) 2))))
|
|
|
|
(defun make-color-scheme (bg fg)
|
|
(with (bg (if (= (type bg) 'number) bg (color-make bg))
|
|
fg (if (= (type fg) 'number) fg (color-make fg))
|
|
dark (darken-color bg)
|
|
light (lighten-color bg))
|
|
(list light bg dark fg)))
|
|
|
|
; THE TILES :
|
|
; =========
|
|
|
|
(defun fvwm-vbar-tile (size active spec)
|
|
(with (cols (if active active-color-scheme color-scheme)
|
|
foreground (# 1 cols)
|
|
tile ()
|
|
theTile (pixmap-make size 1))
|
|
(with (foreground (# 0 cols))
|
|
(draw-line theTile 0 0 (if (eq spec 'right) 0 1) 0))
|
|
(with (foreground (# 2 cols))
|
|
(draw-line theTile (- size 1) 0 (- size (if (eq spec 'left) 1 2)) 0))
|
|
theTile
|
|
))
|
|
|
|
(defun fvwm-hbar-tile (size active spec)
|
|
(with (cols (if active active-color-scheme color-scheme)
|
|
foreground (# 1 cols)
|
|
tile ()
|
|
theTile (pixmap-make 1 size))
|
|
(with (foreground (# 0 cols))
|
|
(draw-line theTile 0 0 0 (if (eq spec 'title) 0 1)))
|
|
(with (foreground (# 2 cols))
|
|
(draw-line theTile 0 (- size 1) 0 (- size (if spec 1 2))))
|
|
theTile
|
|
))
|
|
|
|
(defun fvwm-tl-pixmap (w h active seam spec)
|
|
(with (cols (if active active-color-scheme color-scheme)
|
|
foreground (# 1 cols)
|
|
tile ()
|
|
theTile (pixmap-make w h))
|
|
(with (foreground (# 0 cols))
|
|
(draw-line theTile 0 0 (- w 1) 0)
|
|
(draw-line theTile 0 1 (- w 1) 1)
|
|
(draw-line theTile 0 0 0 (- h 1))
|
|
(draw-line theTile 1 0 1 (- h 1))
|
|
(if seam (draw-line theTile (- w 1) 0 (- w 1) (- h 2)))
|
|
)
|
|
(with (foreground (# 2 cols))
|
|
(if spec
|
|
(draw-line theTile (- h 1) (- h 1) (- w 1) (- h 1))
|
|
(progn
|
|
(draw-line theTile (- h 2) (- h 2) (- w 2) (- h 2))
|
|
(draw-line theTile (- h 2) (- h 1) (- w 1) (- h 1))))
|
|
(if seam (draw-line theTile (- w 2) 1 (- w 2) (- h 1)))
|
|
)
|
|
theTile
|
|
))
|
|
|
|
(defun fvwm-tr-pixmap (w h active seam spec)
|
|
(with (cols (if active active-color-scheme color-scheme)
|
|
foreground (# 1 cols)
|
|
tile ()
|
|
theTile (pixmap-make w h))
|
|
(with (foreground (# 0 cols))
|
|
(draw-line theTile 0 0 (- w 1) 0)
|
|
(draw-line theTile 0 1 (- w 2) 1)
|
|
(if seam (draw-line theTile 1 0 1 (- h 2)))
|
|
(if (not spec)
|
|
(draw-line theTile (+ (- w h) 1) (- h 1) (+ (- w h) 1) (- h 1)))
|
|
)
|
|
(with (foreground (# 2 cols))
|
|
(if seam (draw-line theTile 0 1 0 (- h 1)))
|
|
(draw-line theTile (- w 1) 1 (- w 1) (- h 1))
|
|
(draw-line theTile (- w 2) 2 (- w 2) (- h 1))
|
|
(if (not spec)
|
|
(draw-line theTile 0 (- h 1) (- w h) (- h 1))
|
|
(if (> w h)
|
|
(draw-line theTile 0 (- h 1) (- w h 1) (- h 1))))
|
|
(if (not spec)
|
|
(draw-line theTile (if seam 2 0) (- h 2) (+ (- w h) 1) (- h 2)))
|
|
)
|
|
theTile
|
|
))
|
|
|
|
(defun fvwm-bl-pixmap (w h active seam)
|
|
(with (cols (if active active-color-scheme color-scheme)
|
|
foreground (# 1 cols)
|
|
tile ()
|
|
theTile (pixmap-make w h))
|
|
(with (foreground (# 0 cols))
|
|
(draw-line theTile 0 0 0 (- h 1))
|
|
(draw-line theTile 1 0 1 (- h 2))
|
|
(draw-line theTile h 0 (- w 1) 0)
|
|
(draw-line theTile (- h 1) 1 (- w 1) 1)
|
|
(if seam (draw-line theTile (- w 1) 0 (- w 1) (- h 2)))
|
|
)
|
|
(with (foreground (# 2 cols))
|
|
(draw-line theTile 1 (- h 1) (- w 1) (- h 1))
|
|
(draw-line theTile 2 (- h 2) (- w (if seam 2 1)) (- h 2))
|
|
(draw-line theTile (- h 2) 0 (- h 1) 0)
|
|
(draw-line theTile (- h 2) 1 (- h 2) 1)
|
|
(if seam (draw-line theTile (- w 2) 1 (- w 2) (- h 1)))
|
|
)
|
|
theTile
|
|
))
|
|
|
|
(defun fvwm-br-pixmap (w h active seam)
|
|
(with (cols (if active active-color-scheme color-scheme)
|
|
foreground (# 1 cols)
|
|
tile ()
|
|
theTile (pixmap-make w h))
|
|
(with (foreground (# 0 cols))
|
|
(draw-line theTile 0 0 (+ (- w h) 1) 0)
|
|
(draw-line theTile 0 1 (+ (- w h) 1) 1)
|
|
(if seam (draw-line theTile 1 0 1 (- h 2)))
|
|
)
|
|
(with (foreground (# 2 cols))
|
|
(draw-line theTile 0 (- h 1) (- w 1) (- h 1))
|
|
(draw-line theTile (if seam 2 0) (- h 2) (- w 1) (- h 2))
|
|
(draw-line theTile (- w 1) 0 (- w 1) (- h 1))
|
|
(draw-line theTile (- w 2) 0 (- w 2) (- h 2))
|
|
(if seam (draw-line theTile 0 1 0 (- h 1)))
|
|
)
|
|
theTile
|
|
))
|
|
|
|
(defun fvwm-bv-pixmap (w h active)
|
|
(with (cols (if active active-color-scheme color-scheme)
|
|
foreground (# 1 cols)
|
|
tile ()
|
|
theTile (pixmap-make w h))
|
|
(with (foreground (# 0 cols))
|
|
(draw-line theTile 0 1 (- w 1) 1)
|
|
(draw-line theTile 0 0 0 (- h 1))
|
|
(draw-line theTile 1 1 1 (- h 1))
|
|
)
|
|
(with (foreground (# 2 cols))
|
|
(draw-line theTile 1 0 (- w 1) 0)
|
|
(draw-line theTile (- w 1) 0 (- w 1) (- h 1))
|
|
(draw-line theTile (- w 2) 2 (- w 2) (- h 1))
|
|
)
|
|
theTile
|
|
))
|
|
|
|
(defun fvwm-tv-pixmap (w h active spec)
|
|
(with (cols (if active active-color-scheme color-scheme)
|
|
foreground (# 1 cols)
|
|
tile ()
|
|
theTile (pixmap-make w h))
|
|
(with (foreground (# 0 cols))
|
|
(draw-line theTile 0 0 0 (- h 1))
|
|
(if (not (eq spec 'right))
|
|
(draw-line theTile 1 0 1 (- h 1)))
|
|
(draw-line theTile 0 (- h 1) (- w 2) (- h 1))
|
|
)
|
|
(with (foreground (# 2 cols))
|
|
(if (not (eq spec 'left))
|
|
(draw-line theTile (- w 2) 0 (- w 2) (- h 2)))
|
|
(draw-line theTile (- w 1) 0 (- w 1) (- h 1))
|
|
(draw-line theTile 1 (- h 2) (- w 1) (- h 2))
|
|
)
|
|
theTile
|
|
))
|
|
|
|
|
|
; Frame Behavior
|
|
; ===============
|
|
|
|
(setq fvwm-frame-behavior
|
|
(state-make
|
|
(on (user-event 'focus-in)
|
|
(wob-tile (# 'activepixmap wob-property)) )
|
|
(on (user-event 'focus-out)
|
|
(wob-tile (# 'pixmap wob-property)) )
|
|
(on (user-event 're-color)
|
|
(with (redo-expr (# 'redo-expr wob-property)
|
|
ntile (with (active ()) (eval redo-expr))
|
|
atile (with (active t) (eval redo-expr)))
|
|
(if (eq (wob-tile) (# 'activepixmap wob-property))
|
|
(wob-tile atile)
|
|
(wob-tile ntile))
|
|
(## 'pixmap wob ntile)
|
|
(## 'activepixmap wob atile))))
|
|
)
|
|
|
|
; Title Behavior
|
|
; ===============
|
|
|
|
(setq fvwm-title-behavior
|
|
(state-make
|
|
(on (user-event 'focus-in)
|
|
(wob-tile (# 'activepixmap wob-property)) )
|
|
(on (user-event 'focus-out)
|
|
(wob-tile (# 'pixmap wob-property)) )
|
|
(on (user-event 'press)
|
|
(wob-tile (# 'pressedpixmap wob-property)) )
|
|
(on (user-event 'release)
|
|
(wob-tile (# 'activepixmap wob-property)) )
|
|
(on (user-event 'pre-color)
|
|
(with (redo-expr (# 'redo-expr wob-property)
|
|
ntile (with (active () pressed ()) (eval redo-expr))
|
|
atile (with (active t pressed ()) (eval redo-expr))
|
|
ptile (with (active t pressed t) (eval redo-expr)))
|
|
(## 'new-npm wob ntile)
|
|
(## 'new-apm wob atile)
|
|
(## 'new-ppm wob ptile)))
|
|
(on (user-event 're-color)
|
|
(with (redo-expr (# 'redo-expr wob-property)
|
|
ntile (# 'new-npm wob)
|
|
atile (# 'new-apm wob)
|
|
ptile (# 'new-ppm wob))
|
|
(if (eq (wob-tile) (# 'activepixmap wob-property))
|
|
(wob-tile atile)
|
|
(eq (wob-tile) (# 'pressedpixmap wob-property))
|
|
(wob-tile ptile)
|
|
(wob-tile ntile))
|
|
(## 'pixmap wob ntile)
|
|
(## 'activepixmap wob atile)
|
|
(## 'pressedpixmap wob ptile))))
|
|
)
|
|
|
|
(setq fvwm-title-plug-behavior
|
|
(state-make
|
|
(on (user-event 'focus-in)
|
|
(wob-tile (# 'activepixmap wob-property)))
|
|
(on (user-event 'focus-out)
|
|
(wob-tile (# 'pixmap wob-property)))
|
|
(on (user-event 're-color)
|
|
(with (label-vertical-margin 0
|
|
label-horizontal-margin 0
|
|
font (# 'font wob-property)
|
|
name (eval (# 'name-expr wob-property))
|
|
background (# 1 active-color-scheme)
|
|
foreground (# 3 active-color-scheme)
|
|
atile (label-make name)
|
|
background (# 1 color-scheme)
|
|
foreground (# 3 color-scheme)
|
|
ntile (label-make name))
|
|
(wob-tile (if (eq (wob-tile) (# 'activepixmap wob-property))
|
|
atile ntile))
|
|
(## 'pixmap wob ntile)
|
|
(## 'activepixmap wob atile)
|
|
(## 'bg wob (# 1 color-scheme))
|
|
(## 'abg wob (# 1 active-color-scheme))
|
|
(## 'fg wob (# 3 color-scheme))
|
|
(## 'afg wob (# 3 active-color-scheme))))
|
|
(on (user-event 'name-change)
|
|
(with (label-vertical-margin 0
|
|
label-horizontal-margin 0
|
|
font (# 'font wob-property)
|
|
name (eval (# 'name-expr wob-property))
|
|
background (# 'abg wob-property)
|
|
foreground (# 'afg wob-property)
|
|
atile (label-make name)
|
|
background (# 'bg wob-property)
|
|
foreground (# 'fg wob-property)
|
|
ntile (label-make name))
|
|
(wob-tile (if (eq (wob-tile) (# 'activepixmap wob-property))
|
|
atile ntile))
|
|
(## 'pixmap wob ntile)
|
|
(## 'activepixmap wob atile))))
|
|
)
|
|
|
|
|
|
|
|
; THE PLUGS :
|
|
; =========
|
|
|
|
(defunq fvwm-border-plug (pix-expr)
|
|
(with (borderwidth 0
|
|
fsm (fsm-make (state-make fvwm-frame-behavior
|
|
(fvwm-button-behavior fvwm-border-action ())))
|
|
tile ()
|
|
pixmap (with (active ()) (eval pix-expr))
|
|
activepixmap (with (active t) (eval pix-expr))
|
|
property (list 'pixmap pixmap 'activepixmap activepixmap
|
|
'redo-expr pix-expr))
|
|
(plug-make pixmap)))
|
|
|
|
(defunq fvwm-resize-plug (cur pix-expr)
|
|
(with (borderwidth 0
|
|
cursor (if fvwm-resize-cursors (eval cur) fvwm-frame-cursor)
|
|
fsm (fsm-make (state-make fvwm-frame-behavior
|
|
(fvwm-button-behavior fvwm-corner-action ())))
|
|
tile ()
|
|
pixmap (with (active ()) (eval pix-expr))
|
|
activepixmap (with (active t) (eval pix-expr))
|
|
property (list 'pixmap pixmap 'activepixmap activepixmap
|
|
'redo-expr pix-expr))
|
|
(plug-make pixmap)))
|
|
|
|
|
|
(defun fvwm-border-plug-tl (small)
|
|
(if small
|
|
(fvwm-border-plug (fvwm-tl-pixmap frame-width (- frame-width 1)
|
|
active () t))
|
|
(fvwm-border-plug (fvwm-tl-pixmap frame-width frame-width
|
|
active () ()))))
|
|
|
|
(defun fvwm-border-plug-tr (small)
|
|
(if small
|
|
(fvwm-border-plug (fvwm-tr-pixmap frame-width (- frame-width 1)
|
|
active () t))
|
|
(fvwm-border-plug (fvwm-tr-pixmap frame-width frame-width
|
|
active () ()))))
|
|
(defun fvwm-border-plug-bl ()
|
|
(fvwm-border-plug (fvwm-bl-pixmap frame-width frame-width
|
|
active ())))
|
|
|
|
(defun fvwm-border-plug-br ()
|
|
(fvwm-border-plug (fvwm-br-pixmap frame-width frame-width
|
|
active ())))
|
|
|
|
(defun fvwm-resize-vplug-tl ()
|
|
(fvwm-resize-plug cursor-NW
|
|
(fvwm-tv-pixmap frame-width
|
|
(- corner-size frame-width)
|
|
active ())))
|
|
|
|
(defun fvwm-resize-vplug-tr ()
|
|
(fvwm-resize-plug cursor-NE
|
|
(fvwm-tv-pixmap frame-width
|
|
(- corner-size frame-width)
|
|
active ())))
|
|
|
|
(defun fvwm-resize-vplug-tl2 (wide)
|
|
(with (fsm (fsm-make (state-make fvwm-frame-behavior
|
|
(fvwm-button-behavior fvwm-side-action ())))
|
|
borderwidth 0
|
|
bar-min-width 0
|
|
bar-max-width 1000
|
|
cursor (if fvwm-resize-cursors cursor-W fvwm-frame-cursor)
|
|
redo-expr (if wide
|
|
'(fvwm-vbar-tile frame-width active ())
|
|
'(fvwm-vbar-tile (- frame-width 1) active 'left))
|
|
tile (with (active ()) (eval redo-expr))
|
|
atile (with (active t) (eval redo-expr))
|
|
property (list 'pixmap tile 'activepixmap atile
|
|
'redo-expr redo-expr))
|
|
(bar-make
|
|
(if wide
|
|
(fvwm-resize-plug cursor-NE
|
|
(fvwm-tv-pixmap frame-width
|
|
(- corner-size frame-width)
|
|
active ()))
|
|
(fvwm-resize-plug cursor-NW
|
|
(fvwm-tv-pixmap (- frame-width 1)
|
|
(- corner-size frame-width -1)
|
|
active 'left))))))
|
|
|
|
(defun fvwm-resize-vplug-tr2 (wide)
|
|
(with (fsm (fsm-make (state-make fvwm-frame-behavior
|
|
(fvwm-button-behavior fvwm-side-action ())))
|
|
borderwidth 0
|
|
bar-min-width 0
|
|
bar-max-width 1000
|
|
cursor (if fvwm-resize-cursors cursor-E fvwm-frame-cursor)
|
|
redo-expr (if wide
|
|
'(fvwm-vbar-tile frame-width active ())
|
|
'(fvwm-vbar-tile (- frame-width 1) active 'right))
|
|
tile (with (active ()) (eval redo-expr))
|
|
atile (with (active t) (eval redo-expr))
|
|
property (list 'pixmap tile 'activepixmap atile
|
|
'redo-expr redo-expr))
|
|
(bar-make
|
|
(if wide
|
|
(fvwm-resize-plug cursor-NE
|
|
(fvwm-tv-pixmap frame-width
|
|
(- corner-size frame-width)
|
|
active ()))
|
|
(fvwm-resize-plug cursor-NE
|
|
(fvwm-tv-pixmap (- frame-width 1)
|
|
(- corner-size frame-width -1)
|
|
active 'right))))))
|
|
|
|
(defun fvwm-resize-vplug-tl-small (wide)
|
|
(if (> corner-size
|
|
(+ title-width frame-width (if wide 2 0)))
|
|
(if wide
|
|
(fvwm-resize-plug cursor-NW
|
|
(fvwm-tv-pixmap frame-width
|
|
(- corner-size frame-width title-width 2)
|
|
active ()))
|
|
(fvwm-resize-plug cursor-NW
|
|
(fvwm-tv-pixmap frame-width
|
|
(- corner-size frame-width title-width)
|
|
active ())))))
|
|
|
|
(defun fvwm-resize-vplug-tr-small (wide)
|
|
(if (> corner-size
|
|
(+ title-width frame-width (if wide 2 0)))
|
|
(if wide
|
|
(fvwm-resize-plug cursor-NE
|
|
(fvwm-tv-pixmap frame-width
|
|
(- corner-size frame-width title-width 2)
|
|
active ()))
|
|
(fvwm-resize-plug cursor-NE
|
|
(fvwm-tv-pixmap frame-width
|
|
(- corner-size frame-width title-width)
|
|
active ())))))
|
|
|
|
(defun fvwm-resize-vplug-bl ()
|
|
(fvwm-resize-plug cursor-SW
|
|
(fvwm-bv-pixmap frame-width
|
|
(- corner-size frame-width)
|
|
active)))
|
|
|
|
(defun fvwm-resize-vplug-br ()
|
|
(fvwm-resize-plug cursor-SE
|
|
(fvwm-bv-pixmap frame-width
|
|
(- corner-size frame-width)
|
|
active)))
|
|
|
|
(defun fvwm-resize-hplug-bl ()
|
|
(fvwm-resize-plug cursor-SW
|
|
(fvwm-bl-pixmap corner-size frame-width active t)))
|
|
|
|
(defun fvwm-resize-hplug-br ()
|
|
(fvwm-resize-plug cursor-SE
|
|
(fvwm-br-pixmap corner-size frame-width active t)))
|
|
|
|
(defun fvwm-resize-hplug-tl ()
|
|
(fvwm-resize-plug cursor-NW
|
|
(fvwm-tl-pixmap corner-size frame-width active t ())))
|
|
|
|
(defun fvwm-resize-hplug-tr ()
|
|
(fvwm-resize-plug cursor-NE
|
|
(fvwm-tr-pixmap corner-size frame-width active t ())))
|
|
|
|
(defun fvwm-resize-hplug-tl2 ()
|
|
(fvwm-resize-plug cursor-NW
|
|
(fvwm-tl-pixmap corner-size (- frame-width 1) active t t)))
|
|
|
|
(defun fvwm-resize-hplug-tr2 ()
|
|
(fvwm-resize-plug cursor-NE
|
|
(fvwm-tr-pixmap corner-size (- frame-width 1) active t t)))
|
|
|
|
; THE BARS :
|
|
; ========
|
|
|
|
|
|
(defun fvwm-border-vertical-bar (dir)
|
|
(with (
|
|
fsm (fsm-make (state-make fvwm-frame-behavior
|
|
(fvwm-button-behavior fvwm-border-action ())))
|
|
borderwidth 0
|
|
bar-min-width 0
|
|
bar-max-width 1000
|
|
cursor fvwm-frame-cursor
|
|
redo-expr (if (= dir 'left)
|
|
'(fvwm-vbar-tile (- frame-width 1) active 'left)
|
|
(= dir 'right)
|
|
'(fvwm-vbar-tile (- frame-width 1) active 'right)
|
|
'(fvwm-vbar-tile frame-width active ()))
|
|
tile (with (active ()) (eval redo-expr))
|
|
atile (with (active t) (eval redo-expr))
|
|
property (list 'pixmap tile 'activepixmap atile
|
|
'redo-expr redo-expr)
|
|
)
|
|
(bar-make)
|
|
))
|
|
|
|
|
|
(defun fvwm-border-top-bar (small)
|
|
(with (
|
|
fsm (fsm-make (state-make fvwm-frame-behavior
|
|
(fvwm-button-behavior fvwm-border-action ())))
|
|
borderwidth 0
|
|
bar-min-width 0
|
|
bar-max-width 1000
|
|
cursor fvwm-frame-cursor
|
|
redo-expr (if small
|
|
'(fvwm-hbar-tile (- frame-width 1) active t)
|
|
'(fvwm-hbar-tile frame-width active ()))
|
|
tile (with (active ()) (eval redo-expr))
|
|
atile (with (active t) (eval redo-expr))
|
|
property (list 'pixmap tile 'activepixmap atile
|
|
'redo-expr redo-expr)
|
|
)
|
|
(bar-make (fvwm-border-plug-tl small) () (fvwm-border-plug-tr small))
|
|
))
|
|
|
|
(defun fvwm-border-bottom-bar ()
|
|
(with (
|
|
fsm (fsm-make (state-make fvwm-frame-behavior
|
|
(fvwm-button-behavior fvwm-border-action ())))
|
|
borderwidth 0
|
|
bar-min-width 0
|
|
bar-max-width 1000
|
|
cursor fvwm-frame-cursor
|
|
redo-expr '(fvwm-hbar-tile frame-width active ())
|
|
tile (with (active ()) (eval redo-expr))
|
|
atile (with (active t) (eval redo-expr))
|
|
property (list 'pixmap tile 'activepixmap atile
|
|
'redo-expr redo-expr)
|
|
)
|
|
(bar-make (fvwm-border-plug-bl) () (fvwm-border-plug-br))
|
|
))
|
|
|
|
(defun fvwm-resize-left-bar (title wide)
|
|
(with (
|
|
fsm (fsm-make (state-make fvwm-frame-behavior
|
|
(fvwm-button-behavior fvwm-side-action ())))
|
|
borderwidth 0
|
|
bar-min-width 0
|
|
bar-max-width 1000
|
|
cursor (if fvwm-resize-cursors cursor-W fvwm-frame-cursor)
|
|
redo-expr '(fvwm-vbar-tile frame-width active ())
|
|
tile (with (active ()) (eval redo-expr))
|
|
atile (with (active t) (eval redo-expr))
|
|
property (list 'pixmap tile 'activepixmap atile
|
|
'redo-expr redo-expr)
|
|
)
|
|
(bar-make (if title
|
|
(fvwm-resize-vplug-tl-small wide)
|
|
(fvwm-resize-vplug-tl))
|
|
()
|
|
(fvwm-resize-vplug-bl) )))
|
|
|
|
(defun fvwm-resize-right-bar (title wide)
|
|
(with (
|
|
fsm (fsm-make (state-make fvwm-frame-behavior
|
|
(fvwm-button-behavior fvwm-side-action ())))
|
|
borderwidth 0
|
|
bar-min-width 0
|
|
bar-max-width 1000
|
|
cursor (if fvwm-resize-cursors cursor-E fvwm-frame-cursor)
|
|
redo-expr '(fvwm-vbar-tile frame-width active ())
|
|
tile (with (active ()) (eval redo-expr))
|
|
atile (with (active t) (eval redo-expr))
|
|
property (list 'pixmap tile 'activepixmap atile
|
|
'redo-expr redo-expr)
|
|
)
|
|
(bar-make (if title
|
|
(fvwm-resize-vplug-tr-small wide)
|
|
(fvwm-resize-vplug-tr))
|
|
()
|
|
(fvwm-resize-vplug-br))))
|
|
|
|
(defun fvwm-resize-bottom-bar ()
|
|
(with (
|
|
fsm (fsm-make (state-make fvwm-frame-behavior
|
|
(fvwm-button-behavior fvwm-side-action ())))
|
|
borderwidth 0
|
|
bar-min-width 0
|
|
bar-max-width 1000
|
|
cursor (if fvwm-resize-cursors cursor-S fvwm-frame-cursor)
|
|
plug-separator 0
|
|
redo-expr '(fvwm-hbar-tile frame-width active ())
|
|
tile (with (active ()) (eval redo-expr))
|
|
atile (with (active t) (eval redo-expr))
|
|
property (list 'pixmap tile 'activepixmap atile
|
|
'redo-expr redo-expr)
|
|
)
|
|
(bar-make (fvwm-resize-hplug-bl)
|
|
()
|
|
(fvwm-resize-hplug-br))))
|
|
|
|
(defun fvwm-resize-top-bar (small)
|
|
(with (
|
|
fsm (fsm-make (state-make fvwm-frame-behavior
|
|
(fvwm-button-behavior fvwm-side-action ())))
|
|
borderwidth 0
|
|
bar-min-width 0
|
|
bar-max-width 1000
|
|
cursor (if fvwm-resize-cursors cursor-N fvwm-frame-cursor)
|
|
plug-separator 0
|
|
redo-expr (if small
|
|
'(fvwm-hbar-tile (- frame-width 1) active t)
|
|
'(fvwm-hbar-tile frame-width active ()))
|
|
tile (with (active ()) (eval redo-expr))
|
|
atile (with (active t) (eval redo-expr))
|
|
property (list 'pixmap tile 'activepixmap atile
|
|
'redo-expr redo-expr)
|
|
)
|
|
(if small
|
|
(bar-make (fvwm-resize-hplug-tl2)
|
|
()
|
|
(fvwm-resize-hplug-tr2))
|
|
(bar-make (fvwm-resize-hplug-tl)
|
|
()
|
|
(fvwm-resize-hplug-tr)))))
|
|
|
|
(defun fvwm-left-bar ()
|
|
(if has-frame
|
|
(if has-resize
|
|
(fvwm-resize-left-bar has-title wide-shadow)
|
|
(fvwm-border-vertical-bar ()))))
|
|
|
|
(defun fvwm-right-bar ()
|
|
(if has-frame
|
|
(if has-resize
|
|
(fvwm-resize-right-bar has-title wide-shadow)
|
|
(fvwm-border-vertical-bar ()))))
|
|
|
|
(defun fvwm-bottom-bar ()
|
|
(if has-frame
|
|
(if has-resize
|
|
(fvwm-resize-bottom-bar)
|
|
(fvwm-border-bottom-bar))))
|
|
|
|
(defun fvwm-top-bar ()
|
|
(if has-frame
|
|
(if has-resize
|
|
(fvwm-resize-top-bar (and (not wide-shadow) has-title))
|
|
(fvwm-border-top-bar (and (not wide-shadow) has-title)))))
|
|
|
|
|
|
; THE TITLE-BAR :
|
|
; =============
|
|
|
|
(defun fvwm-title-plug (name-expr)
|
|
(with (borderwidth 0
|
|
label-vertical-margin 0
|
|
label-horizontal-margin 0
|
|
font title-font
|
|
name (eval name-expr)
|
|
background (# 1 active-color-scheme)
|
|
foreground (# 3 active-color-scheme)
|
|
atile (label-make name)
|
|
background (# 1 color-scheme)
|
|
foreground (# 3 color-scheme)
|
|
ntile (label-make name)
|
|
fsm (fsm-make fvwm-title-plug-behavior)
|
|
property (list 'pixmap ntile
|
|
'activepixmap atile
|
|
'font title-font
|
|
'name-expr name-expr
|
|
'bg (# 1 color-scheme)
|
|
'abg (# 1 active-color-scheme)
|
|
'fg (# 3 color-scheme)
|
|
'afg (# 3 active-color-scheme)))
|
|
(plug-make ntile)))
|
|
|
|
(defun fvwm-title-seam-pixmap (col wd)
|
|
(with (tile ()
|
|
foreground col)
|
|
(pixmap-make 1 wd)))
|
|
|
|
(defun fvwm-inner-titlebar ()
|
|
(with (
|
|
fsm (fsm-make (state-make fvwm-title-behavior
|
|
(fvwm-button-behavior fvwm-title-action 'press)))
|
|
lseam (fvwm-title-seam-pixmap (# 0 color-scheme) title-width)
|
|
rseam (fvwm-title-seam-pixmap (# 2 color-scheme) title-width)
|
|
alseam (fvwm-title-seam-pixmap (# 0 active-color-scheme) title-width)
|
|
arseam (fvwm-title-seam-pixmap (# 2 active-color-scheme) title-width)
|
|
lredo '(fvwm-title-seam-pixmap
|
|
(# (if pressed 2 0)
|
|
(if active active-color-scheme color-scheme)) title-width)
|
|
rredo '(fvwm-title-seam-pixmap
|
|
(# (if pressed 0 2)
|
|
(if active active-color-scheme color-scheme)) title-width)
|
|
redo-expr '(if pressed
|
|
(with (active-color-scheme
|
|
(list (# 2 active-color-scheme)
|
|
(# 1 active-color-scheme)
|
|
(# 0 active-color-scheme)))
|
|
(fvwm-hbar-tile title-width active 'title))
|
|
(fvwm-hbar-tile title-width active 'title))
|
|
tile (with (active () pressed ()) (eval redo-expr))
|
|
atile (with (active t pressed ()) (eval redo-expr))
|
|
ptile (with (active t pressed t) (eval redo-expr))
|
|
property (list 'pixmap tile
|
|
'activepixmap atile
|
|
'pressedpixmap ptile
|
|
'redo-expr redo-expr)
|
|
bar-min-width title-width
|
|
bar-max-width bar-min-width
|
|
)
|
|
(bar-make
|
|
(with (property (list 'pixmap lseam 'activepixmap alseam
|
|
'pressedpixmap arseam 'redo-expr lredo))
|
|
(plug-make lseam))
|
|
()
|
|
(fvwm-title-plug 'window-name)
|
|
()
|
|
(with (property (list 'pixmap rseam 'activepixmap arseam
|
|
'pressedpixmap alseam 'redo-expr rredo))
|
|
(plug-make rseam))
|
|
)))
|
|
|
|
(defun small-square (pixmap size light dark)
|
|
(with (x1 (/ (+ size 2) 3)
|
|
x2 (- size x1 1))
|
|
(with (foreground light)
|
|
(draw-line pixmap x1 x1 x1 x2)
|
|
(draw-line pixmap x1 x1 x2 x1))
|
|
(with (foreground dark)
|
|
(draw-line pixmap x1 x2 x2 x2)
|
|
(draw-line pixmap x2 x1 x2 x2))
|
|
pixmap))
|
|
|
|
(defun medium-square (pixmap size light dark)
|
|
(with (x1 (/ (+ size 4) 4)
|
|
x2 (- size x1 1))
|
|
(with (foreground light)
|
|
(draw-line pixmap x1 x1 x1 x2)
|
|
(draw-line pixmap x1 x1 x2 x1))
|
|
(with (foreground dark)
|
|
(draw-line pixmap x1 x2 x2 x2)
|
|
(draw-line pixmap x2 x1 x2 x2))
|
|
pixmap))
|
|
|
|
(defun large-square (pixmap size light dark)
|
|
(with (x1 (/ (+ size 6) 6)
|
|
x2 (- size x1 1))
|
|
(with (foreground light)
|
|
(draw-line pixmap x1 x1 x1 x2)
|
|
(draw-line pixmap x1 x1 x2 x1))
|
|
(with (foreground dark)
|
|
(draw-line pixmap x1 x2 x2 x2)
|
|
(draw-line pixmap x2 x1 x2 x2))
|
|
pixmap))
|
|
|
|
(defun horizontal-rectangle (pixmap size light dark)
|
|
(with (x1 (/ (+ size 6) 6)
|
|
x2 (- size x1 1)
|
|
y1 (/ (+ size 2) 3)
|
|
y2 (- size y1 1))
|
|
(with (foreground light)
|
|
(draw-line pixmap x1 y1 x1 y2)
|
|
(draw-line pixmap x1 y1 x2 y1))
|
|
(with (foreground dark)
|
|
(draw-line pixmap x1 y2 x2 y2)
|
|
(draw-line pixmap x2 y1 x2 y2))
|
|
pixmap))
|
|
|
|
(defun vertical-rectangle (pixmap size light dark)
|
|
(with (y1 (/ (+ size 6) 6)
|
|
y2 (- size y1 1)
|
|
x1 (/ (+ size 2) 3)
|
|
x2 (- size x1 1))
|
|
(with (foreground light)
|
|
(draw-line pixmap x1 y1 x1 y2)
|
|
(draw-line pixmap x1 y1 x2 y1))
|
|
(with (foreground dark)
|
|
(draw-line pixmap x1 y2 x2 y2)
|
|
(draw-line pixmap x2 y1 x2 y2))
|
|
pixmap))
|
|
|
|
(defun medium-circle (pixmap size light dark)
|
|
(with (x1 (/ (+ size 6) 5)
|
|
x2 (- size x1 1)
|
|
o1 (/ (* (+ size 2) 3) 8)
|
|
o2 (- size o1 1))
|
|
(with (foreground light)
|
|
(draw-line pixmap o1 x1 o2 x1)
|
|
(draw-line pixmap o1 x1 x1 o1)
|
|
(draw-line pixmap x1 o1 x1 o2))
|
|
(with (foreground dark)
|
|
(draw-line pixmap x2 o1 x2 o2)
|
|
(draw-line pixmap x2 o2 o2 x2)
|
|
(draw-line pixmap o1 x2 o2 x2))
|
|
pixmap))
|
|
|
|
(defun medium-diamond (pixmap size light dark)
|
|
(with (x1 (/ (+ size 6) 6)
|
|
x2 (- size x1 (% size 2))
|
|
h (/ size 2))
|
|
(with (foreground dark)
|
|
(draw-line pixmap h x1 x2 h)
|
|
(draw-line pixmap x2 h h x2))
|
|
(with (foreground light)
|
|
(draw-line pixmap h x1 x1 h)
|
|
(draw-line pixmap x1 h h x2))
|
|
pixmap))
|
|
|
|
(defun down-triangle (pixmap size light dark)
|
|
(with (x1 (/ (+ size 4) 4)
|
|
x2 (- size x1 (% size 2) -1)
|
|
h (/ size 2))
|
|
(with (foreground light)
|
|
(draw-line pixmap x1 x1 x2 x1)
|
|
(draw-line pixmap x1 x1 h x2))
|
|
(with (foreground dark)
|
|
(draw-line pixmap x2 x1 h x2))
|
|
pixmap))
|
|
|
|
(defun up-triangle (pixmap size light dark)
|
|
(with (x1 (/ (- size 4) 4)
|
|
x2 (- size x1 (% size 2) 2)
|
|
h (/ (- size 2) 2))
|
|
(with (foreground dark)
|
|
(draw-line pixmap x1 x2 x2 x2)
|
|
(draw-line pixmap x2 x2 h x1))
|
|
(with (foreground light)
|
|
(draw-line pixmap x1 x2 h x1))
|
|
pixmap))
|
|
|
|
(defun fvwm-button-pixmap (size active pressed draw-func)
|
|
(with (cols (if active active-color-scheme color-scheme)
|
|
foreground (# 1 cols)
|
|
tile ()
|
|
last (- size 1)
|
|
pixmap (pixmap-make size size))
|
|
(with (foreground (# (if pressed 2 0) cols))
|
|
(draw-line pixmap 0 0 last 0)
|
|
(draw-line pixmap 0 1 0 last))
|
|
(with (foreground (# (if pressed 0 2) cols))
|
|
(draw-line pixmap last 0 last last)
|
|
(draw-line pixmap 1 last last last))
|
|
(eval (list draw-func pixmap size (# 0 cols) (# 2 cols)))
|
|
pixmap))
|
|
|
|
(defun fvwm-interpret-event (event relp)
|
|
(with (ecode (if (= (type event) 'list)
|
|
(# 0 event)
|
|
(= event t)
|
|
any
|
|
event)
|
|
emod (if (= (type event) 'list)
|
|
(eval (+ '(together) (sublist 1 (length event) event)))
|
|
any))
|
|
(if (= (type ecode) 'string)
|
|
((if relp keyrelease keypress) (key-make ecode) emod)
|
|
(= (type ecode) 'number)
|
|
((if relp buttonrelease buttonpress) ecode emod)
|
|
())))
|
|
|
|
(setq fvwm-button-event-code ())
|
|
|
|
(defun fvwm-button-action-arc (evdesc action atype relp)
|
|
(on-eval (fvwm-interpret-event evdesc relp)
|
|
(if (not relp)
|
|
(list 'progn
|
|
'(if (and (boundp 'autofocus) (not autofocus))
|
|
(set-focus window))
|
|
'(send-user-event 'press wob)
|
|
(if (not (= atype 'release))
|
|
action
|
|
'(setq fvwm-button-event-code (current-event-code)))
|
|
(if (= atype 'press)
|
|
'(send-user-event 'release wob)))
|
|
(list 'progn
|
|
'(send-user-event 'release wob)
|
|
'(setq fvwm-button-rev (list (current-event-code) (current-event-modifier)))
|
|
(if (= atype 'release)
|
|
(list 'if '(= fvwm-button-event-code (current-event-code))
|
|
action))))))
|
|
|
|
(defun fvwm-button-behavior (action atype)
|
|
(if (not action)
|
|
(state-make ())
|
|
(= (type action) 'fsm-state)
|
|
action
|
|
(and action (= (type action) 'list) (= (type (# 0 action)) 'list))
|
|
(eval (+ '(state-make)
|
|
(mapfor ele action
|
|
(fvwm-button-action-arc (# 0 ele) (# 1 ele) (# 2 ele) ()))
|
|
(mapfor ele action
|
|
(fvwm-button-action-arc (# 0 ele) (# 1 ele) (# 2 ele) t))))
|
|
(state-make
|
|
(fvwm-button-action-arc t action atype ())
|
|
(fvwm-button-action-arc t action atype t))))
|
|
|
|
(defun fvwm-button-plug (draw action atype)
|
|
(with (redo-expr (list 'fvwm-button-pixmap 'title-width 'active 'pressed draw)
|
|
ntile (with (active () pressed ()) (eval redo-expr))
|
|
atile (with (active t pressed ()) (eval redo-expr))
|
|
ptile (with (active t pressed t) (eval redo-expr))
|
|
property (list 'pixmap ntile
|
|
'activepixmap atile
|
|
'pressedpixmap ptile
|
|
'redo-expr redo-expr)
|
|
fsm (fsm-make (state-make fvwm-title-behavior
|
|
(fvwm-button-behavior action atype))))
|
|
(plug-make ntile)))
|
|
|
|
(defun fvwm-title-row (border resize shadow)
|
|
(with (fsm (fsm-make fvwm-frame-behavior)
|
|
plug-separator 0
|
|
lseam-expr '(fvwm-title-seam-pixmap
|
|
(# 0 (if active active-color-scheme color-scheme))
|
|
(+ title-width 2))
|
|
rseam-expr '(fvwm-title-seam-pixmap
|
|
(# 2 (if active active-color-scheme color-scheme))
|
|
(+ title-width 2))
|
|
seams (or shadow (not border))
|
|
lseam (if seams (with (active ()) (eval lseam-expr)))
|
|
alseam (if seams (with (active t) (eval lseam-expr)))
|
|
rseam (if seams (with (active ()) (eval rseam-expr)))
|
|
arseam (if seams (with (active t) (eval rseam-expr)))
|
|
lseam-prop (list 'pixmap lseam 'activepixmap alseam
|
|
'redo-expr lseam-expr)
|
|
rseam-prop (list 'pixmap rseam 'activepixmap arseam
|
|
'redo-expr rseam-expr)
|
|
redo-expr '(fvwm-hbar-tile (+ title-width 2) active ())
|
|
tile (with (active ()) (eval redo-expr))
|
|
atile (with (active t) (eval redo-expr))
|
|
property (list 'pixmap tile 'activepixmap atile
|
|
'redo-expr redo-expr)
|
|
bar-min-width (if (and (not wide-shadow) border)
|
|
(+ title-width 1)
|
|
(+ title-width 2))
|
|
bar-max-width bar-min-width
|
|
params1 (+
|
|
(if seams (with (property lseam-prop)
|
|
(list (plug-make lseam))))
|
|
(mapfor descr fvwm-left-plugs
|
|
(fvwm-button-plug (# 0 descr) (# 1 descr) (# 2 descr)))
|
|
(list (bar-make () (fvwm-inner-titlebar) ()))
|
|
(mapfor descr fvwm-right-plugs
|
|
(fvwm-button-plug (# 0 descr) (# 1 descr) (# 2 descr)))
|
|
(if seams (with (property rseam-prop)
|
|
(list (plug-make rseam)))))
|
|
params2 (+
|
|
(if border
|
|
(if resize
|
|
(list (fvwm-resize-vplug-tl2 shadow))
|
|
(list (fvwm-border-vertical-bar (if (not shadow) 'left)))))
|
|
(list (bar-make (eval (+ '(bar-make) params1))))
|
|
(if border
|
|
(if resize
|
|
(list (fvwm-resize-vplug-tr2 shadow))
|
|
(list (fvwm-border-vertical-bar (if (not shadow) 'right)))))
|
|
))
|
|
(eval (+ '(bar-make) params2))))
|
|
|
|
(defun fvwm-titlebar ()
|
|
(if has-title
|
|
(with (menu ()
|
|
fsm ()
|
|
plug-separator 0
|
|
cursor fvwm-frame-cursor
|
|
borderwidth 0
|
|
bar-min-width 0
|
|
bar-max-width 1000)
|
|
(if has-frame
|
|
(bar-make (bar-make (fvwm-top-bar)
|
|
(fvwm-title-row has-frame has-resize wide-shadow)))
|
|
(fvwm-title-row has-frame has-resize wide-shadow)))
|
|
(if has-frame (fvwm-top-bar))))
|
|
|
|
|
|
; INTERNAL BEHAVIOR OF WINDOWS :
|
|
; ============================
|
|
(setq fvwm-window-behavior
|
|
(state-make
|
|
(on focus-out
|
|
(maintain-focus-out))
|
|
(on focus-in
|
|
(progn
|
|
(maintain-focus-in)
|
|
(if (eval (boundp 'autocolormap))
|
|
(set-colormap-focus))))
|
|
(on leave-window-not-from-grab
|
|
(progn
|
|
(if (or (not (boundp 'autofocus)) autofocus)
|
|
(set-focus ()))
|
|
(if (and (eval (boundp 'autofocus)) (eval (boundp 'autocolormap)))
|
|
(set-colormap-focus ()))))
|
|
(on enter-window
|
|
(if (or (not (boundp 'autofocus)) autofocus)
|
|
(set-focus)))
|
|
(on name-change
|
|
(progn
|
|
(send-user-event 'name-change)
|
|
(if (window-icon?)
|
|
(progn
|
|
(send-user-event 'name-change window-icon)
|
|
(if (boundp 'update-placements)
|
|
(with (wob window-icon)
|
|
(update-placements)))))
|
|
(if (boundp 'icon-mgr-update)
|
|
(icon-mgr-update))))
|
|
(on (property-change "WM_ICON_NAME")
|
|
(progn
|
|
(if (window-icon?)
|
|
(progn
|
|
(send-user-event 'name-change window-icon)
|
|
(if (boundp 'update-placements)
|
|
(with (wob window-icon)
|
|
(update-placements)))))
|
|
(if (boundp 'icon-mgr-update)
|
|
(icon-mgr-update))))
|
|
(on window-icon-pixmap-change
|
|
(if (window-icon?)
|
|
(send-user-event 'icon-pixmap-change window-icon)))
|
|
)
|
|
)
|
|
|
|
(defun maintain-focus-in ()
|
|
(send-user-event 'focus-in window)
|
|
(## 'virt-col window (# 'virt-col2 window))
|
|
(## 'virt-act window t)
|
|
(if (boundp 'icon-mgr-focusin)
|
|
(icon-mgr-focusin))
|
|
(if (eval (boundp 'autoraise))
|
|
(raise-window)
|
|
(if (and fvwm-virtual-colors
|
|
(boundp 'virtual-update)
|
|
(not (= (# 'virt-col1 window) (# 'virt-col2 window))))
|
|
(virtual-update)))
|
|
; (if (eval (boundp 'autocolormap))
|
|
; (set-colormap-focus))
|
|
)
|
|
|
|
(defun maintain-focus-out ()
|
|
(send-user-event 'focus-out window)
|
|
(## 'virt-col window (# 'virt-col1 window))
|
|
(## 'virt-act window ())
|
|
(if (boundp 'icon-mgr-focusout)
|
|
(icon-mgr-focusout))
|
|
(if (and fvwm-virtual-colors
|
|
(boundp 'virtual-update)
|
|
(not (= (# 'virt-col1 window) (# 'virt-col2 window))))
|
|
(virtual-update))
|
|
; (if (eval (boundp 'autocolormap))
|
|
; (set-colormap-focus ()))
|
|
)
|
|
|
|
(defunq fvwm-get-style (plist prop def)
|
|
(with (plist (eval plist)
|
|
prop (eval prop))
|
|
(if (member prop plist)
|
|
(# prop plist)
|
|
(eval def))))
|
|
|
|
(defun fvwm-get-colors (styles props)
|
|
(with (col (or (fvwm-get-style props 'color ())
|
|
(# 0 styles) fvwm-color)
|
|
acol (or (fvwm-get-style props 'active-color
|
|
(or (# 1 styles) fvwm-active-color))
|
|
col)
|
|
tcol (or (fvwm-get-style props 'title-color ())
|
|
(# 2 styles) fvwm-title-color "black")
|
|
atcol (or (fvwm-get-style props 'active-title-color
|
|
(or (# 3 styles) fvwm-active-title-color))
|
|
tcol))
|
|
(list col acol tcol atcol)))
|
|
|
|
(defun fvwm-resize-window ()
|
|
(with (resize-style 1
|
|
mwm-resize-style-corner-size (or (# 'resize-corner-size window) 1)
|
|
mwm-resize-style-catch-corners 1)
|
|
(resize-window)))
|
|
|
|
(defun fvwm-update-color ()
|
|
(with (props (matches-cond-all fvwm-window-styles)
|
|
cols (fvwm-get-colors (matches-cond fvwm-color-styles) props)
|
|
corner-size (# 'resize-corner-size window)
|
|
frame-width (# 'frame-width window)
|
|
title-width (# 'title-width window)
|
|
is-active (# 'virt-act window)
|
|
color-scheme (make-color-scheme (# 0 cols) (# 2 cols))
|
|
active-color-scheme (make-color-scheme (# 1 cols) (# 3 cols)))
|
|
(send-user-event 'pre-color window)
|
|
(send-user-event 're-color window)
|
|
(if (window-icon?)
|
|
(send-user-event 'update-color window-icon))
|
|
(## 'virt-col window (# 0 (if is-active active-color-scheme color-scheme)))
|
|
(## 'virt-col1 window (# 0 color-scheme))
|
|
(## 'virt-col2 window (# 0 active-color-scheme))
|
|
(if (and fvwm-virtual-colors (boundp 'virtual-update))
|
|
(virtual-update))))
|
|
|
|
(defun fvwm-nail-window ()
|
|
(virtual-nail)
|
|
(fvwm-update-color))
|
|
|
|
(defun fvwm-unnail-window ()
|
|
(virtual-unnail)
|
|
(fvwm-update-color))
|
|
|
|
(defun fvwm-toggle-nail-window ()
|
|
(virtual-toggle-nail)
|
|
(fvwm-update-color))
|
|
|
|
|
|
(defun fvwm-window ()
|
|
(with (fsm (fsm-make (state-make fvwm-window-behavior standard-behavior))
|
|
cursor fvwm-frame-cursor
|
|
props (matches-cond-all fvwm-window-styles)
|
|
cols (fvwm-get-colors (matches-cond fvwm-color-styles) props)
|
|
has-frame (fvwm-get-style props 'frame fvwm-has-frame)
|
|
has-resize (fvwm-get-style props 'resize fvwm-has-resize)
|
|
has-title (fvwm-get-style props 'title fvwm-has-title)
|
|
wide-shadow (fvwm-get-style props 'wide-shadow fvwm-wide-shadow)
|
|
title-font (fvwm-get-style props 'title-font fvwm-title-font)
|
|
fonthgt (with (font title-font
|
|
label-vertical-margin 0
|
|
label-horizontal-margin 0)
|
|
(# 3 (dimensions " ")))
|
|
title-width (or (fvwm-get-style props 'title-width fvwm-title-width)
|
|
(+ 4 fonthgt))
|
|
frame-width (fvwm-get-style props 'frame-width fvwm-frame-width)
|
|
corner-size (max (or (fvwm-get-style props 'corner-size
|
|
fvwm-corner-size)
|
|
(+ title-width frame-width (if wide-shadow 2 0)))
|
|
(+ frame-width 2))
|
|
fvwm-left-plugs (fvwm-get-style props 'left-plugs fvwm-left-plugs)
|
|
fvwm-right-plugs (fvwm-get-style props 'right-plugs fvwm-right-plugs)
|
|
fvwm-border-action (fvwm-get-style props 'border-action fvwm-border-action)
|
|
fvwm-side-action (fvwm-get-style props 'side-action fvwm-side-action)
|
|
fvwm-corner-action (fvwm-get-style props 'corner-action fvwm-corner-action)
|
|
fvwm-title-action (fvwm-get-style props 'title-action fvwm-title-action)
|
|
inner-border (fvwm-get-style props 'inner-border fvwm-inner-border)
|
|
outer-border (fvwm-get-style props 'outer-border fvwm-outer-border)
|
|
color-scheme (make-color-scheme (# 0 cols) (# 2 cols))
|
|
active-color-scheme (make-color-scheme (# 1 cols) (# 3 cols))
|
|
inner-borderwidth (if inner-border
|
|
(if (= (type inner-border) 'number)
|
|
inner-border 1) 0)
|
|
borderwidth (if outer-border
|
|
(if (= (type outer-border) 'number)
|
|
outer-border 1) 0)
|
|
borderpixel black
|
|
property (list 'resize-corner-size (if has-resize corner-size 1)
|
|
'frame-width frame-width
|
|
'title-width title-width
|
|
'virt-col (# 0 color-scheme)
|
|
'virt-col1 (# 0 color-scheme)
|
|
'virt-col2 (# 0 active-color-scheme)
|
|
'virt-act ()))
|
|
(window-make (fvwm-titlebar) (fvwm-left-bar)
|
|
(fvwm-right-bar) (fvwm-bottom-bar) ())))
|
|
|