mcclim-cvs December 2006

mcclim-cvs@common-lisp.net

6 participants
124 discussions

[mcclim-cvs] CVS mcclim/Drei/cl-automaton
by thenriksen 04 Dec '06

04 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Drei/cl-automaton In directory clnet:/tmp/cvs-serv11067/Drei/cl-automaton Removed Files: state-and-transition-test.lisp eqv-hash-test.lisp automaton-test.lisp automaton-test-package.lisp Log Message: Removed old RT-based tests.

1 0

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

04 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv11067/Drei Removed Files: kill-ring-test.lisp drei.asd buffer-test.lisp base-test.lisp Log Message: Removed old RT-based tests.

1 0

[mcclim-cvs] CVS mcclim/Apps/Listener
by ahefner 03 Dec '06

03 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv20883 Modified Files: dev-commands.lisp listener.lisp Log Message: If we're going to present the package portion of the prompt, we might as well define a translator to do something useful with it (or am I missing the point?). While we're at it, present the package in the wholine-pane, and add a popup to choose a new package. Also, added discussion of presentation of values at the REPL, as I'm not entirely happy with the current behavior, but leave it unchanged for the moment. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2006/11/21 20:34:40 1.38 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp 2006/12/03 22:56:46 1.39 @@ -23,7 +23,7 @@ (define-command-table application-commands) -(define-command-table lisp-dev-commands :inherit-from nil) ;; "Abstract" command table used for defining some translators in +(define-command-table lisp-dev-commands :inherit-from nil) ;; Translators live here (define-command-table lisp-commands :inherit-from (lisp-dev-commands)) (define-command-table show-commands :inherit-from (lisp-dev-commands)) @@ -519,11 +519,11 @@ ((class-spec 'class-name :prompt "class") &key (orientation 'keyword :prompt "orientation" :default :horizontal)) - (let ((class (frob-to-class class-spec))) - (if (not (null class)) + (let ((class (frob-to-class class-spec))) + (if (not (null class)) (class-grapher *standard-output* class #'clim-mop:class-direct-subclasses :orientation orientation) - (note "~A is not a defined class." class-spec)))) + (note "~A is not a defined class." class-spec)))) ; Lookup direct slots from along the CPL given a class and a slot name. @@ -1261,7 +1261,7 @@ ;; So.. yeah. (defun automagic-translator (pathname) - "Returns values, the command translation, and a documentation string for the translation." + "Returns 2 values: the command translation, and a documentation string for the translation." (cond ((wild-pathname-p pathname) (values `(com-show-directory ,pathname) "Show Matching Files" @@ -1443,26 +1443,47 @@ ;;; Eval (defun display-evalues (values) - (with-drawing-options (t :ink +olivedrab+) - (cond ((null values) - (format t "No values.~%")) - ((= 1 (length values)) - (let ((o (first values))) - (with-output-as-presentation (t o (presentation-type-of o) - :single-box t) - (present (first values) 'expression))) - (fresh-line)) - (t (do* ((i 0 (1+ i)) - (items values (rest items)) - (o (first items) (first items))) - ((null items)) + (labels + ((present-value (value) + ;; I would really prefer this to behave as below, as presenting + ;; things as expressions causes translators applicable to expression + ;; to override those which would be otherwise applicable (such as + ;; the set-current-package translator). I retain the use of w-o-a-p, + ;; swapping the inner/outer presentation types, with the assumption + ;; that someone (the form reader?) really does want expressions, and + ;; the presentation-type-of is seldom a subtype of expression. + ;; Aside from that, the problem with my code below is that it + ;; will use the default presentation method for the type, which will + ;; not necessarily print in the fashion expected from the lisp REPL. + ;; Possibly this +listener-view+ could save the day here, but I'm + ;; unclear on why it exists. --Hefner + + ;; Okay, set-current-package translator now mysteriously works, but + ;; I stand by the notion that 'expression should not be the type of + ;; the innermost presentation. + + #+(or) + (with-output-as-presentation (t value 'expression :single-box t) + (present value (presentation-type-of value) :single-box t)) + + (with-output-as-presentation (t value (presentation-type-of value) + :single-box t) + (present (first values) 'expression)))) + (with-drawing-options (t :ink +olivedrab+) + (cond ((null values) + (format t "No values.~%")) + ((= 1 (length values)) + (present-value (first values)) + (fresh-line)) + (t (do* ((i 0 (1+ i)) + (items values (rest items)) + (object (first items) (first items))) + ((null items)) (with-drawing-options (t :ink +limegreen+) (with-text-style (t (make-text-style nil :italic :small)) (format t "~A " i))) - (with-output-as-presentation (t o (presentation-type-of o) - :single-box t) - (present o 'expression)) - (fresh-line)))))) + (present-value object) + (fresh-line))))))) (defun shuffle-specials (form values) (setf +++ ++ @@ -1476,7 +1497,7 @@ * (first values))) (define-command (com-eval :menu t :command-table lisp-commands) - ((form 'clim:form :prompt "form")) + ((form 'clim:form :prompt "form")) (let* ((- form) (values (multiple-value-list (eval form)))) (fresh-line) @@ -1563,3 +1584,14 @@ :provide-output-destination-keyword nil) ((p 'package)) (setf *package* p)) + +(define-presentation-to-command-translator set-current-package + (package com-set-package lisp-commands + :pointer-documentation ((object stream) + (format stream "Set current package to ~A" (package-name object))) + :documentation ((stream) (format stream "Set Package")) + :menu t + :tester ((object) (not (eql *package* object)))) + (object) + (list object)) + --- /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp 2006/11/21 22:39:32 1.30 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp 2006/12/03 22:56:46 1.31 @@ -19,6 +19,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. +(define-presentation-type listener-current-package () :inherit-from 'package) ;; Wholine Pane @@ -92,7 +93,8 @@ (cell (:left) (format t "~A@~A" username sitename)) (cell (:center) (format t "Package ") - (print-package-name t)) + (with-output-as-presentation (t *package* 'listener-current-package) + (print-package-name t))) (cell (:center) (when (probe-file *default-pathname-defaults*) (with-output-as-presentation (t (truename *default-pathname-defaults*) 'pathname) @@ -163,7 +165,7 @@ (defmethod stream-present :around ((stream listener-interactor-pane) object type &rest args &key (single-box nil sbp) &allow-other-keys) - (apply #'call-next-method stream object type :single-box t args) + (apply #'call-next-method stream object type :single-box t args) ;; we would do this, but CLIM:PRESENT calls STREAM-PRESENT with all ;; the keyword arguments explicitly. *sigh*. #+nil @@ -199,6 +201,29 @@ doc wholine)))) +;;; Package selection popup + +(define-listener-command (com-choose-package) + () + (let ((new-package (menu-choose (sort (mapcar (lambda (package) (cons (package-name package) + package)) + (list-all-packages)) + #'string< + :key #'car) + :label "Choose Package"))) + (when new-package + (setf *package* new-package)))) + +(define-presentation-to-command-translator choose-package-translator + (listener-current-package com-choose-package listener + :echo nil + :priority 100 ; These presentations appear in exactly one context, so give this a high priority. + :documentation ((object stream) + (declare (ignore object)) + (format stream "Choose package"))) + (current-package) + nil) + ;;; Lisp listener command loop (defmethod read-frame-command ((frame listener) &key (stream *standard-input*))

1 0

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

03 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv20865/Drei Modified Files: core.lisp Log Message: Oops, these arguments should be the other way around. --- /project/mcclim/cvsroot/mcclim/Drei/core.lisp 2006/11/08 01:15:33 1.1 +++ /project/mcclim/cvsroot/mcclim/Drei/core.lisp 2006/12/03 22:50:13 1.2 @@ -250,8 +250,8 @@ syntax-line-indentation-function fill-column tab-width - compress-whitespaces - syntax)))) + syntax + compress-whitespaces)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[mcclim-cvs] CVS mcclim/Doc/Guided-Tour
by thenriksen 03 Dec '06

03 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Doc/Guided-Tour In directory clnet:/tmp/cvs-serv26347/Doc/Guided-Tour Modified Files: guided-tour.tex Log Message: Added mention of Gtkairo. --- /project/mcclim/cvsroot/mcclim/Doc/Guided-Tour/guided-tour.tex 2006/11/05 16:54:10 1.5 +++ /project/mcclim/cvsroot/mcclim/Doc/Guided-Tour/guided-tour.tex 2006/12/03 19:59:29 1.6 @@ -223,9 +223,10 @@ facilities will automatically adapt to use whatever toolkit is available on and appropriate for the host environment. In addition, portable Lisp-based implementations of the abstract gadget pane -protocols are provided.\footnote{\mcclim{} does not support look and feel - adaptiveness at the moment except for the experimental beagle backend for Mac - OS X's Cocoa platform. Hence, \mcclim{} mostly uses this portable Lisp-based +protocols are provided.\footnote{\mcclim{} does not support look and + feel adaptiveness at the moment except for the experimental beagle + backend for Mac OS X's Cocoa platform, or the Gtkairo backend using + GTK. Hence, \mcclim{} mostly uses this portable Lisp-based implementation.} \paragraph*{Application Building} \CLIM{} provides a set of tools for

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 03 Dec '06

03 Dec '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv18496 Modified Files: input-editing-drei.lisp Log Message: Stuff inserted via the presentation history should never be an accept result. --- /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2006/11/27 07:44:46 1.3 +++ /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2006/12/03 19:18:06 1.4 @@ -208,7 +208,9 @@ (multiple-value-bind (object type) (presentation-history-next history accepting-type) (when type - (presentation-replace-input stream object type (stream-default-view stream))))))) + (presentation-replace-input stream object type (stream-default-view stream) + :allow-other-keys t + :accept-result nil)))))) (defun history-yank-previous (stream input-buffer gesture numeric-argument) (declare (ignore input-buffer gesture numeric-argument)) @@ -219,7 +221,9 @@ (multiple-value-bind (object type) (presentation-history-previous history accepting-type) (when type - (presentation-replace-input stream object type (stream-default-view stream))))))) + (presentation-replace-input stream object type (stream-default-view stream) + :allow-other-keys t + :accept-result nil)))))) (add-input-editor-command '((#\n :meta)) 'history-yank-next)

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 03 Dec '06

03 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv18224 Modified Files: event.lisp Log Message: * event.lisp (gdkmodifiertype->modifier-state): Uncomment the mod2 -> super-key mapping, it has been reported to be incorrect. (key-handler): Map symbol :TAB to character #\tab. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/11/25 21:14:53 1.14 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/12/03 19:17:26 1.15 @@ -169,7 +169,7 @@ (if (logtest GDK_SHIFT_MASK state) +shift-key+ 0) (if (logtest GDK_CONTROL_MASK state) +control-key+ 0) (if (logtest GDK_MOD1_MASK state) +meta-key+ 0) - (if (logtest GDK_MOD2_MASK state) +super-key+ 0) + ;; (if (logtest GDK_MOD2_MASK state) +super-key+ 0) (if (logtest GDK_MOD3_MASK state) +hyper-key+ 0) ;;; (if (logtest GDK_MOD4_MASK state) ??? 0) ;;; (if (logtest GDK_MOD5_MASK state) ??? 0) @@ -224,6 +224,8 @@ (cond ((eq sym :backspace) (setf char #\backspace)) + ((eq sym :tab) + (setf char #\tab)) ((null char)) ((eql char #\return)) ((eql char #\escape)

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 03 Dec '06

03 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv3918 Modified Files: medium.lisp pixmap.lisp port.lisp Log Message: Set the antialising mode on /all/ cairo crs. * medium.lisp (set-antialias): New function. (sync-sheet, sync-ink, make-cairo-surface): Call set-antialias. * port.lisp ((initialize-instance :after), mirror-drawable): Call set-antialias. Fix the beams: * pixmap.lisp (%medium-copy-area): Perform clipping. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/medium.lisp 2006/11/19 15:55:11 1.12 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/medium.lisp 2006/12/03 15:24:09 1.13 @@ -74,6 +74,12 @@ (not (region-equal (last-seen-region medium) (sheet-region (medium-sheet medium))))))) +(defun set-antialias (cr) + (cairo_set_antialias cr + (if *antialiasingp* + :CAIRO_ANTIALIAS_DEFAULT + :CAIRO_ANTIALIAS_NONE))) + (defun sync-sheet (medium) (when (medium-sheet medium) ;ignore the metrik-medium (setf (gethash medium (dirty-mediums (port medium))) t)) @@ -85,7 +91,7 @@ (setf (cr medium) (gdk_cairo_create drawable)) (dispose-flipping-pixmap medium) (pushnew medium (mirror-mediums mirror)) - (cairo_set_antialias (cr medium) (if *antialiasingp* 0 1))) + (set-antialias (cr medium))) (setf (last-seen-sheet medium) (medium-sheet medium)) (setf (last-seen-region medium) (sheet-region (medium-sheet medium)))))) @@ -250,6 +256,7 @@ (setf (flipping-pixmap medium) (gdk_pixmap_new drawable width height -1))))) (setf (cr medium) (gdk_cairo_create pixmap)) + (set-antialias (cr medium)) (setf (flipping-region medium) region) (cairo_paint (cr medium)) (sync-transformation medium) @@ -938,6 +945,7 @@ (cairo_get_target (cr compatible-medium)) format width height)) (c (cairo_create s))) + (set-antialias c) (make-instance 'gtkairo-medium :cr c :surface s))) (defmacro with-pattern ((m1 mp) &body body) --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/pixmap.lisp 2006/04/17 18:40:27 1.1 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/pixmap.lisp 2006/12/03 15:24:09 1.2 @@ -44,16 +44,23 @@ (to-drawable (medium-gdkdrawable to-medium))) (cairo_surface_flush from-surface) (cairo_surface_flush to-surface) - (let ((gc (gdk_gc_new to-drawable))) - (gdk_draw_drawable to-drawable - gc - from-drawable - (truncate from-x) - (truncate from-y) - (truncate to-x) - (truncate to-y) - (truncate width) - (truncate height)) + (let ((gc (gdk_gc_new to-drawable)) + (region (medium-clipping-region to-medium))) + (unless (eq region +nowhere+) + (setf region + (region-intersection + region + (make-rectangle* to-x to-y (+ to-x width) (+ to-y height)))) + (loop for (x y w h) in (clipping-region->rect-seq region) do + (gdk_draw_drawable to-drawable + gc + from-drawable + (truncate (+ from-x x (- to-x))) + (truncate (+ from-y y (- to-y))) + (truncate x) + (truncate y) + (truncate w) + (truncate h)))) (gdk_gc_unref gc)) (cairo_surface_mark_dirty to-surface)))) --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/port.lisp 2006/11/19 17:31:20 1.11 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/port.lisp 2006/12/03 15:24:09 1.12 @@ -83,6 +83,7 @@ (gtk_init (cffi:null-pointer) (cffi:null-pointer)) (let ((cr (gdk_cairo_create (gdk_screen_get_root_window (gdk_screen_get_default))))) + (set-antialias cr) (setf (metrik-medium port) (make-instance 'metrik-medium :port port :cr cr)))) (when clim-sys:*multiprocessing-p* @@ -150,6 +151,7 @@ (height (floor (bounding-rectangle-max-y region))) (pixmap (gdk_pixmap_new window width height -1)) (cr (gdk_cairo_create pixmap))) + (set-antialias cr) (cairo_set_source_rgba cr 1.0d0 1.0d0

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 03 Dec '06

03 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv20228 Modified Files: gadgets.lisp Log Message: Fix gsharp startup crash reported by "C Y": * gadgets.lisp (realize-native-widget :around): Don't call gadget-active-p unless it's actually a gadget. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp 2006/11/26 17:54:08 1.14 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp 2006/12/03 08:09:06 1.15 @@ -587,7 +587,8 @@ (defmethod realize-native-widget :around ((gadget native-widget-mixin)) (let ((widget (call-next-method))) - (gtk_widget_set_sensitive widget (if (gadget-active-p gadget) 1 0)) + (when (typep gadget 'gadget) + (gtk_widget_set_sensitive widget (if (gadget-active-p gadget) 1 0))) widget)) (defmethod activate-gadget :after ((gadget native-widget-mixin))

1 0

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

02 Dec '06

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv7322 Modified Files: lisp-syntax.lisp Log Message: Improved and fixed some `token-to-object' methods. Soon, Drei will be able to compile itself! --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2006/11/27 12:28:01 1.7 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2006/12/02 20:28:18 1.8 @@ -1709,6 +1709,8 @@ (define-form-predicate form-token-p (token-mixin)) (define-form-predicate form-string-p (string-form)) (define-form-predicate form-quoted-p (quote-form backquote-form)) +(define-form-predicate form-comma-p (comma-form)) +(define-form-predicate form-comma-at-p (comma-at-form)) (define-form-predicate comment-p (comment)) @@ -2563,7 +2565,13 @@ (defmethod token-to-object (syntax (token backquote-form) &rest args) (let ((backquoted-form (first-form (children token)))) (if (form-list-p backquoted-form) - `'(,@(apply #'token-to-object syntax backquoted-form args)) + `(list ,@(loop for element in (children backquoted-form) + if (form-comma-p element) + collect (apply #'token-to-object syntax element args) + else if (form-comma-at-p element) + nconc (apply #'token-to-object syntax element args) + else if (formp element) + collect (apply #'token-to-object syntax element :quote t args))) `',(apply #'token-to-object syntax backquoted-form args)))) (defmethod token-to-object (syntax (token comma-form) &rest args) @@ -2634,7 +2642,7 @@ ""))))) (defmethod token-to-object ((syntax lisp-syntax) (token complete-function-form) &rest args &key &allow-other-keys) - (fdefinition (apply #'token-to-object syntax (second (children token)) args))) + (list 'function (apply #'token-to-object syntax (second (children token)) args))) (defmethod token-to-object ((syntax lisp-syntax) (token bit-vector-form) &key &allow-other-keys)

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 2006