mcclim-cvs September 2007

mcclim-cvs@common-lisp.net

5 participants
29 discussions

[mcclim-cvs] CVS mcclim/ESA
by thenriksen 30 Sep '07

30 Sep '07

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv23970/ESA Modified Files: esa.lisp Log Message: Removed MACRORECORD-PROCESSED-GESTURES-MIXIN from ASYNCHRONOUS-COMMAND-PROCESSOR superclass list, as Jack Unrue pointed out. --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/09/29 13:27:26 1.9 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/09/30 22:03:54 1.10 @@ -468,8 +468,7 @@ finally (setf (executingp drei) nil))) (defclass asynchronous-command-processor (command-processor - instant-macro-execution-mixin - macrorecord-processed-gestures-mixin) + instant-macro-execution-mixin) () (:documentation "Helper class that provides behavior necessary for a command processor that expects to receive gestures through

1 0

[mcclim-cvs] CVS mcclim
by junrue 30 Sep '07

30 Sep '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv12957 Modified Files: mcclim.asd Log Message: define new class graphic-forms-pixmap; separate a few pixmap-related methods from medium.lisp to the new pixmap.lisp --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/09/02 18:55:28 1.60 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/09/30 21:12:50 1.61 @@ -422,6 +422,7 @@ (:file "graft" :depends-on ("package")) (:file "port" :depends-on ("utils" "graft")) (:file "medium" :depends-on ("port")) + (:file "pixmap" :depends-on ("medium")) (:file "frame-manager" :depends-on ("medium")) (:file "gadgets" :depends-on ("port"))))))

1 0

[mcclim-cvs] CVS mcclim/Backends/Graphic-Forms
by junrue 30 Sep '07

30 Sep '07

Update of /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms In directory clnet:/tmp/cvs-serv12957/Backends/Graphic-Forms Modified Files: medium.lisp Added Files: pixmap.lisp Log Message: define new class graphic-forms-pixmap; separate a few pixmap-related methods from medium.lisp to the new pixmap.lisp --- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/medium.lisp 2007/09/09 03:47:08 1.8 +++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/medium.lisp 2007/09/30 21:12:50 1.9 @@ -1,6 +1,6 @@ ;; -*- Mode: Lisp; Package: CLIM-GRAPHIC-FORMS -*- -;;; (c) 2006 Jack D. Unrue (jdunrue (at) gmail (dot) com) +;;; (c) 2006-2007 Jack D. Unrue (jdunrue (at) gmail (dot) com) ;;; based on the null backend by: ;;; (c) 2005 Christophe Rhodes (c.rhodes(a)gold.ac.uk) @@ -55,6 +55,8 @@ (defun ink-to-color (medium ink) (cond + ((subtypep (class-of ink) (find-class 'climi::opacity)) + (setf ink (medium-foreground medium))) ; see discussion of opacity in design.lisp ((eql ink +foreground-ink+) (setf ink (medium-foreground medium))) ((eql ink +background-ink+) @@ -184,30 +186,6 @@ (defmethod (setf medium-line-style) :before (line-style (medium graphic-forms-medium)) ()) -(defmethod medium-copy-area ((from-drawable graphic-forms-medium) - from-x from-y width height - (to-drawable graphic-forms-medium) - to-x to-y) - nil) - -#+nil ; FIXME: PIXMAP class -(progn - (defmethod medium-copy-area ((from-drawable graphic-forms-medium) - from-x from-y width height - (to-drawable pixmap) - to-x to-y) - nil) - (defmethod medium-copy-area ((from-drawable pixmap) - from-x from-y width height - (to-drawable graphic-forms-medium) - to-x to-y) - ()) - (defmethod medium-copy-area ((from-drawable pixmap) - from-x from-y width height - (to-drawable pixmap) - to-x to-y) - ())) - (defmethod medium-draw-point* ((medium graphic-forms-medium) x y) (when (target-of medium) (gfw:with-graphics-context (gc (target-of medium)) --- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/pixmap.lisp 2007/09/30 21:12:50 NONE +++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/pixmap.lisp 2007/09/30 21:12:50 1.1 ;;; -*- Mode: Lisp; Package: CLIM-GRAPHIC-FORMS; -*- ;;; (c) 2007 Jack D. Unrue (jdunrue (at) gmail (dot) com) ;;; based on the null backend by: ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. (in-package :clim-graphic-forms) (defclass graphic-forms-pixmap (climi::mirrored-pixmap) ()) (defmethod medium-copy-area ((from-drawable graphic-forms-medium) from-x from-y width height (to-drawable graphic-forms-medium) to-x to-y) ()) (defmethod medium-copy-area ((from-drawable graphic-forms-medium) from-x from-y width height (to-drawable graphic-forms-pixmap) to-x to-y) ()) (defmethod medium-copy-area ((from-drawable graphic-forms-pixmap) from-x from-y width height (to-drawable graphic-forms-medium) to-x to-y) ()) (defmethod medium-copy-area ((from-drawable graphic-forms-pixmap) from-x from-y width height (to-drawable graphic-forms-pixmap) to-x to-y) ())

1 0

[mcclim-cvs] CVS mcclim/Backends/Graphic-Forms
by junrue 30 Sep '07

30 Sep '07

Update of /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms In directory clnet:/tmp/cvs-serv12530 Modified Files: gadgets.lisp Log Message: fix errant initialization of menu divider label --- /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/gadgets.lisp 2007/09/02 19:00:58 1.4 +++ /project/mcclim/cvsroot/mcclim/Backends/Graphic-Forms/gadgets.lisp 2007/09/30 21:05:51 1.5 @@ -54,7 +54,8 @@ (if (eql (command-menu-item-type thing) :command) (setf (gadget-label sub-pane) (climi::command-menu-item-name thing) (item sub-pane) thing) - (setf (label sub-pane) (climi::command-menu-item-name thing))) + (if (climi::command-menu-item-name thing) + (setf (label sub-pane) (climi::command-menu-item-name thing)))) (setf (sheet-parent sub-pane) menu-pane) (realize-mirror port sub-pane)))))) (dolist (menu-item (contents menu-pane))

1 0

[mcclim-cvs] CVS mcclim
by crhodes 29 Sep '07

29 Sep '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv12842 Modified Files: NEWS Log Message: Fix a couple of bugs in ESA help commands relating to command tables and keystroke lookup. --- /project/mcclim/cvsroot/mcclim/NEWS 2007/09/02 18:50:31 1.25 +++ /project/mcclim/cvsroot/mcclim/NEWS 2007/09/29 13:27:26 1.26 @@ -1,3 +1,7 @@ +* Changes in mcclim-0.9.6 relative to 0.9.5: +** Bug fix: ESA's help commands are better at finding bindings and + describing them + * Changes in mcclim-0.9.5 relative to 0.9.4: ** Installation: the systems clim-listener, clim-examples, and clouseau can now be loaded without loading the system mcclim

1 0

[mcclim-cvs] CVS mcclim/ESA
by crhodes 29 Sep '07

29 Sep '07

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv12842/ESA Modified Files: esa.lisp Log Message: Fix a couple of bugs in ESA help commands relating to command tables and keystroke lookup. --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/09/27 11:03:21 1.8 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/09/29 13:27:26 1.9 @@ -1062,8 +1062,8 @@ when (eq (command-menu-item-type item) :command) do (return (values (command-menu-item-value item) gestures))))) -(defun describe-key-briefly (pane) - (let ((command-table (command-table pane))) +(defun describe-key-briefly (frame) + (let ((command-table (find-applicable-command-table frame))) (multiple-value-bind (command gestures) (read-gestures-for-help command-table) (when (consp command) @@ -1116,8 +1116,10 @@ #'(lambda (menu-name keystroke item) (declare (ignore menu-name)) (cond ((and (eq (command-menu-item-type item) :command) - (listp (command-menu-item-value item)) - (eq (car (command-menu-item-value item)) command)) + (or (and (symbolp (command-menu-item-value item)) + (eq (command-menu-item-value item) command)) + (and (listp (command-menu-item-value item)) + (eq (car (command-menu-item-value item)) command)))) (push (cons keystroke prefix) keystrokes)) ((eq (command-menu-item-type item) :menu) (helper command (command-menu-item-value item) (cons keystroke prefix))) @@ -1352,13 +1354,13 @@ "Prompt for a key and show the command it invokes." (display-message "Describe key briefly:") (redisplay-frame-panes *application-frame*) - (describe-key-briefly (car (windows *application-frame*)))) + (describe-key-briefly *application-frame*)) (set-key 'com-describe-key-briefly 'help-table '((#\h :control) (#\c))) (define-command (com-where-is :name t :command-table help-table) () "Prompt for a command name and show the key that invokes it." - (let* ((command-table (command-table (car (windows *application-frame*)))) + (let* ((command-table (find-applicable-command-table *application-frame*)) (command (handler-case (accept @@ -1383,7 +1385,7 @@ "Show which keys invoke which commands. Without a numeric prefix, sorts the list by command name. With a numeric prefix, sorts by key." (let ((stream (help-stream *application-frame* (format nil "Help: Describe Bindings"))) - (command-table (find-applicable-command-table *application-frame*))) + (command-table (find-applicable-command-table *application-frame*))) (describe-bindings stream command-table (if sort-by-keystrokes #'sort-by-keystrokes

1 0

[mcclim-cvs] CVS mcclim/ESA
by thenriksen 27 Sep '07

27 Sep '07

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv31967 Modified Files: esa.lisp Log Message: Make C-g (and abort gestures in general) behave properly when they are part of a long gesture chain. --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/05/23 14:41:48 1.7 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/09/27 11:03:21 1.8 @@ -467,19 +467,6 @@ do (process-gesture drei gesture) finally (setf (executingp drei) nil))) -(defclass macrorecord-processed-gestures-mixin () - () - (:documentation "Subclasses of this class will perform gesture -recording for macro recording when the gesture is being -processed. This is important when gesture reading does not go -through `esa-read-gesture', for example when the command -processor is being in an event-handling context.")) - -(defmethod process-gesture :before ((command-processor macrorecord-processed-gestures-mixin) gesture) - (when (and (recordingp command-processor) - (directly-processing-p command-processor)) - (push gesture (recorded-keys command-processor)))) - (defclass asynchronous-command-processor (command-processor instant-macro-execution-mixin macrorecord-processed-gestures-mixin) @@ -491,8 +478,9 @@ (defmethod process-gesture :before ((command-processor asynchronous-command-processor) gesture) (when (and (find gesture *abort-gestures* - :test #'gesture-matches-gesture-name-p) + :test #'gesture-matches-gesture-name-p) (directly-processing-p command-processor)) + (setf (accumulated-gestures command-processor) nil) (signal 'abort-gesture :event gesture))) (defclass command-loop-command-processor (command-processor) @@ -632,7 +620,16 @@ (defun substitute-numeric-argument-p (command numargp) (substitute numargp *numeric-argument-p* command :test #'eq)) -(defgeneric process-gestures (command-processor)) +(defgeneric process-gestures (command-processor) + (:documentation "Process the gestures accumulated in +`command-processor', returning T if there are no gestures +accumulated or the accumulated gestures correspond to a +command. In this case, the command will also be executed and the +list of accumulated gestures set to NIL. Will return NIL if the +accumulated gestures do not yet correspond to a command, but +eventually could, if more gestures are provided. Signals +`unbound-gesture-sequence' if the accumulated gestures could +never refer to a command.")) (defmethod process-gestures ((command-processor command-processor)) (multiple-value-bind (prefix-arg prefix-p gestures) @@ -660,7 +657,13 @@ *partial-command-parser* (command-table command-processor) *standard-input* command 0))) - (setf (accumulated-gestures command-processor) nil)) + ;; If we are macrorecording, store whatever the user + ;; did to invoke this command. + (when (recordingp command-processor) + (setf (recorded-keys command-processor) + (append (accumulated-gestures command-processor) + (recorded-keys command-processor)))) + (setf (accumulated-gestures command-processor) nil)) (funcall (command-executor command-processor) command-processor command) nil)) (t t))))))) @@ -686,14 +689,15 @@ (loop for gesture = (read-gesture :stream stream) until (proper-gesture-p gesture) - finally (progn (when (recordingp command-processor) - (push gesture (recorded-keys command-processor))) - (return gesture)))) + finally (return gesture))) (defun esa-unread-gesture (gesture &key (command-processor *command-processor*) (stream *standard-input*)) (cond ((recordingp command-processor) - (pop (recorded-keys command-processor)) + (cond ((equal (first (recorded-keys command-processor)) gesture) + (pop (recorded-keys command-processor))) + ((equal (first (accumulated-gestures command-processor)) gesture) + (pop (accumulated-gestures command-processor)))) (unread-gesture gesture :stream stream)) ((executingp command-processor) (push gesture (remaining-keys command-processor))) @@ -735,6 +739,14 @@ (funcall (command-executor command-processor) command-processor command))))) +(defmethod process-gestures-or-command :around ((command-processor command-processor)) + (handler-case (call-next-method) + (abort-gesture (c) + ;; If the user aborts, we want to forget whatever previous + ;; gestures he entered since the last command execution. + (setf (accumulated-gestures command-processor) nil) + (signal c)))) + (defmethod process-gestures-or-command ((command-processor command-processor)) ;; Build up a list of gestures and repeatedly pass them to ;; `process-gestures'. This "clumsy" approach is chosen because we @@ -743,7 +755,8 @@ ;; rescanning of accumulated input data or some yet-unimplemented ;; complex state retaining mechanism (such as continuations). (loop - (setf *current-gesture* (esa-read-gesture :command-processor command-processor)) + (setf *current-gesture* + (esa-read-gesture :command-processor command-processor)) (unless (process-gesture command-processor *current-gesture*) (return))))

1 0

[mcclim-cvs] CVS mcclim
by crhodes 17 Sep '07

17 Sep '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv11144 Modified Files: builtin-commands.lisp Log Message: Remove strange sbcl-only reader-package-error handling. --- /project/mcclim/cvsroot/mcclim/builtin-commands.lisp 2007/01/10 11:19:01 1.26 +++ /project/mcclim/cvsroot/mcclim/builtin-commands.lisp 2007/09/17 19:21:19 1.27 @@ -377,10 +377,6 @@ *eof-error-p* *eof-value* *recursivep*) - #+sbcl(sb-kernel:reader-package-error (e) - (progn - ;; Resignal the error. - (error e))) ((and reader-error) (e) (declare (ignore e)) nil))

1 0

[mcclim-cvs] CVS mcclim
by crhodes 17 Sep '07

17 Sep '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv11084 Modified Files: graph-formatting.lisp Log Message: Only one version of format-graph-from-roots, please --- /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2007/09/16 22:39:22 1.21 +++ /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2007/09/17 19:20:49 1.22 @@ -3,7 +3,7 @@ ;;; Title: Graph Formatting ;;; Created: 2002-08-13 ;;; License: LGPL (See file COPYING for details). -;;; $Id: graph-formatting.lisp,v 1.21 2007/09/16 22:39:22 rgoldman Exp $ +;;; $Id: graph-formatting.lisp,v 1.22 2007/09/17 19:20:49 crhodes Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2002 by Gilbert Baumann @@ -190,9 +190,6 @@ (bounding-rectangle-max-y graph-output-record)))) graph-output-record)))) -(defun format-graph-from-root (root &rest rest) - (apply #'format-graph-from-roots (list root) rest)) - ;;;; Graph Output Records (defclass standard-graph-output-record (graph-output-record

1 0

[mcclim-cvs] CVS mcclim
by rgoldman 16 Sep '07

16 Sep '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv19555 Modified Files: graph-formatting.lisp Log Message: Removed destructive modification of format-graph-from-roots &rest argument. --- /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2007/03/04 22:26:22 1.20 +++ /project/mcclim/cvsroot/mcclim/graph-formatting.lisp 2007/09/16 22:39:22 1.21 @@ -3,7 +3,7 @@ ;;; Title: Graph Formatting ;;; Created: 2002-08-13 ;;; License: LGPL (See file COPYING for details). -;;; $Id: graph-formatting.lisp,v 1.20 2007/03/04 22:26:22 ahefner Exp $ +;;; $Id: graph-formatting.lisp,v 1.21 2007/09/16 22:39:22 rgoldman Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2002 by Gilbert Baumann @@ -115,9 +115,11 @@ (define-graph-type :digraph digraph-graph-output-record) ;;;; Entry +(defun format-graph-from-root (root-object &rest other-args) + (apply #'format-graph-from-roots (list root-object) other-args)) (defun format-graph-from-roots (root-objects object-printer inferior-producer - &rest graph-options + &rest rest-args &key stream orientation cutoff-depth merge-duplicates duplicate-key duplicate-test generation-separation @@ -128,63 +130,65 @@ graph-type (move-cursor t) &allow-other-keys) (declare (ignore orientation generation-separation within-generation-separation center-nodes)) - ;; Mungle some arguments - (check-type cutoff-depth (or null integer)) - (check-type root-objects sequence) - (setf stream (or stream *standard-output*) - graph-type (or graph-type (if merge-duplicates :digraph :tree)) - duplicate-key (or duplicate-key #'identity) - duplicate-test (or duplicate-test #'eql) ) - - ;; I'm not sure what to do here. Saying you want a tree, but want - ;; duplicates merged seems wrong. OTOH, if you go out of your way - ;; to do it, at your own risk, is it our place to say "no"? + ;; don't destructively modify the &rest arg + (let ((graph-options (copy-list rest-args))) + ;; Munge some arguments + (check-type cutoff-depth (or null integer)) + (check-type root-objects sequence) + (setf stream (or stream *standard-output*) + graph-type (or graph-type (if merge-duplicates :digraph :tree)) + duplicate-key (or duplicate-key #'identity) + duplicate-test (or duplicate-test #'eql) ) + + ;; I'm not sure what to do here. Saying you want a tree, but want + ;; duplicates merged seems wrong. OTOH, if you go out of your way + ;; to do it, at your own risk, is it our place to say "no"? ;; [2005/08/11:rpg] ;;; (when (and (eq graph-type :tree) merge-duplicates) ;;; (cerror "Substitute NIL for merge-duplicates" ;;; "Merge duplicates specified to be true when using :tree layout.") ;;; (setf merge-duplicates nil)) - ;; clean the options - (remf graph-options :stream) - (remf graph-options :duplicate-key) - (remf graph-options :duplicate-test) - (remf graph-options :arc-drawer) - (remf graph-options :arc-drawing-options) - (remf graph-options :graph-type) - (remf graph-options :move-cursor) + ;; clean the options + (remf graph-options :stream) + (remf graph-options :duplicate-key) + (remf graph-options :duplicate-test) + (remf graph-options :arc-drawer) + (remf graph-options :arc-drawing-options) + (remf graph-options :graph-type) + (remf graph-options :move-cursor) - (multiple-value-bind (cursor-old-x cursor-old-y) - (stream-cursor-position stream) - (let ((graph-output-record - (labels ((cont (stream graph-output-record) - (with-output-recording-options (stream :draw nil :record t) - (generate-graph-nodes graph-output-record stream root-objects - object-printer inferior-producer - :duplicate-key duplicate-key - :duplicate-test duplicate-test) - (layout-graph-nodes graph-output-record stream arc-drawer arc-drawing-options) - (layout-graph-edges graph-output-record stream arc-drawer arc-drawing-options)) )) - (apply #'invoke-with-new-output-record stream - #'cont - (find-graph-type graph-type) - nil - ;; moved to local variable... [2005/07/25:rpg] - ;; :hash-table (make-hash-table :test duplicate-test) - graph-options - )))) - (setf (output-record-position graph-output-record) - (values cursor-old-x cursor-old-y)) - (when (and (stream-drawing-p stream) - (output-record-ancestor-p (stream-output-history stream) - graph-output-record)) - (with-output-recording-options (stream :draw t :record nil) - (replay graph-output-record stream))) - (when move-cursor - (setf (stream-cursor-position stream) - (values (bounding-rectangle-max-x graph-output-record) - (bounding-rectangle-max-y graph-output-record)))) - graph-output-record))) + (multiple-value-bind (cursor-old-x cursor-old-y) + (stream-cursor-position stream) + (let ((graph-output-record + (labels ((cont (stream graph-output-record) + (with-output-recording-options (stream :draw nil :record t) + (generate-graph-nodes graph-output-record stream root-objects + object-printer inferior-producer + :duplicate-key duplicate-key + :duplicate-test duplicate-test) + (layout-graph-nodes graph-output-record stream arc-drawer arc-drawing-options) + (layout-graph-edges graph-output-record stream arc-drawer arc-drawing-options)) )) + (apply #'invoke-with-new-output-record stream + #'cont + (find-graph-type graph-type) + nil + ;; moved to local variable... [2005/07/25:rpg] + ;; :hash-table (make-hash-table :test duplicate-test) + graph-options + )))) + (setf (output-record-position graph-output-record) + (values cursor-old-x cursor-old-y)) + (when (and (stream-drawing-p stream) + (output-record-ancestor-p (stream-output-history stream) + graph-output-record)) + (with-output-recording-options (stream :draw t :record nil) + (replay graph-output-record stream))) + (when move-cursor + (setf (stream-cursor-position stream) + (values (bounding-rectangle-max-x graph-output-record) + (bounding-rectangle-max-y graph-output-record)))) + graph-output-record)))) (defun format-graph-from-root (root &rest rest) (apply #'format-graph-from-roots (list root) rest)) @@ -248,7 +252,7 @@ (object :initarg :object :reader graph-node-object) - ;; internal slots for the graph layout algorithmn + ;; internal slots for the graph layout algorithm (minor-size :initform nil :accessor graph-node-minor-size

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 September 2007