home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / framemaker.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  3KB  |  93 lines
  1. ;; a sample special-purpose customisation for framemaker windows
  2.  
  3. ;;=============================================================================
  4. ;; framemaker windows
  5. ;;=============================================================================
  6. ;; frame windows: Maker.name
  7. ;; where name is *kit (makerkit, dockit) for main windows
  8. ;; other for popups
  9.  
  10. ;; frame icons:
  11. (setq frame-icon-color.1 (color-make "RoyalBlue1"))
  12. (setq frame-icon-font.1 pop-item.font)
  13. (setq frame-icon-color.2 (color-make "RoyalBlue2"))
  14. (setq frame-icon-font.2 small-font)
  15. (setq frame-inactive-color frame-icon-color.1)
  16. (setq frame-active-color (color-make "RoyalBlue4"))
  17.  
  18. ;; frame windows:
  19. ;; main windows:
  20. (set-window Maker.dockit (simple-win
  21.     'background frame-inactive-color
  22.     'active.background frame-active-color
  23.     'label.background frame-inactive-color
  24. ))
  25. ;; popups:
  26. (set-window Maker (simple-win
  27.     'map-on-raise t
  28.     'font small-font
  29.     'background frame-inactive-color
  30.     'active.background frame-active-color
  31.     'label.background frame-inactive-color
  32. ))
  33.  
  34. (require 'simple-icon)
  35.  
  36. ;; an icon decoration for framemaker
  37. (set-icon-window Maker
  38.   (if (= "makerkit" window-client-name) ; top window(menu): use frame pixmap
  39.     (simple-icon 'background frame-icon-color.2)
  40.  
  41.     (match ".*kit" window-client-name)
  42.     (progn                ; main edit windows: icon name
  43.       (simple-icon 'background frame-icon-color.1
  44.     'simple-icon.plug-name (+ "[ " window-icon-name " ]")
  45.     'simple-icon.no-center-plug t
  46.     'font frame-icon-font.1
  47.       )
  48.     )
  49.  
  50.                     ; all popups, use a smaller name
  51.     (with (name (match "FrameMaker - \\(.*\\)$" window-name 1))
  52.       (if (= name "")
  53.     (setq name window-name)
  54.       )
  55.       (simple-icon 'background frame-icon-color.2
  56.     'font frame-icon-font.2
  57.     'simple-icon.plug-name name)
  58. )))
  59.  
  60. ;; center main frame windows in screen if they map offscreen, 
  61. ;; make frame popups appear under cursor
  62.  
  63. (set-placement Maker
  64.   (lambda (f) (if f 
  65.       (if 
  66.     (match ".*kit" window-client-name)
  67.     (if (or (< window-x 0) (< window-y 0))
  68.       (move-window 0 0)
  69.     )
  70.     
  71.     t
  72.     (with (mouse-pos (current-mouse-position)
  73.         x (# 0 mouse-pos)
  74.         y (# 1 mouse-pos)
  75.         xe 0
  76.         ye 0
  77.       )
  78.       (setq x (- x (/ window-width 2)))
  79.       (setq y (- y (/ window-height 2)))
  80.       (setq xe (+ x (window-width)))
  81.       (setq ye (+ y (window-height)))
  82.       (if (< x 0) (setq x 0))
  83.       (if (< y 0) (setq y 0))
  84.       (if (> xe screen-width) (setq x (- screen-width
  85.         (window-width)
  86.       )))
  87.       (if (> ye screen-height) (setq y (- screen-height
  88.         (window-height)
  89.       )))
  90.       (move-window x y)
  91. )))))
  92.  
  93.