August 2005 - mcclim-cvs@common-lisp.net - mailman3.common-lisp.net

[mcclim-cvs] CVS update: mcclim/Lisp-Dep/fix-sbcl.lisp
by crhodes＠common-lisp.net 19 Aug '05

19 Aug '05

Update of /project/mcclim/cvsroot/mcclim/Lisp-Dep In directory common-lisp.net:/tmp/cvs-serv32041/Lisp-Dep Modified Files: fix-sbcl.lisp Log Message: SBCL / OpenMCL(?) build fixes Fix the perennially annoying duplicate component error in the Scigraph defsystem (name the components by the full namestring, which should be unique) While I'm at it, fix the annoyance over static / dynamic packages: for sbcl, clim-lisp-patch and clim-mop are dynamic packages, so they shouldn't be created by DEFPACKAGE (because reevaluating the defpackage subsequently, say by recompiling stuff, then invokes undefined behaviour) Date: Fri Aug 19 23:34:43 2005 Author: crhodes Index: mcclim/Lisp-Dep/fix-sbcl.lisp diff -u mcclim/Lisp-Dep/fix-sbcl.lisp:1.8 mcclim/Lisp-Dep/fix-sbcl.lisp:1.9 --- mcclim/Lisp-Dep/fix-sbcl.lisp:1.8 Mon Feb 23 11:48:28 2004 +++ mcclim/Lisp-Dep/fix-sbcl.lisp Fri Aug 19 23:34:43 2005 @@ -2,10 +2,11 @@ (when (find-package "SB-MOP") (pushnew :sb-mop *features*))) -(defpackage #:clim-mop - (:use #+sb-mop #:sb-mop #-sb-mop #:sb-pcl) - #-sb-mop - (:shadowing-import-from #:sb-pcl #:eql-specializer-object)) +(eval-when (:compile-toplevel :load-toplevel :execute) + (unless (find-package '#:clim-mop) + (make-package '#:clim-mop :use '(#+sb-mop #:sb-mop + #-sb-mop #:sb-pcl)) + (shadowing-import 'sb-pcl::eql-specializer-object '#:clim-mop))) (eval-when (:compile-toplevel :load-toplevel :execute) (loop for sym being the symbols of :clim-mop

1 0

[mcclim-cvs] CVS update: mcclim/mcclim.asd mcclim/patch.lisp
by crhodes＠common-lisp.net 19 Aug '05

19 Aug '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv32041 Modified Files: mcclim.asd patch.lisp Log Message: SBCL / OpenMCL(?) build fixes Fix the perennially annoying duplicate component error in the Scigraph defsystem (name the components by the full namestring, which should be unique) While I'm at it, fix the annoyance over static / dynamic packages: for sbcl, clim-lisp-patch and clim-mop are dynamic packages, so they shouldn't be created by DEFPACKAGE (because reevaluating the defpackage subsequently, say by recompiling stuff, then invokes undefined behaviour) Date: Fri Aug 19 23:34:42 2005 Author: crhodes Index: mcclim/mcclim.asd diff -u mcclim/mcclim.asd:1.5 mcclim/mcclim.asd:1.6 --- mcclim/mcclim.asd:1.5 Wed Apr 20 00:35:42 2005 +++ mcclim/mcclim.asd Fri Aug 19 23:34:41 2005 @@ -78,7 +78,7 @@ (parse-namestring c) (make-pathname :type "lisp" :defaults *clim-directory*)) - collect `(:file ,(pathname-name p) :pathname ,p)))))) + collect `(:file ,(namestring p) :pathname ,p)))))) (defsystem :clim-lisp :components Index: mcclim/patch.lisp diff -u mcclim/patch.lisp:1.4 mcclim/patch.lisp:1.5 --- mcclim/patch.lisp:1.4 Mon Nov 15 05:47:41 2004 +++ mcclim/patch.lisp Fri Aug 19 23:34:41 2005 @@ -1,6 +1,10 @@ (in-package :cl-user) -(defpackage :clim-lisp-patch - (:use) - (:export #:describe #:describe-object #:interactive-stream-p)) +(eval-when (:compile-toplevel :load-toplevel :execute) + (unless (find-package :clim-lisp-patch) + (make-package :clim-lisp-patch :use nil))) +(export '(clim-lisp-patch::describe + clim-lisp-patch::describe-object + clim-lisp-patch::interactive-stream-p) + :clim-lisp-patch)

1 0

[mcclim-cvs] CVS update: mcclim/panes.lisp
by rstrandh＠common-lisp.net 19 Aug '05

19 Aug '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv19958 Modified Files: panes.lisp Log Message: Patch to panes.lisp from Max-Gerd Retzlaff. Date: Fri Aug 19 04:20:35 2005 Author: rstrandh Index: mcclim/panes.lisp diff -u mcclim/panes.lisp:1.153 mcclim/panes.lisp:1.154 --- mcclim/panes.lisp:1.153 Wed Jun 22 11:49:15 2005 +++ mcclim/panes.lisp Fri Aug 19 04:20:35 2005 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -;;; $Id: panes.lisp,v 1.153 2005/06/22 09:49:15 tmoore Exp $ +;;; $Id: panes.lisp,v 1.154 2005/08/19 02:20:35 rstrandh Exp $ (in-package :clim-internals) @@ -2591,6 +2591,7 @@ #+clim-mp (unless input-buffer (clim-sys:make-process (lambda () (let ((*application-frame* frame)) + (redisplay-frame-panes frame :force-p t) (standalone-event-loop))))) (slot-value frame 'stream)))

1 0

[mcclim-cvs] CVS update: mcclim/dialog.lisp
by rstrandh＠common-lisp.net 19 Aug '05

19 Aug '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv14088 Modified Files: dialog.lisp Log Message: Patches to dialog.lisp from Max-Gerd Retzlaff. Date: Fri Aug 19 02:48:26 2005 Author: rstrandh Index: mcclim/dialog.lisp diff -u mcclim/dialog.lisp:1.19 mcclim/dialog.lisp:1.20 --- mcclim/dialog.lisp:1.19 Fri Feb 25 15:15:17 2005 +++ mcclim/dialog.lisp Fri Aug 19 02:48:25 2005 @@ -136,6 +136,19 @@ (defvar *accepting-values-stream* nil) +(defmacro with-stream-in-own-window ((&optional (stream '*query-io*) + &rest further-streams) + &rest body) + `(let* ((,stream (open-window-stream)) + ,@(mapcar (lambda (a-stream) + (list a-stream stream)) + further-streams)) + (sleep 0.1) ;; hackhack.. some delay to "ensure" that the window-stream ist opened + (unwind-protect + (progn + ,@body) + (close ,stream)))) + (defmacro accepting-values ((&optional (stream t) &rest args @@ -144,17 +157,22 @@ align-prompts label scroll-bars x-position y-position width height command-table frame-class) &body body) - (declare (ignorable own-window exit-boxes initially-select-query-identifier + (declare (ignorable exit-boxes initially-select-query-identifier modify-initial-query resynchronize-every-pass resize-frame align-prompts label scroll-bars x-position y-position width height command-table frame-class)) (setq stream (stream-designator-symbol stream '*standard-input*)) (with-gensyms (accepting-values-continuation) - `(flet ((,accepting-values-continuation (,stream) - ,@body)) - (invoke-accepting-values ,stream - #',accepting-values-continuation - ,@args)))) + (let ((return-form + `(flet ((,accepting-values-continuation (,stream) + ,@body)) + (invoke-accepting-values ,stream + #',accepting-values-continuation + ,@args)) + )) + (if own-window + `(with-stream-in-own-window (,stream *standard-input* *standard-output*) ,return-form) + return-form)))) (defun invoke-accepting-values (stream body @@ -167,7 +185,10 @@ (frame-class 'accept-values)) (declare (ignore own-window exit-boxes modify-initial-query resize-frame label scroll-bars x-position y-position - width height frame-class)) + width height frame-class)) + (when (and align-prompts ;; t means the same as :right + (not (eq align-prompts :left))) + (setf align-prompts :right)) (multiple-value-bind (cx cy) (stream-cursor-position stream) (let* ((*accepting-values-stream* (make-instance 'accepting-values-stream @@ -224,11 +245,11 @@ (fresh-line stream) (with-output-as-presentation (stream nil 'exit-button) - (format stream "Exit")) + (format stream "OK")) (write-char #\space stream) (with-output-as-presentation (stream nil 'abort-button) - (format stream "Abort")) + (format stream "Cancel")) (terpri stream))) (defmethod stream-accept ((stream accepting-values-stream) type

1 0

[mcclim-cvs] CVS update: mcclim/design.lisp mcclim/ports.lisp
by rstrandh＠common-lisp.net 18 Aug '05

18 Aug '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv26220 Modified Files: design.lisp ports.lisp Log Message: Removed a few compiler warnings. Date: Thu Aug 18 21:58:18 2005 Author: rstrandh Index: mcclim/design.lisp diff -u mcclim/design.lisp:1.23 mcclim/design.lisp:1.24 --- mcclim/design.lisp:1.23 Wed Oct 6 07:12:12 2004 +++ mcclim/design.lisp Thu Aug 18 21:58:18 2005 @@ -89,6 +89,8 @@ (define-protocol-class color (design uniform-design)) +(defgeneric color-rgb (color)) + (defmethod print-object ((color color) stream) (print-unreadable-object (color stream :identity nil :type t) (multiple-value-call #'format stream "~,4F ~,4F ~,4F" (color-rgb color)))) @@ -239,6 +241,8 @@ (saturation (atan f2 f1))) (values intensity hue saturation))))) +(defgeneric color-ihs (color)) + (defmethod color-ihs ((color color)) (multiple-value-call #'rgb-to-ihs (color-rgb color))) @@ -354,6 +358,8 @@ (print-unreadable-object (flipper stream :identity nil :type t) (format stream "~S ~S" design1 design2)))) +(defgeneric make-flipping-ink (design1 design2)) + (defmethod make-flipping-ink ((design1 design) (design2 design)) (make-instance 'standard-flipping-ink :design1 design1 :design2 design2)) @@ -396,9 +402,13 @@ (defun make-pattern (array designs) (make-instance 'indexed-pattern :array array :designs designs)) +(defgeneric pattern-width (pattern)) + (defmethod pattern-width ((pattern indexed-pattern)) (with-slots (array) pattern (array-dimension array 1))) + +(defgeneric pattern-height (pattern)) (defmethod pattern-height ((pattern indexed-pattern)) (with-slots (array) pattern Index: mcclim/ports.lisp diff -u mcclim/ports.lisp:1.48 mcclim/ports.lisp:1.49 --- mcclim/ports.lisp:1.48 Tue Feb 22 04:14:26 2005 +++ mcclim/ports.lisp Thu Aug 18 21:58:18 2005 @@ -92,6 +92,9 @@ ;; A method on (SETF KEYBOARD-INPUT-FOCUS) brings them together, ;; calling %SET-PORT-KEYBOARD-FOCUS. +(defgeneric port-keyboard-input-focus (port)) +(defgeneric (setf port-keyboard-input-focus) (focus port)) + (defmethod port-keyboard-input-focus (port) (declare (ignore port)) (when *application-frame* @@ -107,7 +110,7 @@ ;; now calls (setf keyboard-input-focus), we need something concrete the ;; backend can implement to set the focus. (defmethod %set-port-keyboard-focus (port focus &key timestamp) - (declare (ignore focus)) + (declare (ignore focus timestamp)) (warn "%SET-PORT-KEYBOARD-FOCUS is not implemented on ~W" port))

1 0

[mcclim-cvs] CVS update: mcclim/commands.lisp
by rstrandh＠common-lisp.net 18 Aug '05

18 Aug '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv28655 Modified Files: commands.lisp Log Message: Patch from Max-Gerd Retzlaff Date: Thu Aug 18 06:30:11 2005 Author: rstrandh Index: mcclim/commands.lisp diff -u mcclim/commands.lisp:1.53 mcclim/commands.lisp:1.54 --- mcclim/commands.lisp:1.53 Wed Jun 22 13:41:35 2005 +++ mcclim/commands.lisp Thu Aug 18 06:30:09 2005 @@ -746,30 +746,36 @@ ;; We don't need fresh gensyms of these variables for each accept form. (with-gensyms (value ptype changedp) `(defun ,name (,command-table ,stream ,partial-command) - (destructuring-bind (,command-name ,@original-args) - ,partial-command - (let ((,command-line-name (command-line-name-for-command - ,command-name - ,command-table - :errorp nil)) - ,@(mapcar #'list required-arg-names original-args)) - (accepting-values (,stream) - (format ,stream - "You are being prompted for arguments to ~S~%" - ,command-line-name) - ,@(loop - for var in required-arg-names - for original-var in original-args - for parameter in required-args - append `((multiple-value-bind (,value ,ptype ,changedp) - ,(accept-form-for-argument-partial - stream parameter var original-var) - (declare (ignore ,ptype)) - (terpri ,stream) - (when ,changedp - (setq ,var ,value)))))) - (list ,command-name ,@required-arg-names)))))))) - + (do ((still-missing nil t)) + (nil) + (destructuring-bind (,command-name ,@original-args) + ,partial-command + (let ((,command-line-name (command-line-name-for-command + ,command-name + ,command-table + :errorp nil)) + ,@(mapcar #'list required-arg-names original-args)) + (accepting-values (,stream) + (format ,stream + "You are being prompted for arguments to ~S~%~%" + ,command-line-name) + ,@(loop + for var in required-arg-names + for original-var in original-args + for parameter in required-args + append `((multiple-value-bind (,value ,ptype ,changedp) + ,(accept-form-for-argument-partial + stream parameter var original-var) + (declare (ignore ,ptype)) + (terpri ,stream) + (when ,changedp + (setq ,var ,value))))) + (when still-missing + (format ,stream + "~&Please supply all arguments."))) + (setf ,partial-command (list ,command-name ,@required-arg-names)) + (unless (partial-command-p ,partial-command) + (return ,partial-command)))))))))) ;;; XXX What do to about :acceptably? Probably need to wait for Goatee "buffer ;;; streams" so we can insert an accept-result-extent in the buffer for @@ -1079,7 +1085,6 @@ stream (view textual-view) &key) - (declare (ignore acceptably for-context-type)) (let ((command-line-name (command-line-name-for-command object command-table :errorp nil))) (if command-line-name

1 0

[mcclim-cvs] CVS update: mcclim/Examples/town-example.lisp
by rstrandh＠common-lisp.net 18 Aug '05

18 Aug '05

Update of /project/mcclim/cvsroot/mcclim/Examples In directory common-lisp.net:/tmp/cvs-serv24274 Added Files: town-example.lisp Log Message: Another example of the use of CLIM. (thanks to Max-Gerd Retzlaff) It tries to demonstrate the following topics: custom view classes, different present presentation methods for different views, completion for accept presentation methods, accepting-values dialogues, presentation to command translators, partial commands in menus, automatically generated menus, and keystroke gestures for commands. Date: Thu Aug 18 05:25:31 2005 Author: rstrandh

1 0

[mcclim-cvs] CVS update: mcclim/frames.lisp mcclim/incremental-redisplay.lisp
by rstrandh＠common-lisp.net 18 Aug '05

18 Aug '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv24177 Modified Files: frames.lisp incremental-redisplay.lisp Log Message: Initial cleanups to incremental redisplay. Date: Thu Aug 18 05:17:22 2005 Author: rstrandh Index: mcclim/frames.lisp diff -u mcclim/frames.lisp:1.107 mcclim/frames.lisp:1.108 --- mcclim/frames.lisp:1.107 Sun Apr 17 20:46:26 2005 +++ mcclim/frames.lisp Thu Aug 18 05:17:21 2005 @@ -484,25 +484,6 @@ (:disowned (disown-frame fm frame))))))) -;;; Defined in incremental-redisplay.lisp -(defvar *enable-updating-output*) - -#+nil -(defun redisplay-changed-panes (frame) - (map-over-sheets #'(lambda (pane) - (multiple-value-bind (redisplayp clearp) - (pane-needs-redisplay pane) - (when redisplayp - (when (and clearp - (or (not (pane-incremental-redisplay - pane)) - (not *enable-updating-output*))) - (window-clear pane)) - (redisplay-frame-pane frame pane) - (unless (eq redisplayp :command-loop) - (setf (pane-needs-redisplay pane) nil))))) - (frame-top-level-sheet frame))) - (defparameter +default-prompt-style+ (make-text-style :fix :italic :normal)) (defmethod default-frame-top-level Index: mcclim/incremental-redisplay.lisp diff -u mcclim/incremental-redisplay.lisp:1.51 mcclim/incremental-redisplay.lisp:1.52 --- mcclim/incremental-redisplay.lisp:1.51 Tue Aug 16 06:30:37 2005 +++ mcclim/incremental-redisplay.lisp Thu Aug 18 05:17:21 2005 @@ -245,8 +245,7 @@ (defmethod pane-needs-redisplay :around ((pane updating-output-stream-mixin)) (let ((redisplayp (call-next-method))) (values redisplayp (and (not (eq redisplayp :no-clear)) - (or (not (pane-incremental-redisplay pane)) - (not *enable-updating-output*)))))) + (not (pane-incremental-redisplay pane)))))) (defmethod window-clear :after ((pane updating-output-stream-mixin)) "Get rid of any updating output records stored in the stream; they're gone @@ -850,9 +849,6 @@ ;; move overlapping nil))))) -(defparameter *enable-updating-output* t - "Switch to turn on incremental redisplay") - (defvar *trace-updating-output* nil) (defvar *no-unique-id* (cons nil nil)) @@ -874,8 +870,6 @@ unique-id id-test cache-value cache-test &key (fixed-position nil) (all-new nil) (parent-cache nil)) - (unless *enable-updating-output* - (return-from invoke-updating-output (funcall continuation stream))) (finish-output stream) (let ((parent-cache (or parent-cache *current-updating-output* stream))) (when (eq unique-id *no-unique-id*) @@ -991,16 +985,6 @@ (defvar *dump-updating-output* nil) -;;; Protocol for notifying that records have been added or deleted, -;;; for real, during redisplay. - -(defgeneric redisplay-add-output-record (record stream) - (:documentation "Process an output record that has been added (i.e., - was not in the output history of the stream) during redisplay. The - record has not been displayed yet.")) - -(defgeneric redisplay-delete-output-record (record bounding-rectangle stream)) - (defgeneric redisplay-output-record (record stream &optional check-overlapping)) @@ -1032,30 +1016,6 @@ (delete-stale-updating-output record)) (set-medium-graphics-state current-graphics-state stream))))) -(defmethod redisplay-add-output-record (record - (stream updating-output-stream-mixin)) - (with-bounding-rectangle* (x1 y1 x2 y2) - record - (draw-rectangle* stream x1 y1 x2 y2 - :ink +background-ink+))) - -(defmethod redisplay-add-output-record :after - (record (stream updating-output-stream-mixin)) - (note-output-record-got-sheet record stream)) - -(defmethod redisplay-delete-output-record - (record bounding-rectangle (stream updating-output-stream-mixin)) - (declare (ignore record)) - (with-bounding-rectangle* (x1 y1 x2 y2) - bounding-rectangle - (draw-rectangle* stream x1 y1 x2 y2 - :ink +background-ink+))) - -(defmethod redisplay-delete-output-record :after - (record bounding-rectangle (stream updating-output-stream-mixin)) - (declare (ignore bounding-rectangle)) - (note-output-record-lost-sheet record stream)) - (defun erase-rectangle (stream bounding) (with-bounding-rectangle* (x1 y1 x2 y2) bounding @@ -1244,7 +1204,7 @@ ((frame application-frame) (pane updating-output-stream-mixin) &key force-p) (setf (id-counter pane) 0) (let ((incremental-redisplay (pane-incremental-redisplay pane))) - (cond ((or (not incremental-redisplay) (not *enable-updating-output*)) + (cond ((not incremental-redisplay) (call-next-method)) ((or (null (updating-record pane)) force-p)

1 0

[mcclim-cvs] CVS update: mcclim/incremental-redisplay.lisp
by rstrandh＠common-lisp.net 16 Aug '05

16 Aug '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv26736 Modified Files: incremental-redisplay.lisp Log Message: Fixed a bug in function-matches-p. It should use symbol-function and not symbol-value. Date: Tue Aug 16 06:30:37 2005 Author: rstrandh Index: mcclim/incremental-redisplay.lisp diff -u mcclim/incremental-redisplay.lisp:1.50 mcclim/incremental-redisplay.lisp:1.51 --- mcclim/incremental-redisplay.lisp:1.50 Mon Aug 15 02:41:38 2005 +++ mcclim/incremental-redisplay.lisp Tue Aug 16 06:30:37 2005 @@ -124,9 +124,9 @@ ((and (symbolp map-test-func) (symbolp func)) ; not eq nil) ((and (symbolp map-test-func) (fboundp map-test-func)) - (eq (symbol-value map-test-func) func)) + (eq (symbol-function map-test-func) func)) ((and (symbolp func) (fboundp func)) - (eq map-test-func (symbol-value func))) + (eq map-test-func (symbol-function func))) (t nil)))) (defun ensure-test (map test)

1 0

[mcclim-cvs] CVS update: mcclim/incremental-redisplay.lisp
by tmoore＠common-lisp.net 15 Aug '05

15 Aug '05

Update of /project/mcclim/cvsroot/mcclim In directory common-lisp.net:/tmp/cvs-serv9635 Modified Files: incremental-redisplay.lisp Log Message: Change specialized output-record-hash method to specialize on standard-bounding-rectangle, as noted by Taylor Campbell Date: Mon Aug 15 02:41:38 2005 Author: tmoore Index: mcclim/incremental-redisplay.lisp diff -u mcclim/incremental-redisplay.lisp:1.49 mcclim/incremental-redisplay.lisp:1.50 --- mcclim/incremental-redisplay.lisp:1.49 Tue Aug 9 22:30:12 2005 +++ mcclim/incremental-redisplay.lisp Mon Aug 15 02:41:38 2005 @@ -715,7 +715,7 @@ (:documentation "Produce a value that can be used to hash the output record in an equalp hash table")) -(defmethod output-record-hash ((record basic-output-record)) +(defmethod output-record-hash ((record standard-bounding-rectangle)) (slot-value record 'coordinates)) (defconstant +fixnum-bits+ (integer-length most-positive-fixnum))

1 0