Commit 64c49c91 authored by hatchond's avatar hatchond
Browse files

- package.lisp: now export almost every symbols. They are sorted in

  alphabetical order and type order (class, generic function,
  function, ...)

- input.lisp: minor modification in event-process for client-message on
  application. An application that does not support to be maximized in
  fullscreen don't have the _net_wm_state_fullscreen property sets
  anymore.

- lib/clx-patch.lisp: fixed bug found in input-focus.

- wm.lisp:
   focused-p modified.
   dispatch-repaint: new method for the repaint protocol.
   draw-focused-decoration & draw-unfocused-decoration: removed.

- widget.lisp:
   focused-p modified.
   repaint implementations for icon, button and box-button.

- themer.lisp: themes are now defined in their own packages.

- themes/*/theme.lisp: All default themes converted in this new
  system.

The rest concern what we discuss on precedent post about a repaint
protocol.

The two generic functions draw-on-focus-{in,out} had been supressed in
favor of a single one named repaint.

 repaint widget name focus [generic function]
  This method is dedicated to widget repaint such as every buttons,
  icons, edges ...
  It is specialized on widget type, theme name (via an eql
  specializer) and a boolean that indicate if the corresponding
  toplevel (type decoration) is or not focused.

  Except for standard expose events, the repaint dispatching on focus
  change will be perform according to parts-to-redraw-on-focus list
  given in define-theme.

  The core of eclipse provide some basic implementation for the
  repaint method:

  (defmethod repaint ((widget base-widget) theme-name (focused-p t))
    (values))

  (defmethod repaint ((widget button) theme-name (focused-p t))
    ;; draw a pixmap if the button provide a pixmap to display when
    ;; toplevel is focused.
    ;; in case of title bar draw a centered text corresponding to the app
    ;; name.
    )

  (defmethod repaint ((widget button) theme-name (focused-p null))
    ;; clear the button.
    )

  (defmethod repaint ((widget box-button) theme-name focused-p)
    ;; draw the message that is displayed by this box.
    )

  (defmethod repaint ((widget icon) theme-name focused-p)
    ;; draw the icon name if aplication does not provide a pixmap for it.
    )

  This method is expected to be overloaded by theme implementors as
  well as to be exported by theme package definition.

  Theme implementation notes:
  --------------------------

   - themes are supposed to be defined in their own packages.
   - theme package definition should be suplied.
   - the naming convention for themes packages is:
     <theme-name>-ECLIPSE-THEME.

   Typically a theme package will export at least two symbols:
    - INITIALIZE-FRAME
    - REPAINT

   Here comes an example of how defining a theme (see our predefined
   themes for more):

   ;;; -*- Mode: Lisp; Package: FOO-ECLIPSE-THEME -*-
   ;;; GPL Disclaimer for example.
   ;;; file theme.lisp

   (common-lisp:in-package :common-lisp-user)

   (defpackage "FOO-ECLIPSE-THEME"
     (:use eclipse clx-ext common-lisp)
     (:size 10)
     (:export repaint initialize-frame)
     (:documentation
      "Foo theme decoration for the eclipse window manager. Written by ...")
     )

   (in-package "FOO-ECLIPSE-THEME")

   (define-theme "Foo"
       ;; the rest of the definition
       )

   (defmethod repaint ((widget title-bar) (name (eql "Foo")) (focus t))
     "handle repaint WHEN focused."
     ;; do some stuff
     )

   (defmethod repaint ((widget title-bar) (name (eql "Foo")) (focus null))
     "handle repaint WHEN NOT focused."
     ;; do some stuff
     )

   (defun bar ()
     ;; do what you want
     )

   ;;; end of theme.lisp
parent eaabc4cf
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: gestures.lisp,v 1.2 2003/03/16 00:38:55 hatchond Exp $
;;; $Id: gestures.lisp,v 1.3 2003/03/17 11:13:17 hatchond Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -253,8 +253,8 @@
(handler-bind
((error #'(lambda (condition)
(declare (ignorable condition))
(format t "Can't realize key-combo ~A~%" name)
(format t " modifiers : ~A~% key : ~A~%" modifiers keys)
(format *stderr* "Can't realize key-combo ~A~%" name)
(format *stderr* " mods : ~A~% key : ~A~%" modifiers keys)
(throw 'keystroke-definition nil))))
(let ((ks (make-keystroke name keys modifiers default-modifiers-p fun)))
(when (stroke-equal ks (gethash name *keystrokes*))
......@@ -274,8 +274,8 @@
(handler-bind
((error #'(lambda (condition)
(declare (ignorable condition))
(format t "Can't realize mouse-combo ~A~%" name)
(format t " modifiers : ~A~% key : ~A~%" modifiers button)
(format *stderr* "Can't realize mouse-combo ~A~%" name)
(format *stderr* " mods : ~A~% key : ~A~%" modifiers button)
(throw 'mouse-stroke-definition nil))))
(let ((ms (make-mouse-stroke
name button modifiers default-modifiers-p fun)))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: input.lisp,v 1.6 2003/05/13 14:54:01 hatchond Exp $
;;; $Id: input.lisp,v 1.7 2003/05/14 08:56:17 hatchond Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -284,7 +284,7 @@
(defmethod event-process ((event focus-out) (application application))
(with-slots (master) application
(when (and master (not (eql (event-mode event) :while-grabbed)))
(draw-unfocused-decoration master))))
(dispatch-repaint master :focus nil))))
(defmethod event-process ((event focus-in) (application application))
(with-slots (master window) application
......@@ -293,7 +293,7 @@
;; if focus policy is on-click.
(when (eq *focus-type* :on-click)
(vs:restack-window window (vs:nth-vscreen (root-vscreens *root*))))
(when master (draw-focused-decoration master))
(when master (dispatch-repaint master :focus t))
(setf (netwm:net-active-window *root-window*) window))))
(defmethod event-process ((event property-notify) (app application))
......@@ -348,31 +348,32 @@
;; win_state_maximized_horiz
(when (logbitp 3 to-change) (maximize-window master 3)))))
(:_NET_WM_STATE
(let ((action (aref data 0))
(let ((mode (aref data 0))
(prop (netwm:net-wm-state window))
(prop1 (id->atom-name (aref data 1)))
(prop2 (unless (zerop (aref data 2))
(id->atom-name (aref data 2)))))
(case action
(case mode
(0 (setf prop (remove prop1 prop))
(when prop2 (setf prop (remove prop2 prop))))
(1 (push prop1 prop)
(when prop2 (push prop2 prop))))
(setf (netwm:net-wm-state window) prop)
(1 (pushnew prop1 prop)
(when prop2 (pushnew prop2 prop))))
(when (or (eq prop1 :_net_wm_state_hidden)
(eq prop2 :_net_wm_state_hidden))
(if (= action 0) (uniconify application) (iconify application)))
(if (= mode 0) (uniconify application) (iconify application)))
(when (or (eql prop1 :_net_wm_state_fullscreen)
(eql prop2 :_net_wm_state_fullscreen))
(when (fullscreenable-p application)
(setf (full-screen-mode application) (if (= action 0) :off :on))))
(if (fullscreenable-p application)
(setf (full-screen-mode application) (if (= mode 0) :off :on))
(setf prop (remove :_net_wm_state_fullscreen prop))))
(when master
(when (or (eql prop1 :_net_wm_state_maximized_vert)
(eql prop2 :_net_wm_state_maximized_vert))
(maximize-window master 2))
(when (or (eql prop1 :_net_wm_state_maximized_horz)
(eql prop2 :_net_wm_state_maximized_horz))
(maximize-window master 3)))))
(maximize-window master 3)))
(setf (netwm:net-wm-state window) prop)))
(:_NET_WM_DESKTOP
(let* ((cur-desk (gnome:win-workspace window))
(new-desk (aref data 0))
......@@ -390,21 +391,14 @@
;;; Events for buttons
(defun redraw-icon-and-box-button (exposure-event button &key (color *white*))
(when (zerop (event-count exposure-event))
(with-slots (window item-to-draw gcontext) button
(xlib:clear-area window)
(draw-centered-text window gcontext item-to-draw :color color))))
(defmethod event-process ((event exposure) (button button))
(when (zerop (event-count event))
(with-slots (master) button
(if (or (not master) (focused-p master))
(draw-on-focus-in button)
(draw-on-focus-out button)))))
(let ((name (theme-name (root-decoration-theme *root*))))
(repaint button name (and master (focused-p master)))))))
(defmethod event-process ((event exposure) (box box-button))
(redraw-icon-and-box-button event box :color *black*))
(repaint box (theme-name (root-decoration-theme *root*)) nil))
(defmethod event-process ((event button-release) (close close-button))
(close-widget (get-child (button-master close) :application)))
......@@ -483,7 +477,7 @@
;;; events for an icon
(defmethod event-process ((event exposure) (icon icon))
(redraw-icon-and-box-button event icon))
(repaint icon (theme-name (root-decoration-theme *root*)) nil))
(defmethod event-process ((event button-press) (icon icon))
(setf (icon-desiconify-p icon) t
......
;;; -*- Mode: Lisp -*-
;;; $Id: clx-patch.lisp,v 1.2 2002/06/24 07:30:33 james Exp $
;;; $Id: clx-patch.lisp,v 1.1 2002/11/07 14:22:42 hatchond Exp $
;;;
;;; This file contains the patch fixing a bug in CLX as distributed
;;; with vanilla CMUCL versions up to 18d.
......@@ -13,6 +13,15 @@
(xlib:int16 x y)
(xlib:card16 width height border-width value-mask))
#|
This patch is also buggy: trying to find a window returns unexisting window
structure at X server level. But as already said
(see http://www.mail-archive.com/cmucl-help@cons.org/msg00173.html) reversing
(xlib::or-get 8 window (member :none :pointer-root)) for
(xlib::or-get 8 (member :none :pointer-root) window) doesn't work.
Indeed O or 1 are inappropriated ID's.
(defun xlib:input-focus (display)
(declare (type xlib:display display))
(declare (xlib::clx-values focus revert-to))
......@@ -22,3 +31,20 @@
(values
(xlib::or-get 8 window (member :none :pointer-root))
(xlib::member8-get 1 :none :pointer-root :parent))))
|#
(defun xlib:input-focus (display)
(declare (type xlib:display display))
(declare (xlib::clx-values focus revert-to))
(xlib::with-buffer-request-and-reply
(display xlib::*x-getinputfocus* 16 :sizes (8 32))
()
(values
(let ((id (xlib::card29-get 8)))
(declare (type xlib::card29 id))
(case id
(0 :none)
(1 :pointer-root)
(t (xlib::lookup-window display id))))
(xlib::member8-get 1 :none :pointer-root :parent))))
;;; -*- Mode: Lisp; Package: User -*-
;;; $Id: package.lisp,v 1.1 2002/11/07 15:08:44 hatchond Exp $
;;; $Id: package.lisp,v 1.2 2003/03/16 01:20:33 hatchond Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -20,11 +20,345 @@
(common-lisp:in-package :common-lisp-user)
(defpackage ECLIPSE-INTERNALS
(defpackage "ECLIPSE-INTERNALS"
(:nicknames eclipse ewmi)
(:use clx-extensions common-lisp)
(:size 10)
(:size 500)
(:documentation "")
(:export
eclipse
)
(:documentation ""))
"APPLICATION" ;class
"BASE-WIDGET" ;class
"BOTTOM" ;class
"BOTTOM-LEFT" ;class
"BOTTOM-RIGHT" ;class
"BOX-BUTTON" ;class
"BUTTON" ;class
"CLOSE-BUTTON" ;class
"DECORATION" ;class
"DEFAULT-STYLE" ;class
"ECLIPSE-SCREENS" ;class
"EDGE" ;class
"FRAME-STYLE" ;class
"GEOMETRY" ;class
"ICON" ;class
"ICONIFY-BUTTON" ;class
"KEYSTROKE" ;class
"LEFT" ;class
"MAXIMIZE-BUTTON" ;class
"MENU-BUTTON" ;class
"MENU-ITEM" ;class
"MENU-LEAF-ITEM" ;class
"MENU-WIDGET" ;class
"MOUSE-STROKE" ;class
"POP-UP-MENU" ;class
"PUSH-BUTTON" ;class
"RIGHT" ;class
"STROKE" ;class
"SUB-MENU" ;class
"THEME" ;class
"TITLE-BAR" ;class
"TOP" ;class
"TOP-LEFT" ;class
"TOP-RIGHT" ;class
"TRANSIENT-STYLE" ;class
"APPLICATION-CLASS" ;function
"APPLICATION-CLASS-NAME" ;function
"APPLICATION-CLASS-TYPE" ;function
"APPLICATION-FIND" ;function
"APPLICATION-LIST" ;function
"APPLICATION-NAME" ;function
"APPLICATION-P" ;function
"BASE-WIDGET-P" ;function
"BUTTON-P" ;function
"CHECK-SIZE" ;function
"COPY-GEOMETRY" ;function
"CREATE-APPLICATION" ;function
"CREATE-BUTTON" ;function
"CREATE-ECLIPSE-VIRTUAL-SCREENS" ;function
"CREATE-ICON" ;function
"CREATE-MESSAGE-BOX" ;function
"DECORATION-P" ;function
"DECORATION-THEME" ;setf function
"DECORE-APPLICATION" ;function
"DEFAULT-HANDLER" ;function
"DEFAULT-STYLE-P" ;function
"DEFINE-KEY-COMBO" ;function
"DEFINE-MENU-3" ;function
"DEFINE-MOUSE-COMBO" ;function
"DELETE-ROOT-PROPERTIES" ;function
"DISMISS-MOVE-RESIZE" ;function
"DISPLAY-COORDINATES" ;function
"DISPLAY-GEOMETRY" ;function
"DISPLAY-INFOS" ;function
"DRAW-FOCUSED-DECORATION" ;function
"DRAW-UNFOCUSED-DECORATION" ;function
"DRAW-WINDOW-GRID" ;function
"ECLIPSE" ;function
"ECLIPSE-PATH" ;function
"EDGE-POSITION" ;function
"ENSURE-THEME-DIRECTORY-EXISTS" ;function
"FINALIZE-MOVE" ;function
"FIND-CORNER" ;function
"FIND-DECORATION-FRAME-STYLE" ;function
"FIND-INPUT-MODEL" ;function
"FINISH-RESIZE" ;function
"FONT-NAME" ;setf function
"FREE-THEME" ;function
"FULLSCREENABLE-P" ;function
"FULL-SCREEN-MODE" ;setf function
"GEOMETRY-COORDINATES" ;function
"GEOMETRY-H" ;function
"GEOMETRY-P" ;function
"GEOMETRY-SIZES" ;function
"GEOMETRY-W" ;function
"GEOMETRY-X" ;function
"GEOMETRY-Y" ;function
"GET-MAX-ITEM-WIDTH" ;function
"GET-VISIBLE-WINDOWS" ;function
"GIVE-FOCUS-TO-NEXT-WIDGET-IN-DESKTOP" ;function
"GNOME-DESKTOP-NUM" ;function
"HIGHLIGHT" ;function
"HOME-SUBDIRECTORY" ;function
"ICON-BOX-UPDATE" ;function
"ICON-P" ;function
"ICON-SORT-CREATION-ORDER" ;function
"ICON-SORT-NAME" ;function
"ICON-SORT-TYPE" ;function
"INIT-EDGES-CURSORS" ;function
"INIT-GNOME-COMPLIANCE" ;function
"INITIALIZE-CLONE" ;function
"INITIALIZE-FRAME" ;function
"INITIALIZE" ;function
"INITIALIZE-GEOMETRY-INFO-BOX" ;function
"INITIALIZE-MANAGER" ;function
"INITIALIZE-ROOT" ;function
"INIT-LOG-FILE" ;function
"KEYCODE-REGISTERED-P" ;function
"KEYSTROKE-P" ;function
"KILL-CLIENT-WINDOW" ;function
"LOAD-CONFIG-FILE" ;function
"LOAD-PNM->PIXMAP" ;function
"LOAD-THEME" ;function
"LOOKUP-KEYSTROKE" ;function
"LOOKUP-MOUSE-STROKE" ;function
"LOOKUP-THEME" ;function
"LOOKUP-WIDGET" ;function
"MAKE-BACKGROUND-PIXMAP" ;function
"MAKE-BUTTONS-BAR" ;function
"MAKE-CORNER" ;function
"MAKE-DECORATION" ;function
"MAKE-DESK-ENTRIES" ;function
"MAKE-EDGES" ;function
"MAKE-GEOMETRY" ;function
"MAKE-KEYSTROKE" ;function
"MAKE-MENU-BUTTON" ;function
"MAKE-MENU-BUTTON-MENU" ;function
"MAKE-MENU-LEAF-ITEM" ;function
"MAKE-MOUSE-STROKE" ;function
"MAKE-POP-UP" ;function
"MAKE-RAISE-WINDOW" ;function
"MAKE-RUNNING-MENU" ;function
"MAKE-SUB-MENU" ;function
"MAKE-SUBSTRUCTURE" ;function
"MAKE-TITLE-BAR" ;function
"MAKE-VIEW-PORT-PROPERTY" ;function
"MAXIMIZE-WINDOW" ;function
"MOTIF-WM-DECORATION" ;function
"MOUSE-STROKE-FOR-MOVE-AND-RESIZE" ;function
"MOUSE-STROKE-P" ;function
"MOVE-CURSOR-DOWN" ;function
"MOVE-CURSOR-LEFT" ;function
"MOVE-CURSOR-RIGHT" ;function
"MOVE-CURSOR-UP" ;function
"MOVE-WIDGET" ;function
"NUMBER-OF-VIRTUAL-SCREENS" ;setf function
"PERFORM-CLICK" ;function
"PIXMAP-HEIGHT" ;function
"PIXMAP-WIDTH" ;function
"PROCEDE-DECORATION" ;function
"PUT-ON-TOP" ;function
"QUERY-APPLICATION-TREE" ;function
"%QUIT%" ;function
"RAISE-WINDOW" ;function
"REALIZE-MENU-ITEMS" ;function
"REALIZE-POP-UP" ;function
"RECOMPUTE-WM-NORMAL-HINTS" ;function
"REGISTER-ALL-KEYSTROKES" ;function
"REGISTER-ALL-MOUSE-STROKES" ;function
"RUN-APPLICATION" ;function
"SEND-WM-PROTOCOLS-CLIENT-MESSAGE" ;function
"STICK-P" ;function
"TIMED-MESSAGE-BOX" ;function
"TITLE-BAR-HORIZONTAL-P" ;function
"TRANSIENT-STYLE-P" ;function
"UNDECORE-APPLICATION" ;function
"UNDRAW-GEOMETRY-INFO-BOX" ;function
"UNREGISTER-ALL-KEYSTROKES" ;function
"UNREGISTER-ALL-MOUSE-STROKES" ;function
"UPDATE-CLONE" ;function
"UPDATE-EDGES-GEOMETRY" ;function
"UPDATE-LISTS" ;function
"UPDATE-TITLE-BAR-SIZES" ;function
"WHERE-IS-POINTER" ;function
"WINDOW-DESKTOP-NUM" ;setf function
"WINDOW-TRANSIENT-P" ;function
"WM-ICON-NAME" ;function
"WM-NAME" ;function
"WM-STATE" ;function
"WORKSPACE-NAMES" ;setf function
"ADD-DESKTOP-APPLICATION" ;generic function
"ADD-TO-VSCREEN" ;generic function
"APPLICATION-DESKTOP-NUMBER" ;generic function
"APPLICATION-ICON" ;generic function
"APPLICATION-ICONIC-P" ;generic function
"APPLICATION-INPUT-MODEL" ;generic function
"APPLICATION-MASTER" ;generic function
"APPLICATION-UNOBSCURED-P" ;generic function
"APPLICATION-WANTS-FOCUS-P" ;generic function
"ARM-BRANCH" ;generic function
"ARM" ;generic function
"BOTTOM-LEFT-H" ;generic function
"BOTTOM-LEFT-W" ;generic function
"BOTTOM-RIGHT-H" ;generic function
"BOTTOM-RIGHT-W" ;generic function
"BUTTON-ACTIVE-P" ;generic function
"BUTTON-ARMED" ;generic function
"BUTTON-ITEM-TO-DRAW" ;generic function
"BUTTON-MASTER" ;generic function
"CHANGE-VSCREEN" ;generic function
"CIRCULATE-WINDOW" ;generic function
"CLOSE-WIDGET" ;generic function
"DECORATION-ACTIVE-P" ;generic function
"DECORATION-APPLICATION-GRAVITY" ;generic function
"DECORATION-BASE-HEIGHT" ;generic function
"DECORATION-BASE-WIDTH" ;generic function
"DECORATION-CHILDREN" ;generic function
"DECORATION-FRAME-STYLE" ;generic function
"DECORATION-INC-SIZES" ;generic function
"DECORATION-MAX-HEIGHT" ;generic function
"DECORATION-MAXIMIZED" ;generic function
"DECORATION-MAX-WIDTH" ;generic function
"DECORATION-MIN-HEIGHT" ;generic function
"DECORATION-MIN-WIDTH" ;generic function
"DECORATION-PRECEDENT-TIME" ;generic function
"DECORATION-WM-HINTS" ;generic function
"DECORATION-WM-SIZE-HINTS" ;generic function
"DEFAULT-MODIFIERS-P" ;generic function
"DESTROY-SUBSTRUCTURE" ;generic function
"DISARM" ;generic function
"DISPATCH-REPAINT" ;generic function
"DRAW-ON-FOCUS-IN" ;generic function
"DRAW-ON-FOCUS-OUT" ;generic function
"EVENT-PROCESS" ;generic function
"FOCUSED-P" ;generic function
"FOCUS-WIDGET" ;generic function
"FRAME-BUTTON-SIZES" ;generic function
"FRAME-ITEM-EXIST-P" ;generic function
"FRAME-ITEM-HEIGHT" ;generic function
"FRAME-ITEM-PIXMAPS" ;generic function
"FRAME-ITEM-SIZES" ;generic function
"FRAME-ITEM-WIDTH" ;generic function
"FREE-FRAME-STYLE" ;generic function
"GET-CHILD" ;generic function
"GET-PIXMAP" ;generic function
"GET-ROOT-DESKTOP" ;generic function
"ICON-APPLICATION" ;generic function
"ICON-CREATION-TIME" ;generic function
"ICON-DESICONIFY-P" ;generic function
"ICONIFY" ;generic function
"INITIALIZE-MOVE" ;generic function
"KEYSTROKE-KEYSYMS" ;generic function
"MAP-OR-UNMAP-SCREEN" ;generic function
"MENU-3-PROCESS" ;generic function
"MENU-LEAF-CALLBACK" ;generic function
"MENU-ROOT-APPLICATION-WINDOW" ;generic function
"MENU-ROOT" ;generic function
"MOUSE-STROKE-BUTTON" ;generic function
"REPAINT" ;generic function
"REMOVE-DESKTOP-APPLICATION" ;generic function
"REMOVE-FROM-VSCREEN" ;generic function
"REMOVE-WIDGET" ;generic function
"RESIZE-FROM" ;generic function
"RESIZE" ;generic function
"ROOT-DECORATION-THEME" ;generic function
"ROOT-DEFAULT-CURSOR" ;generic function
"ROOT-DESKTOP" ;generic function
"ROOT-MANAGER" ;generic function
"ROOT-MOVE-STATUS" ;generic function
"ROOT-RESIZE-STATUS" ;generic function
"ROOT-VSCREENS" ;generic function
"SET-FOCUS" ;generic function
"STROKE-ACTION" ;generic function
"STROKE-EQUAL" ;generic function
"STROKE-KEYS" ;generic function
"STROKE-MODIFIERS" ;generic function
"STROKE-NAME" ;generic function
"STYLE-BOTTOM-MARGIN" ;generic function
"STYLE-FRAME-ITEM-PIXMAPS" ;generic function
"STYLE-HMARGIN" ;generic function
"STYLE-LEFT-MARGIN" ;generic function
"STYLE-NB-BUTTONS" ;generic function
"STYLE-PARTS-TO-REDRAW-ON-FOCUS" ;generic function
"STYLE-PIXMAP-TABLE" ;generic function
"STYLE-RIGHT-MARGIN" ;generic function
"STYLE-TITLE-BAR-DIRECTION" ;generic function
"STYLE-TITLE-BAR-POSITION" ;generic function
"STYLE-TOP-MARGIN" ;generic function
"STYLE-VMARGIN" ;generic function
"THEME-DEFAULT-STYLE" ;generic function
"THEME-NAME" ;generic function
"THEME-TRANSIENT-STYLE" ;generic function
"TOP-LEFT-H" ;generic function
"TOP-LEFT-W" ;generic function
"TOP-RIGHT-H" ;generic function
"TOP-RIGHT-W" ;generic function
"UNICONIFY" ;generic function
"UNMAP-ICON-WINDOW" ;generic function
"WIDGET-GCONTEXT" ;generic function
"WIDGET-WINDOW" ;generic function
"ACTION" ;macro
"ATOM-NAME->ID" ;macro
"CURRENT-DESK" ;macro
"DEFINE-THEME" ;macro
"DEFTYPEDPARAMETER" ;macro
"ID->ATOM-NAME" ;macro
"WITH-ROOT-CURSOR" ;macro
"+ANY-DESKTOP+" ;constant
"+DECORATION-EVENT-MASK+" ;constant
"+EDGE-EVENT-MASK+" ;constant
"+FOCUSABLE-MASK+" ;constant
"+GNOME-PROTOCOLS+" ;constant
"+NETWM-PROTOCOL+" ;constant
"+POINTER-EVENT-MASK+" ;constant
"+PUSH-BUTTON-MASK+" ;constant
"+STD-BUTTON-MASK+" ;constant
"+UNFOCUSABLE-MASK+" ;constant
"*WHITE*" ;variable
"*BLACK*" ;variable
"*ROOT*" ;variable
"*ROOT-WINDOW*" ;variable
"*STDERR*" ;variable
"*CURSOR-2*" ;variable
"*DISPLAY*" ;variable
"*ECLIPSE-DIRECTORY*" ;variable
;; user custom.
"*CHANGE-DESKTOP-MESSAGE-ACTIVE-P*" ;variable
"*CLOSE-DISPLAY-P*" ;variable
"*FOCUS-NEW-MAPPED-WINDOW*" ;variable
"*FOCUS-TYPE*" ;variable
"*FOCUS-WHEN-WINDOW-CYCLE*" ;variable
"*ICON-BOX-SORT-FUNCTION*" ;variable
"*ICON-HINTS*" ;variable
"*MENU-1-ITEMS*" ;variable
"*MOVE-MODE*" ;variable
"*RESIZE-MODE*" ;variable
"*VERBOSE-MOVE*" ;variable
"*VERBOSE-RESIZE*" ;variable
"*WRAP-POINTER-WHEN-CYCLE*" ;variable
))
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: themer.lisp,v 1.1 2002/11/07 14:54:27 hatchond Exp $
;;; $Id: themer.lisp,v 1.2 2003/05/14 08:56:17 hatchond Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -22,6 +22,12 @@
(defparameter *themes* (make-hash-table :test #'equal))
(declaim (inline lookup-theme))
(defun lookup-theme (name)
"return named theme or nil"
(declare (optimize (speed 3) (safety 1)))
(gethash name *themes*))
(defclass frame-style ()
((title-bar-position
:initform :top
......@@ -221,28 +227,46 @@
(values))
(defun free-theme (name)
"Release all X resources that are associated with the named theme."
(with-slots (default-style transient-style) (gethash name *themes*)
(and default-style (free-frame-style default-style))
(and transient-style (free-frame-style transient-style)))
(remhash name *themes*))
(remhash name *themes*)
(unuse-package name))
(defun load-theme (root-window name)
(fmakunbound 'initialize-frame)
(setf name (ensure-theme-directory-exists name))
(load (concatenate 'string name "theme.o"))
(or (gethash name *themes*) (initialize-frame name root-window)))
"loads and returns theme named by parameter name. Themes are cached."
(unless (gethash name *themes*)
(fmakunbound 'initialize-frame)
(setf name (ensure-theme-directory-exists name))
(load (concatenate 'string name "theme.o"))
(setf name (theme-name (initialize-frame name root-window))))
(use-package (format nil "~:@(~A~)-ECLIPSE-THEME" name))
(gethash name *themes*))
(defun make-keyword (string)
(intern (with-standard-io-syntax (string-upcase string)) :keyword))
(defmacro define-theme ((theme-name) (&rest forms))
(flet
((define-style (style-to-define items &optional style)
`(with-slots (pixmap-table frame-item-pixmaps nb-buttons
top-margin bottom-margin left-margin right-margin
vmargin hmargin top-left-w top-left-h
top-right-w top-right-h bottom-right-w bottom-right-h
bottom-left-w bottom-left-h) ,style-to-define
((define-style (style-to-define items directory window &optional style)
`(with-slots ((pixmap-table eclipse::pixmap-table)
(frame-item-pixmaps eclipse::frame-item-pixmaps)
(nb-buttons eclipse::nb-buttons)
(top-margin eclipse::top-margin)
(bottom-margin eclipse::bottom-margin)
(left-margin eclipse::left-margin)
(right-margin eclipse::right-margin)
(vmargin eclipse::vmargin)
(hmargin eclipse::hmargin)
(top-left-w eclipse::top-left-w)
(top-left-h eclipse::top-left-h)
(top-right-w eclipse::top-right-w)
(top-right-h eclipse::top-right-h)
(bottom-right-w eclipse::bottom-right-w)
(bottom-right-h eclipse::bottom-right-h)
(bottom-left-w eclipse::bottom-left-w)
(bottom-left-h eclipse::bottom-left-h)) ,style-to-define
,@(loop for (key names) in items
for array = (make-array 3 :initial-element nil)
when (eq key :custom)
......@@ -253,28 +277,32 @@
nconc
(loop for name in names
for i from 0
for k = (make-keyword name)
for k = (eclipse::make-keyword name)
for pix = (gensym)
for form =
`(let ((,pix
(or ,(and style `(get-pixmap ,style ,k))
(load-pnm->pixmap dir ,name window))))
(or ,(and style
`(eclipse:get-pixmap ,style ,k))
(eclipse:load-pnm->pixmap
,directory ,name ,window))))
(setf (gethash ,k pixmap-table) ,pix)
(setf (aref ,array ,i) ,pix))
collect form))
(multiple-value-setq (top-left-w top-left-h)
(frame-item-sizes ,style-to-define :top-left))
(eclipse:frame-item-sizes ,style-to-define :top-left))