[mcclim-cvs] CVS mcclim/docs/guided-tour

cfruhwirth cfruhwirth at common-lisp.net
Thu Jan 26 07:09:35 UTC 2006


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 at 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]



More information about the Mcclim-cvs mailing list