Commit 92115b2c authored by Iban Hatchondo's avatar Iban Hatchondo
Browse files

Fix: theme rework to remove eql specializer on theme name in favor of theme object.

parent e5ba59a1
......@@ -58,7 +58,7 @@
:modifiers '(:and :ALT-LEFT :CONTROL-LEFT))
(define-key-combo :scroll-down
:keys '(:q)
:modifiers '(:and :ALT-LEFT :CONTROL-LEFT))
:modifiers '(:and :ISO-LEVEL3-SHIFT :CONTROL-LEFT))
;; example of user define keystroke:
;(define-key-combo :raise-pointered-window
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: input.lisp,v 1.52 2008-08-29 14:57:47 ihatchondo Exp $
;;; $Id: input.lisp,v 1.53 2009-02-20 18:03:55 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -148,13 +148,12 @@
(undecore-application widget :state 0)
(setf (wm-state window) 3)))))
(decoration
(let ((application (get-child widget :application)))
(let ((application (get-child widget :application)))
(if (application-iconic-p application)
(setf (wm-state (widget-window application)) 3)
(with-slots (window send-event-p) event
(progn
(setf send-event-p t)
(setf window (widget-window application))
(format t "about to withdraw: ~a ~%" (wm-name window))
(event-process event root)))))))))
(defmethod event-process ((event destroy-notify) (root root))
......@@ -451,13 +450,13 @@
(defmethod event-process ((event exposure) (button button))
(when (zerop (event-count event))
(let* ((master (slot-value button 'master))
(name (if master
(slot-value (decoration-frame-style master) 'name)
(theme-name (root-decoration-theme *root*)))))
(repaint button name (and master (focused-p master))))))
(theme (if master
(slot-value (decoration-frame-style master) 'theme)
(root-decoration-theme *root*))))
(repaint button theme (and master (focused-p master))))))
(defmethod event-process ((event exposure) (box box-button))
(repaint box (theme-name (root-decoration-theme *root*)) nil))
(repaint box (root-decoration-theme *root*) nil))
(defmethod event-process ((event button-release) (close close-button))
(close-widget (get-child (button-master close) :application)))
......
;;; -*- Mode: Lisp; Package: User -*-
;;; $Id: package.lisp,v 1.18 2004/03/01 14:53:57 ihatchondo Exp $
;;; $Id: package.lisp,v 1.19 2005/01/16 23:25:59 ihatchondo Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -181,7 +181,7 @@
#:pixmap-width ;function
#:procede-decoration ;function
#:query-application-tree ;function
#:%quit% ;function
#:quit ;function
#:realize-menu-items ;function
#:realize-pop-up ;function
#:recompute-wm-normal-hints ;function
......@@ -254,6 +254,7 @@
#:frame-item-pixmaps ;generic function
#:frame-item-sizes ;generic function
#:frame-item-width ;generic function
#:frame-style-theme ;generic function
#:free-frame-style ;generic function
#:get-child ;generic function
#:get-pixmap ;generic function
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: themer.lisp,v 1.11 2005/03/01 10:06:37 ihatchondo Exp $
;;; $Id: themer.lisp,v 1.12 2009-11-17 18:08:43 ihatchondo Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2002 Iban HATCHONDO
......@@ -31,11 +31,11 @@
(gethash name *themes*))
(defclass frame-style ()
((name
:initform "no name"
:type string
:initarg :theme-name
:reader frame-style-theme-name)
((theme
:initform nil
:type (or null theme)
:initarg style-theme
:reader frame-style-theme)
(title-bar-position
:initform :top
:type keyword
......@@ -239,6 +239,9 @@
(defmethod initialize-instance :after ((theme theme) &rest options)
(declare (ignorable options))
(with-slots (default-style transient-style) theme
(when default-style (setf (slot-value default-style 'theme) theme))
(when transient-style (setf (slot-value transient-style 'theme) theme)))
(setf (gethash (theme-name theme) *themes*) theme))
;;;; build-in no decoration theme.
......@@ -247,7 +250,6 @@
(make-instance 'theme :name "no-decoration"
:default-style (make-instance 'default-style
:theme-name "no-decoration"
:title-bar-position :none))
;;;; misc functions.
......@@ -299,11 +301,8 @@
;;;; theme manipulation.
;; I defined this here, just to avoid compilation warnings.
;; But it doesn't matter, because just before loading a theme
;; (fmakunbound 'initialize-frame) is called.
(defun initialize-frame (directory-name window)
(declare (ignorable directory-name window))
(defmethod initialize-frame (theme-class-symbol directory-name window)
(declare (ignorable theme-class-symbol directory-name window))
(values))
(defun free-theme (name)
......@@ -316,11 +315,13 @@
(defun load-theme (root-window name)
"Loads and returns theme named by parameter name. Themes are cached."
(unless (lookup-theme name)
(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))))
(unless (lookup-theme name)
(let* ((tclass (string-upcase name))
(theme-package (concatenate 'string tclass "-ECLIPSE-THEME")))
(setf name (ensure-theme-directory-exists name))
(load (concatenate 'string name "theme.o"))
(let ((tclass (with-standard-io-syntax (intern tclass theme-package))))
(setf name (theme-name (initialize-frame tclass name root-window))))))
(use-package (format nil "~:@(~A~)-ECLIPSE-THEME" name))
(lookup-theme name))
......@@ -407,28 +408,30 @@
((style1 title-pos1 bkgrd1 parts-to-redraw-on-focus1 items1)
(style2 title-pos2 bkgrd2 parts-to-redraw-on-focus2 items2))
(mapcar #'parse-args forms)
`(defun initialize-frame (dir window)
(let ((fs1 ,(and items1
(let ((theme-class (format nil "~:@(~a~)" (symbol-value theme-name))))
`(progn
(defclass ,(intern theme-class) (eclipse::theme) ()
(:documentation ,(format nil "~a theme base class" theme-name)))
(defmethod eclipse-internals::initialize-frame
((name (eql ',(intern theme-class))) dir window)
(let ((fs1 ,(and items1
`(make-instance
',(intern (symbol-name style1) "ECLIPSE-INTERNALS")
:theme-name ,theme-name
:title-bar-position ,title-pos1
:background (make-background ,bkgrd1 window dir)
:parts-to-redraw-on-focus
',parts-to-redraw-on-focus1)))
(fs2 ,(and items2
(fs2 ,(and items2
`(make-instance
',(intern (symbol-name style2) "ECLIPSE-INTERNALS")
:theme-name ,theme-name
:title-bar-position ,title-pos2
:background (make-background ,bkgrd2 window dir)
:parts-to-redraw-on-focus
',parts-to-redraw-on-focus2))))
,(unless items2 `(declare (ignorable fs2)))
,(when items1 (define-style `fs1 items1 `dir `window))
,(when items2 (define-style `fs2 items2 `dir `window `fs1))
(make-instance 'eclipse::theme :name ,theme-name
,@(and style1 `(,style1 fs1))
,@(and style2 `(,style2 fs2))))))))
,(unless items2 `(declare (ignorable fs2)))
,(when items1 (define-style `fs1 items1 `dir `window))
,(when items2 (define-style `fs2 items2 `dir `window `fs1))
(make-instance ',(intern theme-class) :name ,theme-name
,@(and style1 `(,style1 fs1))
,@(and style2 `(,style2 fs2))))))))))
......@@ -48,8 +48,8 @@
(:right ("right"))
(:left ("left"))))))
(defmethod repaint ((widget title-bar) (name (eql +CoolClean+)) (focus t))
(declare (ignorable name focus))
(defmethod repaint ((widget title-bar) (theme CoolClean) (focus t))
(declare (ignorable theme focus))
(with-slots ((window eclipse::window)
(item-to-draw eclipse::item-to-draw)
(gcontext eclipse::gcontext)
......@@ -61,8 +61,8 @@
(xlib:draw-rectangle window gcontext 0 0 width height t)))))
(draw-centered-text window gcontext item-to-draw :color *white* :x 5)))
(defmethod repaint ((widget title-bar) (name (eql +CoolClean+)) (focus null))
(declare (ignorable name focus))
(defmethod repaint ((widget title-bar) (theme CoolClean) (focus null))
(declare (ignorable theme focus))
(with-slots ((window eclipse::window)
(item-to-draw eclipse::item-to-draw)
(gcontext eclipse::gcontext)) widget
......
......@@ -41,8 +41,8 @@
(:right ("side"))
(:left ("side"))))))
(defmethod repaint ((widget title-bar) (name (eql +Step+)) (focus t))
(declare (ignorable name focus))
(defmethod repaint ((widget title-bar) (theme Step) (focus t))
(declare (ignorable theme focus))
(with-slots ((window eclipse::window)
(item-to-draw eclipse::item-to-draw)
(gcontext eclipse::gcontext)
......@@ -54,8 +54,8 @@
(xlib:draw-rectangle window gcontext 0 0 width height t)))))
(draw-centered-text window gcontext item-to-draw :color *white*)))
(defmethod repaint ((widget title-bar) (name (eql +Step+)) (focus null))
(declare (ignorable name focus))
(defmethod repaint ((widget title-bar) (theme Step) (focus null))
(declare (ignorable theme focus))
(with-slots ((window eclipse::window)
(item-to-draw eclipse::item-to-draw)
(gcontext eclipse::gcontext)) widget
......
......@@ -91,16 +91,16 @@
(multiple-value-bind (width height) (drawable-sizes window)
(xlib:draw-rectangle window gcontext 0 0 width height t)))))
(defmethod repaint ((widget title-bar) (name (eql +brushed-metal+)) (focus t))
(declare (ignorable name focus))
(defmethod repaint ((widget title-bar) (theme brushed-metal) (focus t))
(declare (ignorable theme focus))
(with-slots (frame-style) (button-master widget)
(typecase frame-style
(default-style (default-draw-on-focus-in widget frame-style))
(transient-style (transient-draw-on-focus-in widget frame-style)))))
(defmethod repaint ((wget title-bar) (name (eql +brushed-metal+)) (focus null))
(declare (ignorable name focus))
(with-slots (frame-style) (button-master wget)
(defmethod repaint ((widget title-bar) (theme brushed-metal) (focus null))
(declare (ignorable theme focus))
(with-slots (frame-style) (button-master widget)
(typecase frame-style
(default-style (default-draw-on-focus-out wget frame-style))
(transient-style (xlib:clear-area (widget-window wget))))))
(default-style (default-draw-on-focus-out widget frame-style))
(transient-style (xlib:clear-area (widget-window widget))))))
......@@ -73,16 +73,16 @@
(xlib:draw-rectangle window gcontext w 0 pix-w h t))
(draw-centered-text window gcontext item-to-draw :color *white* :x 5))))
(defmethod repaint ((widget title-bar) (name (eql +microGUI+)) (focus t))
(declare (ignorable name focus))
(defmethod repaint ((widget title-bar) (theme microGUI) (focus t))
(declare (ignorable theme focus))
(with-slots ((frame-style eclipse::frame-style)) (button-master widget)
(when (default-style-p frame-style)
(redraw-title-bar widget
(get-pixmap frame-style :top-blue)
(get-pixmap frame-style :top-curves)))))
(defmethod repaint ((widget title-bar) (name (eql +microGUI+)) (focus null))
(declare (ignorable name focus))
(defmethod repaint ((widget title-bar) (theme microGUI) (focus null))
(declare (ignorable theme focus))
(with-slots ((frame-style eclipse::frame-style)) (button-master widget)
(when (default-style-p frame-style)
(redraw-title-bar widget
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: widgets.lisp,v 1.57 2009-02-20 18:07:01 ihatchondo Exp $
;;; $Id: widgets.lisp,v 1.58 2009-11-17 17:33:21 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -73,12 +73,12 @@
maximization the widget will be enlarged to cover the whole screen except
any existing panels (e.g applications with the :_net_wm_window_type_dock
atom present in there _net_wm_window_type property.
widget (base-widget): the widget to (un)maximize.
code (integer 1 3):
1 operates on width and height.
2 operates on height.
3 operates on width.
:fill-p (boolean): If NIL, cover the whole screen (except dock type
- widget (base-widget): the widget to (un)maximize.
- code (integer 1 3):
-- 1 operates on width and height.
-- 2 operates on height.
-- 3 operates on width.
- :fill-p (boolean): If NIL, cover the whole screen (except dock type
applications). If T, finds the first region of the screen that does
not overlap applications not already overlapped by the widget."))
......@@ -96,14 +96,14 @@
(:documentation "Returns T if one of the state :win_state_fixed_position
:_net_wm_state_sticky is set for the widget."))
(defgeneric repaint (widget theme-name focus)
(:method (widget theme-name focus) nil)
(defgeneric repaint (widget theme focus)
(:method (widget theme focus) nil)
(:documentation
"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.
It is specialized on widget type, frame-style theme 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
......@@ -567,16 +567,16 @@
(defconstant +std-button-mask+
'(:button-press :button-release :button-motion :owner-grab-button :exposure))
(defmethod repaint ((widget button) theme-name (focus t))
(declare (ignorable theme-name focus))
(defmethod repaint ((widget button) theme (focus t))
(declare (ignorable theme focus))
(with-slots (item-to-draw window gcontext) widget
(xlib:clear-area window)
(typecase item-to-draw
(string (draw-centered-text window gcontext item-to-draw))
(xlib:pixmap (draw-pixmap window gcontext item-to-draw)))))
(defmethod repaint ((widget button) theme-name (focus null))
(declare (ignorable theme-name focus))
(defmethod repaint ((widget button) theme (focus null))
(declare (ignorable theme focus))
(xlib:clear-area (widget-window widget)))
(defmethod shaded-p ((widget button))
......@@ -654,8 +654,8 @@
(window-position window) (values x y)
(slot-value box 'item-to-draw) m))))))
(defmethod repaint ((widget box-button) theme-name focus &aux x)
(declare (ignorable theme-name focus))
(defmethod repaint ((widget box-button) theme focus &aux x)
(declare (ignorable theme focus))
(with-slots (window item-to-draw gcontext pixmap) widget
(xlib:clear-area window)
(when pixmap
......@@ -713,19 +713,19 @@
(declare (ignorable value))
(with-slots (window master) button
(when (decoration-p master)
(with-slots (name) (decoration-frame-style master)
(repaint button name (focused-p master))))))
(with-slots (theme) (decoration-frame-style master)
(repaint button theme (focused-p master))))))
(defmethod repaint ((widget push-button) theme-name (focus t))
(declare (ignorable theme-name focus))
(defmethod repaint ((widget push-button) theme (focus t))
(declare (ignorable theme focus))
(with-slots (window gcontext armed active-p item-to-draw) widget
(xlib:clear-area window)
(let ((p (and armed active-p (push-button-pixmap widget :focused-click))))
(when (or p item-to-draw)
(draw-pixmap window gcontext (or p item-to-draw))))))
(defmethod repaint ((widget push-button) theme-name (focus null))
(declare (ignorable theme-name focus))
(defmethod repaint ((widget push-button) theme (focus null))
(declare (ignorable theme focus))
(with-slots (window gcontext armed active-p) widget
(xlib:clear-area window)
(let ((pixmap (push-button-pixmap widget :unfocused-click)))
......@@ -752,8 +752,8 @@
(hmargin :initform 0)
(parent :initform nil)))
(defmethod repaint ((widget title-bar) theme-name focus)
(declare (ignorable theme-name focus))
(defmethod repaint ((widget title-bar) theme focus)
(declare (ignorable theme focus))
(with-slots (item-to-draw window gcontext) widget
(xlib:clear-area window)
(when item-to-draw
......@@ -931,8 +931,8 @@
(and pixmap-to-free (xlib:free-pixmap pixmap-to-free))
(setf pixmap-to-free nil)))
(defmethod repaint ((widget icon) theme-name focus)
(declare (ignorable theme-name focus))
(defmethod repaint ((widget icon) theme focus)
(declare (ignorable theme focus))
(with-slots (window item-to-draw gcontext) widget
(xlib:clear-area window)
(draw-centered-text window gcontext item-to-draw :color *white*)))
......
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
;;; $Id: wm.lisp,v 1.57 2008-08-29 14:57:47 ihatchondo Exp $
;;; $Id: wm.lisp,v 1.58 2009-11-17 17:31:25 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
......@@ -159,9 +159,9 @@
(defmethod dispatch-repaint ((master decoration)
&key (focus (focused-p master)))
(declare (optimize (speed 3) (safety 1)))
(with-slots (parts-to-redraw-on-focus name) (decoration-frame-style master)
(declare (type string name))
(mapc #'(lambda (k) (repaint (get-child master k) name focus))
(with-slots (parts-to-redraw-on-focus theme) (decoration-frame-style master)
(declare (type theme theme))
(mapc #'(lambda (k) (repaint (get-child master k) theme focus))
parts-to-redraw-on-focus)))
(defun recompute-wm-normal-hints (window hmargin vmargin)
......@@ -720,7 +720,7 @@
((window-not-decorable-p window (application-type application))
(setf (netwm:net-frame-extents window) (values 0 0 0 0))
(setf (wm-state window) 1)
(xlib:map-window window))
(xlib:map-window window))
(t (decore-application window application :map t)))
(with-slots (wants-focus-p input-model type) application
(unless (member :_net_wm_window_type_desktop type)
......@@ -737,7 +737,7 @@
:type boolean :reader close-application-p)))
(defun eclipse-internal-loop ()
(let* ((exit 0) time)
(let* ((exit 0))
;; Sets the root window pop-up menu
(when *menu-1-exit-p*
......@@ -765,10 +765,9 @@
(xlib:with-server-grabbed (*display*)
(mapc (lambda (w)
(unless (ignore-errors (ignorable-window-p w))
(unless (ignore-errors (ignorable-window-p w))
(procede-decoration w)))
(xlib:query-tree *root-window*))))
;; Main loop
(loop
(catch 'general-error
......@@ -786,7 +785,7 @@
when (application-p val)
if *close-display-p* do (close-widget val)
else do (undecore-application val))
(setf time 10 exit 2))
(setf exit 2))
(2 (when (root-sm-conn *root*)
(close-sm-connection *root* :exit-p nil))
(xlib:display-finish-output *display*)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment