mcclim-cvs December 2008

mcclim-cvs@common-lisp.net

3 participants
7 discussions

[mcclim-cvs] CVS mcclim
by ahefner 19 Dec '08

19 Dec '08

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv12406 Modified Files: panes.lisp Log Message: Guard against infinite recursion in fit-pane-to-output in the case that compose-space calls the display function to compute the size, and the display function calls us (and we call compose space..) --- /project/mcclim/cvsroot/mcclim/panes.lisp 2008/11/30 22:22:29 1.193 +++ /project/mcclim/cvsroot/mcclim/panes.lisp 2008/12/19 08:58:14 1.194 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. -;;; $Id: panes.lisp,v 1.193 2008/11/30 22:22:29 ahefner Exp $ +;;; $Id: panes.lisp,v 1.194 2008/12/19 08:58:14 ahefner Exp $ (in-package :clim-internals) @@ -2552,7 +2552,7 @@ (flet ((compute (val default) (if (eq val :compute) default val))) (if (or (eq (pane-user-width pane) :compute) - (eq (pane-user-height pane) :compute)) + (eq (pane-user-height pane) :compute)) (progn (with-output-recording-options (pane :record t :draw nil) ;; multiple-value-letf anyone? @@ -2973,7 +2973,12 @@ (:method (pane) (declare (ignore pane)))) (defmethod fit-pane-to-output ((stream clim-stream-pane)) - (when (sheet-mirror stream) + ;;; Guard against infinite recursion of size is set to :compute, as this + ;;; could get called from the display function. We'll call compose-space + ;;; here, which will invoke the display function again.. + (when (and (sheet-mirror stream) + (not (or (eq (pane-user-width stream) :compute) + (eq (pane-user-height stream) :compute)))) (let* ((output (stream-output-history stream)) (fit-width (bounding-rectangle-max-x output)) (fit-height (bounding-rectangle-max-y output)))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 08 Dec '08

08 Dec '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory cl-net:/tmp/cvs-serv30788/Drei Modified Files: lisp-syntax-swank.lisp Log Message: Bring Drei up to date with CVS Swank. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swank.lisp 2008/06/07 13:31:14 1.13 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swank.lisp 2008/12/08 17:48:53 1.14 @@ -63,12 +63,13 @@ (buffer-file-name (filepath (buffer view))) (swank::*buffer-package* package) (swank::*buffer-readtable* *readtable*)) - (let ((result (swank::compile-string-for-emacs - string view-name (offset buffer-mark) (princ-to-string buffer-file-name) - nil)) - (notes (loop for note in (swank::compiler-notes-for-emacs) - collect (make-compiler-note note)))) - (values result notes)))) + (let* ((result (swank::compile-string-for-emacs + string view-name (offset buffer-mark) (princ-to-string buffer-file-name) + nil)) + (notes (loop for note in (swank::compilation-result-notes result) + collect (make-compiler-note note)))) + (values (list (swank::compilation-result-successp result) + (swank::compilation-result-duration result)) notes)))) (defmethod compile-file-for-drei ((image swank-local-image) filepath package &optional load-p) (declare (ignore image)) @@ -76,9 +77,10 @@ (swank::*buffer-readtable* *readtable*) (*compile-verbose* nil) (result (swank::compile-file-for-emacs filepath load-p)) - (notes (loop for note in (swank::compiler-notes-for-emacs) - collect (make-compiler-note note)))) - (values result notes))) + (notes (loop for note in (swank::compilation-result-notes result) + collect (make-compiler-note note)))) + (values (list (swank::compilation-result-successp result) + (swank::compilation-result-duration result)) notes))) (defmethod find-definitions-for-drei ((image swank-local-image) symbol) (declare (ignore image)) @@ -108,4 +110,4 @@ (defmethod fuzzy-completions ((image swank-local-image) symbol-name default-package &optional limit) (declare (ignore image)) - (swank::fuzzy-completions symbol-name (package-name default-package) limit)) + (swank::fuzzy-completions symbol-name (package-name default-package) :limit limit))

1 0

[mcclim-cvs] CVS mcclim/Doc
by rstrandh 08 Dec '08

08 Dec '08

Update of /project/mcclim/cvsroot/mcclim/Doc In directory cl-net:/tmp/cvs-serv30373 Modified Files: mcclim.texi Log Message: Patches from Mikael Jansson. --- /project/mcclim/cvsroot/mcclim/Doc/mcclim.texi 2008/04/23 12:05:36 1.12 +++ /project/mcclim/cvsroot/mcclim/Doc/mcclim.texi 2008/12/08 06:18:38 1.13 @@ -1326,14 +1326,7 @@ @node Protocol Changes @section Protocol Changes -@deffn {Generic Function}{line-style-effective-thickness} line-style medium - -The thickness in device units of the lines rendered on @var{medium} in -the line style @var{line-style}. The default method, assuming normal -line width to be 1 device unit, is provided. -@end deffn - -@c @initarg{:parent} +@include fun-clim-extensions-line-style-effective-thickness.texi @deffn {Generic Function} {(setf output-record-parent)} parent record @@ -1342,16 +1335,9 @@ @end deffn -@deffn {Generic Function} {replay-output-record} record stream &optional region x-offset y-offset -@end deffn - -@deffn {Generic Function} {map-over-output-records-containing-position} function record x y &optional x-offset y-offset &rest function-args -@end deffn - -@deffn {Generic Function} {map-over-output-records-overlapping-region} function record region &optional x-offset y-offset &rest function-args - -@var{x-offset} and @var{y-offset} are ignored. -@end deffn +@include fun-clim-replay-output-record.texi +@include fun-clim-map-over-output-records-containing-position.texi +@include fun-clim-map-over-output-records-overlapping-region.texi @c XXX \defgeneric displayed-output-record-ink for text records @@ -1373,12 +1359,8 @@ @c \defgeneric {invoke-with-new-output-record} :parent key -@deffn {Macro} {with-new-output-record} ({stream &optional record-type record &rest initargs}) \body body -@end deffn -@deffn {Macro} {with-output-to-output-record} ({stream &optional record-type record &rest initargs}) \body body -@end deffn - -@var{record-type} is evaluated. +@include macro-clim-with-new-output-record.texi +@include macro-clim-with-output-to-output-record.texi @node Command Processing @chapter Command Processing @@ -1408,13 +1390,7 @@ @chapter Output Protocol Extensions @cindex extensions -@deffn {Generic Function} {medium-miter-limit} medium -@end deffn - -Returns the minimal value of an angle for which :MITER line joint may be -used; for smaller angles :MITER is interpreted as :BEVEL. -@c Different calls of the function with the same argument must return -@c values which are COORDINATE=. +@include fun-clim-extensions-medium-miter-limit.texi @node Output Recording Extensions @chapter Output Recording Extensions

1 0

[mcclim-cvs] CVS mcclim
by ahefner 07 Dec '08

07 Dec '08

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv19217 Modified Files: frames.lisp Log Message: Change default text and prompt style to sans-serif, except for forms in the listener. --- /project/mcclim/cvsroot/mcclim/frames.lisp 2008/02/05 08:53:09 1.133 +++ /project/mcclim/cvsroot/mcclim/frames.lisp 2008/12/07 20:24:44 1.134 @@ -325,7 +325,7 @@ (lambda (sheet) (when (typep sheet 'pane) (when (and (typep sheet 'clim-stream-pane) - (not (eq :no-clear (pane-redisplay-needed sheet)))) + (not (eq :no-clear (pane-redisplay-needed sheet)))) (window-clear sheet)) (redisplay-frame-pane frame sheet :force-p force-p))) (frame-top-level-sheet frame))) @@ -463,7 +463,7 @@ (:disowned (disown-frame fm frame))))))) -(defparameter +default-prompt-style+ (make-text-style :fix :italic :normal)) +(defparameter +default-prompt-style+ (make-text-style :sans-serif :bold :normal)) (defmethod default-frame-top-level ((frame application-frame)

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by ahefner 07 Dec '08

07 Dec '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory cl-net:/tmp/cvs-serv19217/Apps/Listener Modified Files: listener.lisp Log Message: Change default text and prompt style to sans-serif, except for forms in the listener. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp 2008/02/15 09:48:41 1.43 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp 2008/12/07 20:24:44 1.44 @@ -140,12 +140,18 @@ (object (type empty-input) stream view &key &allow-other-keys) (princ "" stream)) +;;; Sneaky - we want to use :fix text for the command prompt, but +;;; use the default :sans-serif in accepting-values dialogs. Those +;;; are invokved by the :around method on r-f-c, so if we bind +;;; the text style here in the primary method, we're okay. + (defmethod read-frame-command ((frame listener) &key (stream *standard-input*)) "Specialized for the listener, read a lisp form to eval, or a command." (multiple-value-bind (object type) (let ((*command-dispatchers* '(#\,))) - (accept 'command-or-form :stream stream :prompt nil - :default "hello" :default-type 'empty-input)) + (with-text-style (stream (make-text-style :fix :roman :normal)) + (accept 'command-or-form :stream stream :prompt nil + :default "hello" :default-type 'empty-input))) (cond ((presentation-subtypep type 'empty-input) ;; Do nothing.

1 0

[mcclim-cvs] CVS mcclim
by ahefner 07 Dec '08

07 Dec '08

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv22434 Modified Files: dialog.lisp Log Message: Center the label with the text field, since s-o-w-b scrambles the notion of the baseline. --- /project/mcclim/cvsroot/mcclim/dialog.lisp 2008/12/06 14:56:41 1.30 +++ /project/mcclim/cvsroot/mcclim/dialog.lisp 2008/12/07 03:22:54 1.31 @@ -339,7 +339,7 @@ (let ((query-record nil)) (if align (formatting-row (stream) - (formatting-cell (stream :align-x align) + (formatting-cell (stream :align-x align :align-y :center) (do-prompt)) (formatting-cell (stream) (setq query-record (do-accept-present-default))))

1 0

[mcclim-cvs] CVS mcclim
by ahefner 06 Dec '08

06 Dec '08

Update of /project/mcclim/cvsroot/mcclim In directory cl-net:/tmp/cvs-serv9908 Modified Files: commands.lisp dialog.lisp Log Message: Add new keyword to accepting-values, select-first-query, to automatically select the first field in the dialog (we could do this using an existing keyword, but figuring out the right query ID and getting it where it needed to be looked like too much work). This highlights what I think is an existing bug - the exit buttons often don't work when a field in the dialog is accepting. Minor aesthetic tweaks to accepting-values dialog (change border styles, dress up exit buttons, rearrange some line breaks). --- /project/mcclim/cvsroot/mcclim/commands.lisp 2008/10/23 20:49:41 1.80 +++ /project/mcclim/cvsroot/mcclim/commands.lisp 2008/12/06 14:56:41 1.81 @@ -856,24 +856,26 @@ ,command-table :errorp nil)) ,@(mapcar #'list required-arg-names original-args)) - (accepting-values (,stream) + (accepting-values (,stream :select-first-query t + :align-prompts t) (format ,stream - "You are being prompted for arguments to ~S~%~%" + "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 + for first-arg = t then nil append `((multiple-value-bind (,value ,ptype ,changedp) ,(accept-form-for-argument-partial stream parameter var original-var) (declare (ignore ,ptype)) - (terpri ,stream) + ,@(unless first-arg `((terpri ,stream))) (when ,changedp (setq ,var ,value))))) (when still-missing (format ,stream - "~&Please supply all arguments."))) + "~&Please supply all arguments.~%"))) (setf ,partial-command (list ,command-name ,@required-arg-names)) (unless (partial-command-p ,partial-command) (return ,partial-command)))))))))) --- /project/mcclim/cvsroot/mcclim/dialog.lisp 2008/02/01 00:22:04 1.29 +++ /project/mcclim/cvsroot/mcclim/dialog.lisp 2008/12/06 14:56:41 1.30 @@ -155,12 +155,12 @@ &rest args &key own-window exit-boxes initially-select-query-identifier modify-initial-query resynchronize-every-pass resize-frame - align-prompts label scroll-bars + align-prompts label scroll-bars select-first-query x-position y-position width height command-table frame-class) &body body) (declare (ignorable exit-boxes initially-select-query-identifier modify-initial-query resynchronize-every-pass resize-frame - align-prompts scroll-bars + align-prompts scroll-bars select-first-query x-position y-position width height command-table frame-class)) (setq stream (stream-designator-symbol stream '*standard-input*)) (with-gensyms (accepting-values-continuation) @@ -185,6 +185,7 @@ (stream body &key own-window exit-boxes (initially-select-query-identifier nil initially-select-p) + select-first-query modify-initial-query resynchronize-every-pass resize-frame align-prompts label scroll-bars x-position y-position width height @@ -229,6 +230,14 @@ ('(command :command-table accept-values)) (object) (progn + (when (and select-first-query + (not initially-select-p)) + (setf current-command + `(com-select-query + ,(query-identifier + (first + (queries *accepting-values-stream*)))) + select-first-query nil)) (apply (command-name current-command) (command-arguments current-command)) ;; If current command returns without throwing a @@ -252,13 +261,22 @@ (declare (ignore frame)) (updating-output (stream :unique-id 'buttons :cache-value t) (fresh-line stream) - (with-output-as-presentation - (stream nil 'exit-button) - (format stream "OK")) - (write-char #\space stream) - (with-output-as-presentation - (stream nil 'abort-button) - (format stream "Cancel")) + (formatting-table (stream) + (formatting-row (stream) + (formatting-cell (stream) + (with-output-as-presentation (stream nil 'exit-button) + (surrounding-output-with-border + (stream :shape :rounded :radius 6 + :background +gray80+ :highlight-background +gray90+) + (format stream "OK")))) + (formatting-cell (stream) + (with-output-as-presentation + (stream nil 'abort-button) (with-output-as-presentation + (stream nil 'exit-button) + (surrounding-output-with-border + (stream :shape :rounded :radius 6 + :background +gray80+ :highlight-background +gray90+) + (format stream "Cancel"))))))) (terpri stream))) (defmethod stream-accept ((stream accepting-values-stream) type @@ -457,16 +475,25 @@ (stream query-identifier 'selectable-query :single-box t) (surrounding-output-with-border - (stream :shape :inset :move-cursor t) + (stream :shape :rounded + :radius 3 :background +white+ + :foreground +gray40+ + :move-cursor t) + ;;; FIXME: In this instance we really want borders that + ;;; react to the growth of their children. This should + ;;; be straightforward unless there is some involvement + ;;; of incremental redisplay. + ;;; KLUDGE: Arbitrary min-width. (setq editing-stream (make-instance (if *use-goatee* 'goatee-input-editing-stream 'standard-input-editing-stream) :stream stream :cursor-visibility nil - :background-ink +grey90+ :single-line t - :min-width t)))) + :min-width (- (bounding-rectangle-max-x stream) + (stream-cursor-position stream) + 100))))) (when default-supplied-p (input-editing-rescan-loop ;XXX probably not needed editing-stream

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs December 2008