[mcclim-cvs] CVS mcclim/Examples
dlichteblau
dlichteblau at common-lisp.net
Sun Feb 4 12:55:44 UTC 2007
Update of /project/mcclim/cvsroot/mcclim/Examples
In directory clnet:/tmp/cvs-serv1773/Examples
Modified Files:
demodemo.lisp
Added Files:
tabdemo.lisp
Log Message:
Added the tab layout.
* Extensions/tab-layout.lisp: New file.
* Examples/tabdemo.lisp: New file.
* mcclim.asd (CLIM): Added Extensions/tab-layout.lisp.
(CLIM-EXAMPLES): Add tabdemo.lisp
* package.lisp (CLIM-TAB-LAYOUT): New package.
* Examples/demodemo.lisp: Added a button for the tabdemo.
* Doc/make-docstrings.lisp: Process the clim-tab-layout package.
* Doc/mcclim.texi: New chapter about the tab-layout.
* Backends/CLX/frame-manager.lisp (GENERATE-STANDARD-PANE-SPECS,
FIND-CONCRETE-PANE-CLASS): Obey define-abstract-pane-mapping even
for names not the internal packages.
* Backends/gtkairo/event.lisp (TAB-BUTTON-HANDLER): New.
* Backends/gtkairo/frame-manager.lisp ((MAKE-PANE-2
TAB-LAYOUT-PANE)): New. (RESOLVE-ABSTRACT-PANE-NAME): Renamed.
* Backends/gtkairo/gadgets.lisp (TAB-BUTTON-EVENT,
TAB-PRESS-EVENT, TAB-RELEASE-EVENT, GTK-TAB-LAYOUT): New classes.
(REALIZE-NATIVE-WIDGET, CONTAINER-PUT, (SETF
CLIM-TAB-LAYOUT:TAB-LAYOUT-PAGES), REORDER-NOTEBOOK-PAGES,
CONTAINER-MOVE, ALLOCATE-SPACE, (SETF
CLIM-TAB-LAYOUT:TAB-LAYOUT-ENABLED-PAGE), CONNECT-NATIVE-SIGNALS,
CLIM-TAB-LAYOUT:NOTE-TAB-PAGE-CHANGED, SET-TAB-PAGE-ATTRIBUTES,
HANDLE-EVENT): New functions and methods on gtk-tab-layout.
(PARENT-AD-HOC-PRESENTATION): New class.
* Backends/gtkairo/port.lisp (GTK-WIDGET-MODIFY-FG): New function.
* Backends/gtkairo/ffi.lisp: Regenerated.
--- /project/mcclim/cvsroot/mcclim/Examples/demodemo.lisp 2006/12/27 14:47:24 1.17
+++ /project/mcclim/cvsroot/mcclim/Examples/demodemo.lisp 2007/02/04 12:55:44 1.18
@@ -74,7 +74,8 @@
(lambda (&rest ignore)
(declare (ignore ignore))
(format *trace-output* "~&You chose: ~A~%"
- (select-font))))))
+ (select-font))))
+ (make-demo-button "Tab Layout" 'tabdemo:tabdemo)))
(labelling (:label "Tests")
(vertically (:equalize-width t)
(make-demo-button "Label Test" 'label-test)
--- /project/mcclim/cvsroot/mcclim/Examples/tabdemo.lisp 2007/02/04 12:55:44 NONE
+++ /project/mcclim/cvsroot/mcclim/Examples/tabdemo.lisp 2007/02/04 12:55:44 1.1
(in-package :cl-user)
(defpackage :tabdemo
(:use :clim :clim-lisp :clim-tab-layout)
(:export :tabdemo))
(in-package :tabdemo)
;;; example and testing code
(define-presentation-type special-page ())
(define-application-frame tabdemo ()
()
(:menu-bar tabdemo-menubar)
(:panes
(a :text-editor :value "Hello World from page A")
(b :text-editor :value "Hello World from page B")
(c :text-editor :value "This is page C speaking")
(special-page :text-editor
:value "This page has a special presentation type")
(io :interactor :height 150 :width 600)
(pointer-doc :pointer-documentation))
(:layouts
(default
(vertically ()
(with-tab-layout ('tab-page :name 'tabdemo-layout :height 200)
("A" a)
("B" b)
("C" c)
("Special Page" special-page :presentation-type 'special-page))
io
pointer-doc))))
(define-tabdemo-command (com-remove-tabdemo-page :name t)
((page 'tab-page :prompt "Tab page" :gesture :delete))
(remove-page page))
(make-command-table 'tabdemo-pages-menu
:errorp nil
:menu '(("Add Extra Pane" :command com-add-extra-pane)
("Randomize" :command com-randomize-tabdemo)
("Quit" :command com-quit-tabdemo)))
(make-command-table 'tabdemo-properties-menu
:errorp nil
:menu '(("Change Page Title"
:command com-change-page-title)
("Paint Page Red"
:command com-paint-page-red)
("Paint Page Green"
:command com-paint-page-green)))
(make-command-table 'tabdemo-presentation-tests-menu
:errorp nil
:menu '(("Choose Any Page"
:command com-choose-any-page)
("Choose Special Page"
:command com-choose-special-page)))
(make-command-table 'tabdemo-menubar
:errorp nil
:menu '(("Pages" :menu tabdemo-pages-menu)
("Properties" :menu tabdemo-properties-menu)
("Presentation Tests"
:menu tabdemo-presentation-tests-menu)))
(defun tabdemo ()
(run-frame-top-level (make-application-frame 'tabdemo)))
;;;(define-presentation-to-command-translator remove-pane
;;; (tab-page com-remove-tab-page tabdemo
;;; :gesture :describe
;;; :documentation "remove this pane"
;;; :pointer-documentation "remove this pane")
;;; (object)
;;; (list object))
;; FIXME: It only get errors due to bogus frame names with FIND-PANE-NAMED.
;; Ignoring the symbol identity and case works around that.
(defun sane-find-pane-named (frame name)
(find name
(climi::frame-named-panes frame)
:key #'pane-name
:test #'string-equal))
(defun tabdemo-layout ()
(sane-find-pane-named *application-frame* 'tabdemo-layout))
(define-tabdemo-command (com-add-extra-pane :name t)
()
(let ((fm (frame-manager *application-frame*)))
(with-look-and-feel-realization (fm *application-frame*)
(add-page (make-instance 'tab-page
:title "X"
:pane (make-pane 'text-editor-pane
:value "This is an extra page"))
(tabdemo-layout)
t))))
(define-tabdemo-command (com-choose-any-page :name t)
()
(format *standard-input* "You choice: ~A~%" (accept 'tab-page)))
(define-tabdemo-command (com-choose-special-page :name t)
()
(accept 'special-page)
(write-line "Correct answer! That's the special page." *standard-input*))
(define-tabdemo-command (com-quit-tabdemo :name t)
()
(frame-exit *application-frame*))
(define-tabdemo-command (com-randomize-tabdemo :name t)
()
(setf (tab-layout-pages (tabdemo-layout))
(let ((old (tab-layout-pages (tabdemo-layout)))
(new '()))
(loop
while old
for i = (random (length old))
do
(push (elt old i) new)
(setf old (remove-if (constantly t) old :start i :count 1)))
new)))
(define-tabdemo-command (com-change-page-title :name t)
()
(let ((page (tab-layout-enabled-page (tabdemo-layout))))
(when page
(setf (tab-page-title page)
(accept 'string
:prompt "New title"
:default (tab-page-title page))))))
(define-tabdemo-command (com-paint-page-red :name t)
()
(let ((page (tab-layout-enabled-page (tabdemo-layout))))
(when page
(setf (getf (tab-page-drawing-options page) :ink) +red+))))
(define-tabdemo-command (com-paint-page-green :name t)
()
(let ((page (tab-layout-enabled-page (tabdemo-layout))))
(when page
(setf (getf (tab-page-drawing-options page) :ink) +green+))))
#+(or)
(tabdemo:tabdemo)
More information about the Mcclim-cvs
mailing list