Update of /project/mcclim/cvsroot/mcclim/docs/guided-tour In directory common-lisp:/tmp/cvs-serv24673/docs/guided-tour

Added Files: Makefile color-editor.lisp draw-frame.lisp file-browser-all file-browser.lisp guided-tour.bib guided-tour.tex hello-world.lisp scheduler.lisp simple-draw.lisp simple-spreadsheet.lisp techno-dep.fig Log Message: Initial checkin of my "A Guided Tour to CLIM" rework 2006. I put the tree under docs/ because I felt that this was more standard. I would like to suggest that we move Doc/ to docs/manual.

--- /project/mcclim/cvsroot/mcclim/docs/guided-tour/Makefile 2006/01/26 07:09:34 NONE +++ /project/mcclim/cvsroot/mcclim/docs/guided-tour/Makefile 2006/01/26 07:09:34 1.1 #!/usr/bin/make

guided-tour.dvi: guided-tour.tex hello-world.cut draw-frame.cut scheduler.cut file-browser.cut techno-dep.pstex_t techno-dep.pstex latex guided-tour.tex bibtex guided-tour latex guided-tour.tex latex guided-tour.tex

%.pstex: %.fig fig2dev -L pstex $(value $@) -b 0 $< $@

%.pstex_t: %.pstex %.fig fig2dev -L pstex_t $(value $@) -E 1 -p $^ $@

%.cut: %.lisp awk '/LTAG-end/ { found=found " " active; active="" } \ { if (active!="") print $$active > active} \ /LTAG-start/ { split($$2,foo,":"); active=foo[2] } \ END { print found }' $<

.PHONY: clean

clean: rm guided-tour.aux guided-tour.bbl guided-tour.log guided-tour.dvi guided-tour.blg hello-world-def-app hello-world-defclass hello-world-handle-repaint scheduler-part1 scheduler-part2 techno-dep.pstex techno-dep.pstex_t file-browser-all draw-frame-interfacing draw-frame-def-app draw-frame-commands --- /project/mcclim/cvsroot/mcclim/docs/guided-tour/color-editor.lisp 2006/01/26 07:09:35 NONE +++ /project/mcclim/cvsroot/mcclim/docs/guided-tour/color-editor.lisp 2006/01/26 07:09:35 1.1 (eval-when (:compile-toplevel :load-toplevel :execute) (asdf:oos 'asdf:load-op :clim) (asdf:oos 'asdf:load-op :clim-clx))

(in-package :clim-user)

(defun make-color-slider (id initval label) (labelling (:label label) (make-pane ':slider :id id :orientation :horizontal :value initval :max-value 1 :min-value 0 :drag-callback #'color-slider-dragged :value-changed-callback #'color-slider-value-changed)))

(define-application-frame color-editor () (current-color-pane drag-feedback-pane (red :initform 0.0) (green :initform 1.0) (blue :initform 0.0)) (:pane (with-slots (drag-feedback-pane current-color-pane red green blue) *application-frame* (vertically () (setf current-color-pane (make-pane 'application-pane :min-height 100 :max-height 100 :background (make-rgb-color red green blue))) (horizontally (:min-height 200 :max-height 200) (1/2 (make-color-slider 'red red "Red")) (1/4 (make-color-slider 'green green "Green")) (1/4 (make-color-slider 'blue blue "Blue"))) +fill+ (setf drag-feedback-pane (make-pane 'application-pane :min-height 100 :max-height 100 :background (make-rgb-color red green blue)))))) (:menu-bar t))

(defun color-slider-dragged (slider value) (with-slots (drag-feedback-pane red green blue) *application-frame* (setf (medium-background drag-feedback-pane) (ecase (gadget-id slider) (red (make-rgb-color value green blue)) (green (make-rgb-color red value blue)) (blue (make-rgb-color red green value)))) (redisplay-frame-pane *application-frame* drag-feedback-pane)))

(defun color-slider-value-changed (slider new-value) (with-slots (current-color-pane red green blue) *application-frame* ;; The gadget-id symbols match the slot names in color-editor (setf (slot-value *application-frame* (gadget-id slider)) new-value) (setf (medium-background current-color-pane) (make-rgb-color red green blue)) (redisplay-frame-pane *application-frame* current-color-pane)))

(define-color-editor-command (com-quit :name "Quit" :menu t) () (frame-exit *application-frame*)) --- /project/mcclim/cvsroot/mcclim/docs/guided-tour/draw-frame.lisp 2006/01/26 07:09:35 NONE +++ /project/mcclim/cvsroot/mcclim/docs/guided-tour/draw-frame.lisp 2006/01/26 07:09:35 1.1 (eval-when (:compile-toplevel) (asdf:oos 'asdf:load-op :clim) (asdf:oos 'asdf:load-op :clim-clx)) (in-package :clim-user)

; LTAG-start:draw-frame-def-app (define-application-frame draw-frame () ((lines :accessor lines :initform nil) ;; lines of drawing (strings :accessor strings :initform nil)) ;; texts of drawing (:panes (draw-pane (make-pane 'draw-pane)) (interactor :interactor)) (:layouts (default-default (vertically () draw-pane interactor)) (:menu-bar t) (:command-definer t) (:top-level (default-frame-top-level)))

(defclass draw-pane (standard-extended-input-stream ; must have precedence over basic-pane basic-pane permanent-medium-sheet-output-mixin) ())

(defmethod handle-repaint ((pane draw-pane) region) (with-application-frame (frame) (call-next-method) ; Paints the background (dolist (line (lines frame)) (draw-line pane (car line) (cdr line))) (dolist (pair (strings frame)) (draw-text pane (cdr pair) (car pair))))) ; LTAG-end (defmethod frame-standard-output ((frame draw-frame)) (get-frame-pane frame 'interactor))

; LTAG-start:draw-frame-commands (define-draw-frame-command (com-draw-add-string :menu t :name t) ((string 'string) (x 'integer) (y 'integer)) (push (cons (make-point x y) string) (strings *application-frame*)) (update-draw-pane))

(define-draw-frame-command (com-draw-add-line :menu t :name t) ((x1 'integer) (y1 'integer) (x2 'integer) (y2 'integer)) (with-slots (lines) *application-frame* (push (cons (make-point x1 y1) (make-point x2 y2)) lines)) (update-draw-pane))

(define-draw-frame-command (com-draw-clear :menu t :name t) () (with-slots (lines strings) *application-frame* (setf lines nil strings nil)) (update-draw-pane))

;; Auxilary Method (defun update-draw-pane () (repaint-sheet (find-pane-named *application-frame* 'draw-pane) +everywhere+)) ; LTAG-end

; LTAG-start:draw-frame-interfacing (defmethod handle-event ((pane draw-pane) (event pointer-button-press-event)) ;; Start line tracking when left pointer button is pressed (when (eql (pointer-event-button event) +pointer-left-button+) (track-line-drawing pane (pointer-event-x event) (pointer-event-y event))))

(defmethod handle-event ((pane draw-pane) (event key-press-event)) (when (keyboard-event-character event) (multiple-value-bind (x y) (stream-pointer-position pane) ;; Start with empty string, as a key release event will be received anyway (track-text-drawing pane "" x y))) (update-draw-pane))

(defun track-line-drawing (pane startx starty) (let ((lastx startx) (lasty starty)) (with-drawing-options (pane :ink +flipping-ink+) (draw-line* pane startx starty lastx lasty) (tracking-pointer (pane) (:pointer-motion (&key window x y) (draw-line* pane startx starty lastx lasty) ; delete old (draw-line* pane startx starty x y) ; draw new (setq lastx x lasty y)) (:pointer-button-release (&key event x y) (when (eql (pointer-event-button event) +pointer-left-button+) (draw-line* pane startx starty lastx lasty) (execute-frame-command *application-frame* `(com-draw-add-line ,startx ,starty ,x ,y)) (return-from track-line-drawing nil)))))))

(defun track-text-drawing (pane current-string current-x current-y) (tracking-pointer (pane) (:pointer-motion (&key window x y) ;; We can't use flipping ink for text, hence redraw. (handle-repaint pane +everywhere+) (setq current-x x current-y y) (draw-text* pane current-string x y)) (:keyboard (&key gesture) (when (and (typep gesture 'key-release-event) (keyboard-event-character gesture)) (setf current-string (concatenate 'string current-string (string (keyboard-event-character gesture)))) (handle-repaint pane +everywhere+) (draw-text* pane current-string current-x current-y))) (:pointer-button-release (&key event x y) (when (eql (pointer-event-button event) +pointer-left-button+) (execute-frame-command *application-frame* `(com-draw-add-string ,current-string ,x ,y)) (return-from track-text-drawing nil))))) ; LTAG-end:draw-frame-part2 --- /project/mcclim/cvsroot/mcclim/docs/guided-tour/file-browser-all 2006/01/26 07:09:35 NONE +++ /project/mcclim/cvsroot/mcclim/docs/guided-tour/file-browser-all 2006/01/26 07:09:35 1.1 (define-application-frame file-browser () ((active-files :initform nil :accessor active-files)) (:panes (file-browser :application :display-function '(dirlist-display-files) ;; Call the display-function whenever the command ;; loop makes a ``full-cycle'' :display-time :command-loop) (interactor :interactor)) (:layouts (default (vertically () file-browser interactor))))

(defmethod dirlist-display-files ((frame file-browser) pane) ;; Clear old displayed entries (clear-output-record (stream-output-history pane))

(dolist (file (active-files frame)) ;; Instead of write-string, we use present so that the link to ;; object file and the semantic information that file is ;; pathname is retained. (present file 'pathname :stream pane) (terpri pane)))

(define-file-browser-command (com-edit-directory :name "Edit Directory") ((dir 'pathname)) (let ((dir (make-pathname :directory (pathname-directory dir) :name :wild :type :wild :version :wild :defaults dir))) (setf (active-files *application-frame*) (directory dir))))

(define-presentation-to-command-translator pathname-to-edit-command (pathname ; source presentation-type com-edit-directory ; target-command file-browser ; command-table :gesture :select ; use this translator for pointer clicks :documentation "Edit this path") ; used in context menu (object) ; argument List (list object)) ; arguments for target-command

(defmethod adopt-frame :after (frame-manager (frame file-browser)) (execute-frame-command frame `(com-edit-directory ,(make-pathname :directory '(:absolute))))) --- /project/mcclim/cvsroot/mcclim/docs/guided-tour/file-browser.lisp 2006/01/26 07:09:35 NONE +++ /project/mcclim/cvsroot/mcclim/docs/guided-tour/file-browser.lisp 2006/01/26 07:09:35 1.1 (eval-when (:compile-toplevel) (asdf:oos 'asdf:load-op :clim) (asdf:oos 'asdf:load-op :clim-clx))

(in-package :clim-user)

; LTAG-start:file-browser-all (define-application-frame file-browser () ((active-files :initform nil :accessor active-files)) (:panes (file-browser :application :display-function '(dirlist-display-files) ;; Call the display-function whenever the command ;; loop makes a ``full-cycle'' :display-time :command-loop) (interactor :interactor)) (:layouts (default (vertically () file-browser interactor))))

(defmethod dirlist-display-files ((frame file-browser) pane) ;; Clear old displayed entries (clear-output-record (stream-output-history pane))

(dolist (file (active-files frame)) ;; Instead of write-string, we use present so that the link to ;; object file and the semantic information that file is ;; pathname is retained. (present file 'pathname :stream pane) (terpri pane)))

(define-file-browser-command (com-edit-directory :name "Edit Directory") ((dir 'pathname)) (let ((dir (make-pathname :directory (pathname-directory dir) :name :wild :type :wild :version :wild :defaults dir))) (setf (active-files *application-frame*) (directory dir))))

(define-presentation-to-command-translator pathname-to-edit-command (pathname ; source presentation-type com-edit-directory ; target-command file-browser ; command-table :gesture :select ; use this translator for pointer clicks :documentation "Edit this path") ; used in context menu (object) ; argument List (list object)) ; arguments for target-command

(defmethod adopt-frame :after (frame-manager (frame file-browser)) (execute-frame-command frame `(com-edit-directory ,(make-pathname :directory '(:absolute))))) ; LTAG-end--- /project/mcclim/cvsroot/mcclim/docs/guided-tour/guided-tour.bib 2006/01/26 07:09:35 NONE +++ /project/mcclim/cvsroot/mcclim/docs/guided-tour/guided-tour.bib 2006/01/26 07:09:35 1.1 @misc { inside-macintosh, author="Apple Computer", title = "Inside Macintosh", volume = 3, year = "1985", publisher = "Addison-Wesley, Reading, MA" }

@misc { common-windows-manual, author = "Intellicorp, Mountain View, CA", title = "Common Windows Manual", year = "1986" }

@misc { composing-uis, author = "M. Linton, J. Vlissides, P. Calder", title = "Composing user interfaces with interviews", publisher = "IEEE Computer, 22(2):8-22, Feb 1989" }

@misc { presentation-manager, author = "Scott McKay, William York, Michael McMahon", title = "A presentation manager based on application semantics", published = "In Proceedings of the ACM SIG-GRAPH Symposium on User Interface Software and Technology, pages 141-148. ACM Press, Nov 1989" }

@misc { ms-sdk, author = "Microsoft Corporation, Redmond, WA", title = "Microsoft Windows Software Development Kit", year = 1985}

@comment { 5^^^ 6/ } @misc { next-sysman, author = "Next Inc. Redwood City, CA.", title = "Next Preliminary 1.0 System Reference Manual: Concepts", year = 1989 } @misc { motif-guide, author = "Open Software Foundation, Cambridge, MA", title = "OSF/MOTIF Style Guide", year = "1989" }

@misc { clos-window-system, author = "Rob Pettengill", title = "The deli window system, A portable, clos based network window system interface", published = "In Proceedings of the First CLOS Users and Implementors Workshop, pages 121— 124, Oct 1988" }

@misc { x-toolkit, author = "Ramana Rao and Smokey Wallace", title = "The x toolkit", published = "In Proceedings of the Summer 1987 USENIX Con­ference. USENIX, 1986" }

@misc { silica-paper, author = "Ramana Rao", title = "Silica papers", published = "In Preparation", year = 1991 }

@comment { 10^^^ 11/ }

@misc { clim-spec, author = "Scott McKay, Wiliam York", year = 2005, title = "Common lisp interface manager specification", published = "In Preparation" }

@misc { x-window-system, author = "R.W. Scheifler, J. Gettys", title = "The x window system. ACM Transactions on Graphics, 5(2)", year = 1986 }

@misc { sun-view-prog-guide, author = "Sun Microsystems, Mountain View, CA", title = "Sun-View Programmer's Guide", year = "1986" } @misc { news-tech-over, author = "Sun Microsystems", title = "NeWS Technical Overview", year = "1987" }

@misc { open-look-gui, author = "Sun Microsystems, Mountain View, CA", title = "OPEN LOOK Graphical User Interface", year = "1989" } @comment { 15^^^ 16/ }

@misc { prog-ref-manual, author = "Symbolics, Inc", title = "Programmer's Reference Manual Vol 7: Programming the User Interface." }

@book { oop-in-cl, title = "Object-Oriented Programmin in Common Lisp", author = "Sonja E. Kenne", year = "1988", isbn = "0-201-17589-4" }

@misc { mcclim, author = "McCLIM", title = "A free CLIM implementation", url = "http://common-lisp.net/project/mcclim/" } --- /project/mcclim/cvsroot/mcclim/docs/guided-tour/guided-tour.tex 2006/01/26 07:09:35 NONE +++ /project/mcclim/cvsroot/mcclim/docs/guided-tour/guided-tour.tex 2006/01/26 07:09:35 1.1 \documentclass[twocolumn,a4paper]{article} \usepackage[dvips]{graphicx} \usepackage{color} % Need the color package \usepackage{listings} %\usepackage{epsfig} \title{\Huge A Guided Tour of CLIM, \ Common Lisp Interface Manager} \author{ 2006 Update \ Clemens Fruhwirth \texttt{clemens@endorphin.org} \ The McCLIM Project \bigskip \

[603 lines skipped] --- /project/mcclim/cvsroot/mcclim/docs/guided-tour/hello-world.lisp 2006/01/26 07:09:35 NONE +++ /project/mcclim/cvsroot/mcclim/docs/guided-tour/hello-world.lisp 2006/01/26 07:09:35 1.1

[637 lines skipped] --- /project/mcclim/cvsroot/mcclim/docs/guided-tour/scheduler.lisp 2006/01/26 07:09:35 NONE +++ /project/mcclim/cvsroot/mcclim/docs/guided-tour/scheduler.lisp 2006/01/26 07:09:35 1.1

[743 lines skipped] --- /project/mcclim/cvsroot/mcclim/docs/guided-tour/simple-draw.lisp 2006/01/26 07:09:35 NONE +++ /project/mcclim/cvsroot/mcclim/docs/guided-tour/simple-draw.lisp 2006/01/26 07:09:35 1.1

[765 lines skipped] --- /project/mcclim/cvsroot/mcclim/docs/guided-tour/simple-spreadsheet.lisp 2006/01/26 07:09:35 NONE +++ /project/mcclim/cvsroot/mcclim/docs/guided-tour/simple-spreadsheet.lisp 2006/01/26 07:09:35 1.1

[899 lines skipped] --- /project/mcclim/cvsroot/mcclim/docs/guided-tour/techno-dep.fig 2006/01/26 07:09:35 NONE +++ /project/mcclim/cvsroot/mcclim/docs/guided-tour/techno-dep.fig 2006/01/26 07:09:35 1.1

[932 lines skipped]