- mcclim-devel - mailman3.common-lisp.net

[mcclim-devel] McCLIM, clisp and minor bug fixes on Win32.
by Philippe Brochard 20 May '06

20 May '06

Hi everybody, First of all, many thanks for your great work! I don't know if this has already been reported and as I read wrongs things about it, I just want to say that McCLIM works perfectly with CLisp [1] under Windows XP (at least) and Xming [2]. I just have to patch Goatee/goatee-command.lisp to have a working Delete key. (patch attached on this mail). Here is what I've done: 1) Install CLisp and Xming. 2) Set the display (in a terminal) $ set display=localhost:0.0 3) Compile clx (I got the source in the clisp source): CLISP> (load "/clisp/source/clx/mit-clx/defsystem.lisp") CLISP> (without-package-lock () (compile-clx)) CLISP> (without-package-lock () (load-clx)) ; not necessarily useful 4) Get a copy of McCLIM and spatial-trees CLISP> (load "mcclim/spatial-trees/spatial-trees.asd") CLISP> (load "mcclim/mcclim.asd") CLISP> (without-package-lock () (asdf:oos 'asdf:load-op :mcclim)) 5) Build the listener CLISP> (asdf:oos 'asdf:load-op :clim-listener) 6) And build a demo CLISP> (load (compile-file "mcclim/Examples/clim-fig.lisp")) CLISP> (clim-demo::clim-fig) and here is the result : http://hocwp.free.fr/temp/clim-fig.png I've also been able to build my main app (cl-wav-synth) and it works like a charm :) http://hocwp.free.fr/temp/cl-wav-synth-win.png http://hocwp.free.fr/temp/cl-wav-synth-win-2.png Hope that can help. Best regards, Philippe [1] http://clisp.cons.org [2] http://freedesktop.org/wiki/Xming -- Philippe Brochard <hocwp(a)free.fr> http://hocwp.free.fr -=-= http://www.gnu.org/home.fr.html =-=- 291c291,293 < (add-gesture-command-to-table '(#-openmcl #\Delete #+openmcl #\DEL) --- > (add-gesture-command-to-table '(#-(or openmcl (and clisp win32)) #\Delete > #+openmcl #\DEL > #+(and clisp win32) #\Rubout) 339c341,343 < (add-gesture-command-to-table '(#\delete :meta) --- > > (add-gesture-command-to-table '(#-(and clisp win32) #\delete > #+(and clisp win32) #\rubout :meta) 342c346,348 < (add-gesture-command-to-table '(#\delete :control) --- > > (add-gesture-command-to-table '(#-(and clisp win32) #\delete > #+(and clisp win32) #\rubout :control)

1 0

[mcclim-devel] error in transform-region
by Irene DURAND 18 May '06

18 May '06

Hello, I had not updated my mcclim since April 7. I did it today and my software Autowrite doesn't execute anymore. The stack is as below. Has anyone any idea of what can be wrong? Thanks, Irène ---------------------------------------------------------------------------------------------------------------------------------------- The value NIL is not of type (SIMPLE-ARRAY REAL (4)). [Condition of type TYPE-ERROR] Restarts: 0: [ABORT-REQUEST] Abort handling SLIME request. 1: [TERMINATE-THREAD] Terminate this thread (#<THREAD "repl-thread" {B3F9909}>) Backtrace: 0: ((SB-PCL::FAST-METHOD TRANSFORM-REGION (T STANDARD-RECTANGLE)) (#(NIL 0) . #()) #<unavailable argument> #<CLIM-INTERNALS::STANDARD-TRANSLATION 1 0 0 1 0 250> (#<STANDARD-BOUNDING-RECTANGLE X 0:634 Y 0:150 {BA8A089}>)) 1: (CLIM-INTERNALS::UPDATE-MIRROR-GEOMETRY #<HRACK-PANE "(Unnamed Pane)" {C394211}>) 2: ((LAMBDA (SB-PCL::.PV-CELL. SB-PCL::.NEXT-METHOD-CALL. SB-PCL::.ARG0. SB-PCL::.ARG1.)) #<unavailable argument> #<unavailable argument> #<STANDARD-BOUNDING-RECTANGLE X 0:634 Y 0:150 {BA8A089}> #<HRACK-PANE "(Unnamed Pane)" {C394211}>) 3: ((SB-PCL::FAST-METHOD ALLOCATE-SPACE :AROUND (CLIM-INTERNALS::LAYOUT-PROTOCOL-MIXIN T T)) #<unavailable argument> #S(SB-PCL::FAST-METHOD-CALL :FUNCTION #<FUNCTION (SB-PCL::FAST-METHOD ALLOCATE-SPACE #)> :PV-CELL NIL :NEXT-METHOD-CALL #S(SB-PCL::FAST-METHOD-CALL :FUNCTION #<FUNCTION #> :PV-CELL NIL :NEXT-METHOD-CALL NIL :ARG-INFO (3)) :ARG-INFO (3)) #<HRACK-PANE "(Unnamed Pane)" {C394211}> 634 150) 4: ((SB-PCL::FAST-METHOD CLIM-INTERNALS::BOX-LAYOUT-MIXIN/VERTICALLY-ALLOCATE-SPACE (CLIM-INTERNALS::RACK-LAYOUT-MIXIN T T)) (#(NIL 32) . #()) #<unavailable argument> #<VRACK-PANE "(Unnamed Pane)" {C2F1521}> 634 550) 5: ((SB-PCL::FAST-METHOD CLIM-INTERNALS::BOX-LAYOUT-MIXIN/HORIZONTALLY-ALLOCATE-SPACE (CLIM-INTERNALS::RACK-LAYOUT-MIXIN T T)) (#(NIL 31) . #()) #<unavailable argument> #<HRACK-PANE "(Unnamed Pane)" {C2F1789}> 634 550) 6: ((SB-PCL::FAST-METHOD CLIM-INTERNALS::BOX-LAYOUT-MIXIN/VERTICALLY-ALLOCATE-SPACE (CLIM-INTERNALS::RACK-LAYOUT-MIXIN T T)) (#(NIL 32) . #()) #<unavailable argument> #<VRACK-PANE "(Unnamed Pane)" {C0CE1D1}> 634 550) 7: ((SB-PCL::FAST-METHOD CLIM-INTERNALS::BOX-LAYOUT-MIXIN/HORIZONTALLY-ALLOCATE-SPACE (CLIM-INTERNALS::RACK-LAYOUT-MIXIN T T)) (#(NIL 31) . #()) #<unavailable argument> #<HRACK-PANE "(Unnamed Pane)" {C2F1779}> 1071 550) 8: ((SB-PCL::FAST-METHOD CLIM-INTERNALS::BOX-LAYOUT-MIXIN/VERTICALLY-ALLOCATE-SPACE (CLIM-INTERNALS::RACK-LAYOUT-MIXIN T T)) (#(NIL 32) . #()) #<unavailable argument> #<VRACK-PANE "(Unnamed Pane)" {C2F1239}> 1071 602) 9: ((SB-PCL::FAST-METHOD CLIM-INTERNALS::BOX-LAYOUT-MIXIN/VERTICALLY-ALLOCATE-SPACE (CLIM-INTERNALS::RACK-LAYOUT-MIXIN T T)) (#(NIL 32) . #()) #<unavailable argument> #<VRACK-PANE "(Unnamed Pane)" {C0EA699}> 1071 606) 10: ((LAMBDA (SB-PCL::.PV-CELL. SB-PCL::.NEXT-METHOD-CALL. SB-PCL::.ARG0. SB-PCL::.ARG1. SB-PCL::.ARG2.)) #<unavailable argument> #<unavailable argument> #<CLIM-INTERNALS::TOP-LEVEL-SHEET-PANE CLIM-INTERNALS::TOP-LEVEL-SHEET {B713969}> 1071 606) 11: ((LAMBDA (SB-PCL::.PV-CELL. SB-PCL::.NEXT-METHOD-CALL. SB-PCL::.ARG0. SB-PCL::.ARG1.)) #<unavailable argument> #<unavailable argument> #<CLIM-CLX::CLX-FRAME-MANAGER {C14CF61}> #<VISU-AW {BCDDE09}>) 12: ((SB-PCL::FAST-METHOD ADOPT-FRAME (FRAME-MANAGER APPLICATION-FRAME)) (#(NIL 1 13 11) . #()) #<unavailable argument> #<CLIM-CLX::CLX-FRAME-MANAGER {C14CF61}> #<VISU-AW {BCDDE09}>) 13: ((LAMBDA (SB-PCL::.PV-CELL. SB-PCL::.NEXT-METHOD-CALL. SB-PCL::.ARG0. SB-PCL::.ARG1.)) #<unavailable argument> #<unavailable argument> #<CLIM-CLX::CLX-FRAME-MANAGER {C14CF61}> #<VISU-AW {BCDDE09}>) 14: ((SB-PCL::FAST-METHOD RUN-FRAME-TOP-LEVEL :AROUND (APPLICATION-FRAME)) #<unavailable argument> #S(SB-PCL::FAST-METHOD-CALL :FUNCTION #<FUNCTION (SB-PCL::FAST-METHOD RUN-FRAME-TOP-LEVEL #)> :PV-CELL NIL :NEXT-METHOD-CALL NIL :ARG-INFO (1 . T)) #<VISU-AW {BCDDE09}> NIL) 15: (INTERFACE) 16: (SB-INT:EVAL-IN-LEXENV (START) #<NULL-LEXENV>) 17: (SWANK::EVAL-REGION "(start) " T) 18: ((LAMBDA NIL)) 19: ((SB-PCL::FAST-METHOD SWANK-BACKEND:CALL-WITH-SYNTAX-HOOKS (T)) #<unused argument> #<unused argument> #<CLOSURE (LAMBDA NIL) {B846B9D}>) 20: (SWANK::CALL-WITH-BUFFER-SYNTAX #<CLOSURE (LAMBDA NIL) {B846B9D}>) 21: (SB-INT:EVAL-IN-LEXENV (SWANK:LISTENER-EVAL "(start) ") #<NULL-LEXENV>) 22: ((LAMBDA NIL)) 23: ((SB-PCL::FAST-METHOD SWANK-BACKEND:CALL-WITH-DEBUGGER-HOOK (T T)) #<unused argument> #<unused argument> #<FUNCTION SWANK:SWANK-DEBUGGER-HOOK> #<CLOSURE (LAMBDA NIL) {B846395}>) 24: ((LAMBDA NIL)) 25: ((SB-PCL::FAST-METHOD SWANK-BACKEND:CALL-WITH-DEBUGGER-HOOK (T T)) #<unused argument> #<unused argument> #<FUNCTION SWANK:SWANK-DEBUGGER-HOOK> #<FUNCTION (LAMBDA NIL) {AC8E40D}>) 26: (SWANK::CALL-WITH-REDIRECTED-IO #<SWANK::CONNECTION {B2759C9}> #<CLOSURE (LAMBDA NIL) {B846245}>) 27: (SWANK::CALL-WITH-CONNECTION #<SWANK::CONNECTION {B2759C9}> #<FUNCTION (LAMBDA NIL) {AC8E40D}>) 28: (SWANK::HANDLE-REQUEST #<SWANK::CONNECTION {B2759C9}>) 29: ((LAMBDA NIL)) 30: ((LAMBDA NIL)) 31: ((SB-PCL::FAST-METHOD SWANK-BACKEND:CALL-WITH-DEBUGGER-HOOK (T T)) #<unused argument> #<unused argument> #<FUNCTION SWANK:SWANK-DEBUGGER-HOOK> #<CLOSURE (LAMBDA NIL) {B40C0B5}>) 32: (SWANK::CALL-WITH-REDIRECTED-IO #<SWANK::CONNECTION {B2759C9}> #<CLOSURE (LAMBDA NIL) {B40C0C5}>) 33: (SWANK::CALL-WITH-CONNECTION #<SWANK::CONNECTION {B2759C9}> #<CLOSURE (LAMBDA NIL) {B40C0B5}>) 34: (SWANK::CALL-WITH-BINDINGS NIL #<CLOSURE (LAMBDA NIL) {B40C095}>) 35: ((LAMBDA NIL)) 36: ("foreign function: call_into_lisp") 37: ("foreign function: funcall0") 38: ("foreign function: new_thread_trampoline") 39: ("foreign function: #x53EB80") -- Irène DURAND http://dept-info.labri.u-bordeaux.fr/~idurand

1 0

[mcclim-devel] trivial patch to OpenMCL support
by Eric Marsden 13 May '06

13 May '06

Hi, The following trivial patch is required for recent versions of OpenMCL, that have dropped the :mcl *feature*. Index: package.lisp =================================================================== RCS file: /project/mcclim/cvsroot/mcclim/package.lisp,v retrieving revision 1.54 diff -u -r1.54 package.lisp --- package.lisp 30 Mar 2006 12:07:59 -0000 1.54 +++ package.lisp 13 May 2006 14:23:46 -0000 @@ -220,7 +220,7 @@ `(#+clisp ,@'(:gray) #+cmu ,@'(:ext) #+scl ,@'(:ext) - #+mcl ,@'(:ccl) + #+(or mcl openmcl) ,@'(:ccl) #+allegro ,@'(:common-lisp :excl :stream) #+harlequin-common-lisp ,@'(:stream) #+sbcl ,@'(:sb-gray))) ) -- Eric Marsden

1 0

[mcclim-devel] trac? (other plans?)
by Christophe Rhodes 12 May '06

12 May '06

Hi, Common-lisp.net relatively newly supports trac. Should we take advantage of it for a bug tracker? I suppose we should listen to Paolo in particular, who has heroically been wrestling with his bug list on McCLiki -- Paolo, do you think trac would make that part of it easier? Also, I've heard (and encouraged) mutterings from our intrepid Release Manager about a Pentecost Sunday McCLIM release (that's June 4th this year). Does anyone have half-baked work that they'd like to integrate? (Not that we would necessarily need to to have a nice set of release notes: an even partly-working gtk backend might encourage some interest...) Cheers, Christophe

2 1

[mcclim-devel] scrollbars and :command-loop
by Christophe Rhodes 12 May '06

12 May '06

Hi, I have an application pane with :display-time :command-loop, inside a (scrolling ...) form. For the most part, in this application, it is likely that the contents of this pane after a redisplay are similar to those before: so, I would like to be able to preserve the viewport position across redisplays. I've come up with the following method on redisplay-frame-pane: (defmethod redisplay-frame-pane :around ((frame gsharp) (pane gsharp-pane) &key force-p) (declare (ignore force-p)) (let ((transformation (sheet-transformation pane))) (multiple-value-bind (x y) (window-viewport-position pane) (multiple-value-bind (x1 y1) (untransform-position transformation x y) (call-next-method) (setf (window-viewport-position pane) (values x1 y1)))))) which meets the spec, I suppose -- I don't know how well-defined it is, but it does what I wanted it to in McCLIM. However, it leads to visual artifacts: the call-next-method here eventually calls (window-clear), which resets the space-requirements and the transformation of the sheet, which means the scrollbars change size; then the whole of the redraw takes place, and only then does the viewport's position get reset. My question then is twofold. Firstly, is this a sensible thing to be doing at all, or is there some other mechanism for achieving what I want here? (Incremental redisplay might be it, but that has some other problems in this application). Secondly, is there a way of eliminating these glitches? Cheers, Christophe

2 2

[mcclim-devel] trivial sbcl/osx gtkairo patch
by Cyrus Harmon 07 May '06

07 May '06

The following patch allows me to at least launch climacs w/ gtkairo. It doesn't quite work as the Escape key maps to { instead of Escape for some reason, but it looks pretty. Oh, the /opt/local/lib/ is the darwinports lib location. The CFFI guys probably have a better way to do this. Cyrus Index: Backends/gtkairo/gtk-ffi.lisp =================================================================== RCS file: /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp,v retrieving revision 1.5 diff -u -r1.5 gtk-ffi.lisp --- Backends/gtkairo/gtk-ffi.lisp 2 May 2006 13:00:12 -0000 1.5 +++ Backends/gtkairo/gtk-ffi.lisp 3 May 2006 16:44:41 -0000 @@ -19,12 +19,19 @@ (in-package :clim-gtkairo) -#-(or win32 mswindows windows) +#-(or win32 mswindows windows darwin) (eval-when (:compile-toplevel :load-toplevel :execute) (cffi:load-foreign-library "libcairo.so") (cffi:load-foreign-library "libgthread-2.0.so") (cffi:load-foreign-library "libgtk-x11-2.0.so")) +#+darwin +(eval-when (:compile-toplevel :load-toplevel :execute) + (pushnew "/opt/local/lib/" cffi:*foreign-library-directories*) + (cffi:load-foreign-library "libcairo.dylib") + (cffi:load-foreign-library "libgthread-2.0.dylib") + (cffi:load-foreign-library "libgtk-x11-2.0.dylib")) + #+(or win32 mswindows windows) (eval-when (:compile-toplevel :load-toplevel :execute) (cffi:load-foreign-library "libcairo-2.dll")

2 1

[mcclim-devel] mcclim destorys clx on ACL 6.2
by Max-Gerd Retzlaff 05 May '06

05 May '06

Hi, I've just updated my McCLIM to the lastest CVS version. When I now load McClim into the generic ACL 6.2 image even a simple CLX demo like XLIB::JUST-SAY-LISP doesn't work anymore. (Before the loading of McClim it does). Sadly, my last previous cvs update on this particular machine seems to be as long as five month ago, so it is probably a bit hard to find the particular commit to the CVS.. Are they any other ACL 6.2 users who use CVS McCLIM and who have noticed this problem? Bye, Max -- Max-Gerd Retzlaff <m.retzlaff(a)gmx.net> http://blog.matroid.org For your amusement: Old age and treachery will overcome youth and skill.

4 8

[mcclim-devel] (Patch) Keyboard support and (too) trivial `eval-in-frame' for the McCLIM debugger
by Troels Henriksen 28 Apr '06

28 Apr '06

Attached to this post is a patch to the debugger in Apps/Debugger/clim-debugger.lisp. It adds keyboard support and a simple-minded (and almost useless) `eval-in-frame' command. /etc/host.conf: line 24: bad command `mdns off' Index: Apps/Debugger/clim-debugger.lisp =================================================================== RCS file: /project/mcclim/cvsroot/mcclim/Apps/Debugger/clim-debugger.lisp,v retrieving revision 1.1 diff -u -r1.1 clim-debugger.lisp --- Apps/Debugger/clim-debugger.lisp 26 Apr 2005 03:19:34 -0000 1.1 +++ Apps/Debugger/clim-debugger.lisp 28 Apr 2006 14:41:33 -0000 @@ -132,14 +132,14 @@ (defun compute-backtrace (start end) (loop for frame in (swank-backend::compute-backtrace start end) - for frame-no from 0 - collect (make-instance - 'stack-frame - :frame-string (let ((*print-pretty* nil)) - (with-output-to-string (stream) - (swank-backend::print-frame frame stream))) - :frame-no frame-no - :frame-variables (swank-backend::frame-locals frame-no)))) + for frame-no from 0 + collect (make-instance + 'stack-frame + :frame-string (let ((*print-pretty* nil)) + (with-output-to-string (stream) + (swank-backend::print-frame frame stream))) + :frame-no frame-no + :frame-variables (swank-backend::frame-locals frame-no)))) (defmethod expand-backtrace ((info debugger-info) (value integer)) (with-slots (backtrace) info @@ -151,7 +151,19 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defclass debugger-pane (application-pane) - ((condition-info :reader condition-info :initarg :condition-info))) + ((condition-info + :reader condition-info + :initarg :condition-info) + (selected-stack-frame-index + :accessor selected-stack-frame-index + :initarg :selected-strackframe-index + :type 'integer + :initform 0) + (presentation-hashmap + :accessor presentation-hash-table + :initarg :presentation-hash-tablen + :type 'hash-table + :initform (make-hash-table)))) ;; FIXME - These two variables should be removed! ;; Used to return the chosen reatart in the debugger. @@ -173,9 +185,15 @@ (define-application-frame clim-debugger () () (:panes - (debugger-pane (make-debugger-pane))) + (debugger-pane (make-debugger-pane)) + (interactor :interactor + :max-height 100) + (pointer-doc :pointer-documentation)) (:layouts - (default (vertically () (scrolling () debugger-pane)))) + (default (vertically () + (scrolling () debugger-pane) + interactor + pointer-doc))) (:geometry :height 600 :width 800)) (defun run-debugger-frame () @@ -192,26 +210,119 @@ (define-presentation-type more-type ()) (define-presentation-type inspect ()) +(defun highlight-selected-stack-frame (debugger-pane) + "Highlight the presentation associated with the currently + selected stack frame." + (funcall-presentation-generic-function + highlight-presentation + 'stack-frame + (gethash (elt (backtrace + (condition-info debugger-pane)) + (selected-stack-frame-index + debugger-pane)) + (presentation-hash-table debugger-pane)) + debugger-pane + :highlight)) + +(defun unhighlight-selected-stack-frame (debugger-pane) + "Unhighlight the presentation associated with the currently + selected stack frame." + (funcall-presentation-generic-function + highlight-presentation + 'stack-frame + (gethash (elt (backtrace + (condition-info debugger-pane)) + (selected-stack-frame-index + debugger-pane)) + (presentation-hash-table debugger-pane)) + debugger-pane + :unhighlight)) + +(define-presentation-method highlight-presentation ((type stack-frame) record (stream debugger-pane) (state (eql :highlight))) + (declare (ignore state stream)) + (unhighlight-selected-stack-frame stream) + ;; List this presentation as the currently selected. + (setf (selected-stack-frame-index stream) + (position (presentation-object record) + (backtrace (condition-info stream)))) + ;; Unhighlight all other presentations. + + (call-next-method)) + +(define-presentation-method present (object (type stack-frame) stream + (view minimized-stack-frame-view) + &key acceptably for-context-type) + (declare (ignore acceptably for-context-type)) + (format t "~A " (frame-string object))) + +(define-presentation-method present (object (type stack-frame) stream + (view maximized-stack-frame-view) + &key acceptably for-context-type) + (declare (ignore acceptably for-context-type)) + (progn + (princ (frame-string object) stream) + (fresh-line) + (with-text-family (stream :sans-serif) + (bold (stream) (format t " Locals:"))) + (fresh-line) + (format t " ") + (formatting-table + (stream) + (loop for (name n identifier id value val) in (frame-variables object) + do (formatting-row + (stream) + (formatting-cell (stream) (format t "~A" n)) + (formatting-cell (stream) (format t "=")) + (formatting-cell (stream) (present val 'inspect))))) + (terpri stream))) + +(define-presentation-method present (object (type restart) stream + (view textual-view) + &key acceptably for-context-type) + (declare (ignore acceptably for-context-type)) + (bold (stream) (format t "~A" (restart-name object)))) + +(define-presentation-method present (object (type more-type) stream + (view textual-view) + &key acceptably for-context-type) + (declare (ignore acceptably for-context-type)) + (bold (stream) (format t "--- MORE ---"))) + +(define-presentation-method present (object (type inspect) stream + (view textual-view) + &key acceptably for-context-type) + (declare (ignore acceptably for-context-type)) + (format t "~A" object)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Commands ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define-clim-debugger-command (com-more :name "More backtraces") +(define-clim-debugger-command (com-more + :name "More backtraces") ((pane 'more-type)) (expand-backtrace (condition-info pane) 10)) -(define-clim-debugger-command (com-invoke-inspector :name "Invoke inspector") +(define-clim-debugger-command (com-invoke-inspector + :name "Invoke inspector") ((obj 'inspect)) - (clouseau:inspector obj)) + (clouseau:inspector obj :new-process t)) -(define-clim-debugger-command (com-refresh :name "Refresh" :menu t) () +(define-clim-debugger-command (com-refresh + :name "Refresh" + :menu t) + () (change-space-requirements (frame-panes *application-frame*))) -(define-clim-debugger-command (com-quit :name "Quit" :menu t) () +(define-clim-debugger-command (com-quit + :name "Quit" + :menu t) + () (frame-exit *application-frame*)) -(define-clim-debugger-command (com-invoke-restart :name "Invoke restart") +(define-clim-debugger-command (com-invoke-restart + :name "Invoke restart") ((restart 'restart)) (setf *returned-restart* restart) (frame-exit *application-frame*)) @@ -225,6 +336,148 @@ (setf (view stack-frame) +minimized-stack-frame-view+)) (change-space-requirements (frame-panes *application-frame*)))) +(define-clim-debugger-command (com-eval-in-frame + :name "Eval in frame") + ((stack-frame 'stack-frame) + &key + (code 'expression + :prompt "code" + :default (accept 'expression))) + (setf swank::*buffer-package* + *package* + swank::*buffer-readtable* + *readtable*) + (print (swank:eval-string-in-frame + (write-to-string code) + (frame-no stack-frame)))) + +;;; We want to be able to invoke restarts with the 1-9 letters on the +;;; keyboard. + +(define-clim-debugger-command + (com-invoke-restart-by-number + :name "Invoke numbered restart") + ((number 'integer)) + ;; `number' is the number of the restart to invoke. This + ;; is simply used as an index into a list. + (let* ((debugger-pane + (get-frame-pane *application-frame* 'debugger-pane)) + (restarts + (restarts + (condition-info debugger-pane))) + (selected-restart (nth number restarts))) + ;; If the restart is not valid, we just ignore the command. + (when selected-restart + (setf *returned-restart* selected-restart) + (frame-exit *application-frame*)))) + +;;; We associate keystrokes in the interval 0-9 to calls to +;;; `clim-invoke-restart' with the keystroke as argument. Is this a +;;; kludge? I couln't find a better way to do it. + +;; Define a macro for convenience. + +(defmacro keybind-restart-commands (n) + "Associate the numeric keys in the interval 0-N with a call to +`clim-invoke-restart' with the relevant number as argument." + `(progn + ,@(loop for r from 0 upto n + collecting + `(add-command-to-command-table + '(com-invoke-restart-by-number ,r) + 'clim-debugger + :keystroke '(,(code-char (+ (char-code #\0) r))))))) + +(keybind-restart-commands 9) + +;; We also define an abort-command to permit quick exit. + +(define-clim-debugger-command + (com-invoke-abort-restart + :name "Invoke abort restart" + :keystroke (#\q)) + () + (setf *returned-restart* nil) + (frame-exit *application-frame*)) + +;; We want to be able to navigate the list of stack frames +;; with the keyboard. + +(define-clim-debugger-command + (com-next-stack-frame + :name "Next stack-frame" + :keystroke (#\n :control)) + () + (let ((debugger-pane (get-frame-pane *application-frame* 'debugger-pane))) + (when (< (selected-stack-frame-index debugger-pane) + (1- (length (backtrace (condition-info debugger-pane))))) + (incf (selected-stack-frame-index debugger-pane))))) + +(add-command-to-command-table + 'com-next-stack-frame + 'clim-debugger + :errorp nil + :keystroke '(#\n)) + +(define-clim-debugger-command + (com-prev-stack-frame + :name "Previous stack-frame" + :keystroke (#\p :control)) + () + (let ((debugger-pane (get-frame-pane *application-frame* 'debugger-pane))) + (when (> (selected-stack-frame-index debugger-pane) 0) + (decf (selected-stack-frame-index debugger-pane))))) + +(add-command-to-command-table + 'com-prev-stack-frame + 'clim-debugger + :errorp nil + :keystroke '(#\p)) + +(define-clim-debugger-command + (com-toggle-selected-stack-frame-index-view + :name "Toggle view of selected stack-frame" + :keystroke (#\e)) + () + (let* ((debugger-pane (get-frame-pane *application-frame* 'debugger-pane)) + (stack-frame (nth (selected-stack-frame-index debugger-pane) + (backtrace (condition-info debugger-pane))))) + (execute-frame-command *application-frame* + `(com-toggle-stack-frame-view ,stack-frame)))) + +(define-clim-debugger-command + (com-browse-next-stack-frame + :name "Browse next stack-frame" + :keystroke (#\N)) + () + ;; Minize current stack-frame, select and expand next stack-frame. + (let* ((debugger-pane (get-frame-pane *application-frame* 'debugger-pane)) + (current-stack-frame (nth (selected-stack-frame-index debugger-pane) + (backtrace (condition-info debugger-pane))))) + (setf (view current-stack-frame) +minimized-stack-frame-view+) + (com-next-stack-frame) + ;; We have a new current stack-frame (this shadowing may be a bit + ;; ugly).. + (let ((current-stack-frame (nth (selected-stack-frame-index debugger-pane) + (backtrace (condition-info debugger-pane))))) + (setf (view current-stack-frame) +maximized-stack-frame-view+)))) + +(define-clim-debugger-command + (com-browse-prev-stack-frame + :name "Browse previous stack-frame" + :keystroke (#\P)) + () + ;; Minize current stack-frame, select and expand previous stack-frame. + (let* ((debugger-pane (get-frame-pane *application-frame* 'debugger-pane)) + (current-stack-frame (nth (selected-stack-frame-index debugger-pane) + (backtrace (condition-info debugger-pane))))) + (setf (view current-stack-frame) +minimized-stack-frame-view+) + (com-prev-stack-frame) + ;; We have a new current stack-frame. + (let ((current-stack-frame (nth (selected-stack-frame-index debugger-pane) + (backtrace (condition-info debugger-pane))))) + (setf (view current-stack-frame) +maximized-stack-frame-view+)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Command translators ;;;;;;;;;;;;;;;;;;;;; @@ -241,7 +494,16 @@ (list object)) (define-presentation-to-command-translator toggle-stack-frame-view - (stack-frame com-toggle-stack-frame-view clim-debugger :gesture :select) + (stack-frame com-toggle-stack-frame-view clim-debugger + :gesture :select + :documentation "Toggle stack frame view") + (object) + (list object)) + +(define-presentation-to-command-translator eval-in-frame + (stack-frame com-eval-in-frame clim-debugger + :gesture :edit + :documentation "Eval in frame") (object) (list object)) @@ -262,15 +524,15 @@ (formatting-cell (pane) (bold (pane) (format t "~A" first)))) (formatting-cell (pane) (with-text-family (pane family) - (format t "~A" second))))) + (format t "~A" second))))) (defun display-debugger (frame pane) (let ((*standard-output* pane)) (formatting-table (pane) (std-form pane "Condition type:" (type-of-condition (condition-info - pane))) + pane))) (std-form pane "Description:" (condition-message (condition-info - pane))) + pane))) (when (condition-extra (condition-info pane)) (std-form pane "Extra:" (condition-extra (condition-info pane)) :family :fix)) @@ -287,9 +549,12 @@ (formatting-table (pane) (loop for r in (restarts (condition-info pane)) - do (formatting-row (pane) + for rcount from 0 + do (formatting-row (pane) (with-output-as-presentation (pane r 'restart) (formatting-cell (pane) + (format pane "~A." rcount)) + (formatting-cell (pane) (format pane "~A" (restart-name r))) (formatting-cell (pane) @@ -298,8 +563,9 @@ (fresh-line) (display-backtrace frame pane) (change-space-requirements pane - :width (bounding-rectangle-width (stream-output-history pane)) - :height (bounding-rectangle-height (stream-output-history pane))))) + :width (bounding-rectangle-width (stream-output-history pane)) + :height (bounding-rectangle-height (stream-output-history pane)))) + (highlight-selected-stack-frame pane)) (defun display-backtrace (frame pane) @@ -311,13 +577,16 @@ (formatting-table (pane) (loop for stack-frame in (backtrace (condition-info pane)) - for i from 0 - do (formatting-row (pane) - (with-output-as-presentation (pane stack-frame 'stack-frame) - (bold (pane) (formatting-cell (pane) (format t "~A: " i))) - (formatting-cell (pane) - (present stack-frame 'stack-frame - :view (view stack-frame)))))) + for i from 0 + do (formatting-row (pane) + (with-output-as-presentation (pane stack-frame 'stack-frame) + (bold (pane) + (formatting-cell (pane) (format t "~A: " i))) + (formatting-cell (pane) + (setf (gethash stack-frame (presentation-hash-table pane)) + (present stack-frame 'stack-frame + :view (view stack-frame) + :single-box t)))))) (when (>= (length (backtrace (condition-info pane))) 20) (formatting-row (pane) (formatting-cell (pane)) @@ -325,53 +594,6 @@ (bold (pane) (present pane 'more-type))))))) - -(define-presentation-method present (object (type stack-frame) stream - (view minimized-stack-frame-view) - &key acceptably for-context-type) - (declare (ignore acceptably for-context-type)) - (format t "~A " (frame-string object))) - -(define-presentation-method present (object (type stack-frame) stream - (view maximized-stack-frame-view) - &key acceptably for-context-type) - (declare (ignore acceptably for-context-type)) - (progn - (princ (frame-string object) stream) - (fresh-line) - (with-text-family (stream :sans-serif) - (bold (stream) (format t " Locals:"))) - (fresh-line) - (format t " ") - (formatting-table - (stream) - (loop for (name n identifier id value val) in (frame-variables object) - do (formatting-row - (stream) - (formatting-cell (stream) (format t "~A" n)) - (formatting-cell (stream) (format t "=")) - (formatting-cell (stream) (present val 'inspect))))) - (fresh-line))) - -(define-presentation-method present (object (type restart) stream - (view textual-view) - &key acceptably for-context-type) - (declare (ignore acceptably for-context-type)) - (bold (stream) (format t "~A" (restart-name object)))) - -(define-presentation-method present (object (type more-type) stream - (view textual-view) - &key acceptably for-context-type) - (declare (ignore acceptably for-context-type)) - (bold (stream) (format t "--- MORE ---"))) - -(define-presentation-method present (object (type inspect) stream - (view textual-view) - &key acceptably for-context-type) - (declare (ignore acceptably for-context-type)) - (format t "~A" object)) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Starting the debugger ;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -412,4 +634,3 @@ (invoke-debugger (make-condition 'simple-error :format-control "Debugger test"))))) - -- \ Troels "Athas" Henriksen /\ - Insert witty signature

1 0

[mcclim-devel] incremental-redisplay cons cell memory leak
by Andreas Fuchs 26 Apr '06

26 Apr '06

Hi all, a long time ago, I discovered that beirc crashes after 3 or 4 days of running. Now I managed to narrow it down to the incremental redisplay code. It seems that the children-updating-output slot of updating output records has duplicate ORs (68 unique ORs vs. 1765 non-unique) added, which makes sbcl go boom pretty soon. This patch fixes it, but I'm not sure if I'm solving the root of the problem. Tim should maybe have a look at it (: Index: incremental-redisplay.lisp =================================================================== RCS file: /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp,v retrieving revision 1.60 diff -u -r1.60 incremental-redisplay.lisp --- incremental-redisplay.lisp 22 Apr 2006 15:31:27 -0000 1.60 +++ incremental-redisplay.lisp 26 Apr 2006 18:12:40 -0000 @@ -442,7 +442,7 @@ ((child updating-output-record-mixin) record) (declare (ignore record)) (if (parent-updating-output child) - (push child (children-updating-output (parent-updating-output child))) + (pushnew child (children-updating-output (parent-updating-output child))) nil)) (oh, and things seem a bit snappier with it, obviously (-:) Cheers, -- Andreas Fuchs, (http://|im:asf@|mailto:asf@)boinkor.net, antifuchs

2 2

[mcclim-devel] bug(?) in text-editor-pane / Goatee
by Christopher Laux 25 Apr '06

25 Apr '06

Hi all, I've given up looking for this one for now, maybe people familiar with the code in question know what's going on. If you simply set the gadget-value of a text-editor-pane to a string with a newline in it (I assume that's how you set up multiline text, right?) and then set a new value, moving the cursor (home key in this example) can yield the following error: > (setf (gadget-value *edit*) (format nil "test~%test")) > (setf (gadget-value *edit*) "test") The value -1 is not of type (MOD 536870911). [Condition of type TYPE-ERROR] Restarts: 0: [ABORT] Return to application command loop 1: [TERMINATE-THREAD] Terminate this thread (#<THREAD {A8629D9}>) Backtrace: 0: ((SB-PCL::FAST-METHOD GOATEE::BUFFER-STRING (GOATEE::BASIC-BUFFER)) #<unavailable argument> #<unavailable argument> #<GOATEE::EDITABLE-BUFFER {AA30B61}> NIL) 1: ((SB-PCL::FAST-METHOD HANDLE-EVENT (TEXT-FIELD-PANE KEY-PRESS-EVENT)) (#(NIL 65) . #()) #<unavailable argument> #<TEXT-EDITOR-PANE FORM-EDIT {A8BB141}> #<KEY-PRESS-EVENT {B491439}>) 2: (CLIM-INTERNALS::HANDLE-NON-STREAM-EVENT #<CLIM-INTERNALS::PORT-EVENT-QUEUE {A862931}>) 3: ((SB-PCL::FAST-METHOD STREAM-INPUT-WAIT [ ... ] The value doesn't have to be -1 btw... If I'm not mistaken, the problem is that additional undefined characters are inserted mistakenly (visible cues too). The size of the editable-buffer is not correspondingly updated, so after deletion there's a negative size value. Thanks in advance for any help, Chris

1 0