mcclim-cvs January 2008

mcclim-cvs@common-lisp.net

7 participants
255 discussions

[mcclim-cvs] CVS mcclim/Apps/Listener
by ahefner 31 Jan '08

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Apps/Listener In directory clnet:/tmp/cvs-serv25429 Modified Files: wholine.lisp Log Message: Detect changed package name. --- /project/mcclim/cvsroot/mcclim/Apps/Listener/wholine.lisp 2008/01/06 01:33:25 1.3 +++ /project/mcclim/cvsroot/mcclim/Apps/Listener/wholine.lisp 2008/01/31 08:46:44 1.4 @@ -83,7 +83,7 @@ ;; But :small looks awful using freetype, perhaps because the ;; fonts are, for whatever reason, slightly smaller. ;; Very distressing. - (text-size (if (find-package :mcclim-freetype) :normal :small)) + (text-size (if (find-package :mcclim-truetype) :normal :small)) (memusage #+(or cmu scl) (lisp::dynamic-usage) #+sbcl (sb-kernel:dynamic-usage) #+lispworks (getf (system:room-values) :total-allocated)

1 0

[mcclim-cvs] CVS mcclim/Drei/Tests
by thenriksen 31 Jan '08

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei/Tests In directory clnet:/tmp/cvs-serv22290/Drei/Tests Modified Files: core-tests.lisp Log Message: Put point at offset 0, even if there are initial contents. Made some tests run. --- /project/mcclim/cvsroot/mcclim/Drei/Tests/core-tests.lisp 2008/01/19 20:06:01 1.7 +++ /project/mcclim/cvsroot/mcclim/Drei/Tests/core-tests.lisp 2008/01/31 08:34:15 1.8 @@ -27,42 +27,6 @@ (in-suite core-tests) -(test downcase-word - (with-drei-environment () - (downcase-word (point) (current-syntax) 1) - (is (string= (buffer-contents) ""))) - (with-drei-environment (:initial-contents "CLI MA CS CLIMACS") - (let ((m (clone-mark (point) :right))) - (setf (offset m) 0) - (downcase-word m (current-syntax) 3) - (is (string= (buffer-contents) - "cli ma cs CLIMACS")) - (is (= (offset m) 9))))) - -(test upcase-word - (with-drei-environment () - (upcase-word (point) (current-syntax) 1) - (is (string= (buffer-contents) ""))) - (with-drei-environment (:initial-contents "cli ma cs climacs") - (let ((m (clone-mark (point) :right))) - (setf (offset m) 0) - (upcase-word m (current-syntax) 3) - (is (string= (buffer-contents) - "CLI MA CS climacs")) - (is (= (offset m) 9))))) - -(test capitalize-word - (with-drei-environment () - (capitalize-word (point) (current-syntax) 1) - (is (string= (buffer-contents) ""))) - (with-drei-environment ( :initial-contents "cli ma cs climacs") - (let ((m (clone-mark (point) :right))) - (setf (offset m) 0) - (capitalize-word m (current-syntax) 3) - (is (string= (buffer-contents) - "Cli Ma Cs climacs")) - (is (= (offset m) 9))))) - (test possibly-fill-line (with-drei-environment () (possibly-fill-line) @@ -191,6 +155,9 @@ (buffer-is "FOO BAR"))) (test downcase-word + (with-drei-environment () + (downcase-word (point) (current-syntax) 1) + (is (string= (buffer-contents) ""))) (with-drei-environment (:initial-contents "Drei Climacs Drei") (downcase-word (point) (current-syntax) 1) (buffer-is "drei Climacs Drei") @@ -206,9 +173,16 @@ (buffer-is "drei climacs Drei")) (with-drei-environment (:initial-contents "Drei Climacs Drei") (downcase-word (point) (current-syntax) 3) - (buffer-is "drei climacs drei"))) + (buffer-is "drei climacs drei")) + (with-drei-environment (:initial-contents "CLI MA CS CLIMACS") + (downcase-word (point) (current-syntax) 3) + (is (buffer-is "cli ma cs CLIMACS")) + (is (= 9 (offset (point)))))) (test upcase-word + (with-drei-environment () + (upcase-word (point) (current-syntax) 1) + (is (string= (buffer-contents) ""))) (with-drei-environment (:initial-contents "Drei Climacs Drei") (upcase-word (point) (current-syntax) 1) (buffer-is "DREI Climacs Drei") @@ -224,9 +198,19 @@ (buffer-is "DREI CLIMACS Drei")) (with-drei-environment (:initial-contents "Drei Climacs Drei") (upcase-word (point) (current-syntax) 3) - (buffer-is "DREI CLIMACS DREI"))) + (buffer-is "DREI CLIMACS DREI")) + (with-drei-environment (:initial-contents "cli ma cs climacs") + (let ((m (clone-mark (point) :right))) + (setf (offset m) 0) + (upcase-word m (current-syntax) 3) + (is (string= (buffer-contents) + "CLI MA CS climacs")) + (is (= (offset m) 9))))) (test capitalize-word + (with-drei-environment () + (capitalize-word (point) (current-syntax) 1) + (is (string= (buffer-contents) ""))) (with-drei-environment (:initial-contents "drei climacs drei") (capitalize-word (point) (current-syntax) 1) (buffer-is "Drei climacs drei") @@ -242,7 +226,14 @@ (buffer-is "Drei Climacs drei")) (with-drei-environment (:initial-contents "drei climacs drei") (capitalize-word (point) (current-syntax) 3) - (buffer-is "Drei Climacs Drei"))) + (buffer-is "Drei Climacs Drei")) + (with-drei-environment ( :initial-contents "cli ma cs climacs") + (let ((m (clone-mark (point) :right))) + (setf (offset m) 0) + (capitalize-word m (current-syntax) 3) + (is (string= (buffer-contents) + "Cli Ma Cs climacs")) + (is (= (offset m) 9))))) (test indent-region ;; FIXME: Sadly, we can't test this function, because it requires a

1 0

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

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv22290/Drei Modified Files: views.lisp Log Message: Put point at offset 0, even if there are initial contents. Made some tests run. --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/30 21:21:43 1.32 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2008/01/31 08:34:15 1.33 @@ -386,7 +386,7 @@ (when initial-contents (check-type initial-contents array) (insert-buffer-sequence buffer 0 initial-contents)) - (setf point (make-buffer-mark buffer (size buffer) :right)) + (setf point (make-buffer-mark buffer 0 :right)) (setf (read-only-p implementation) read-only (single-line-p implementation) single-line) ;; Hack: we need to be told whenever the undo facilities in the

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 31 Jan '08

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv3409 Modified Files: input-editing.lisp Log Message: Fixed nested use of with-input-editing. --- /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/01/30 23:24:06 1.61 +++ /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/01/30 23:39:19 1.62 @@ -220,15 +220,17 @@ ,@body))) (defun input-editing-rescan-loop (editing-stream continuation) - (loop - (block rescan - (handler-bind ((rescan-condition - #'(lambda (c) - (declare (ignore c)) - (reset-scan-pointer editing-stream) - (return-from rescan nil)))) - (return-from input-editing-rescan-loop - (funcall continuation editing-stream)))))) + (let ((start-scan-pointer (stream-scan-pointer editing-stream))) + (loop + (block rescan + (handler-bind ((rescan-condition + #'(lambda (c) + (reset-scan-pointer editing-stream start-scan-pointer) + ;; Input-editing contexts above may be interested... + (signal c) + (return-from rescan nil)))) + (return-from input-editing-rescan-loop + (funcall continuation editing-stream))))))) (defgeneric invoke-with-input-editing (stream continuation input-sensitizer initial-contents class) @@ -243,23 +245,14 @@ (defmethod invoke-with-input-editing ((stream input-editing-stream) continuation input-sensitizer initial-contents class) - (let ((start-scan-pointer (stream-scan-pointer stream))) + (unless (stream-rescanning-p stream) (if (stringp initial-contents) (replace-input stream initial-contents) (presentation-replace-input stream (first initial-contents) (second initial-contents) - (stream-default-view stream))) - (unwind-protect - (loop (block rescan - (handler-bind ((rescan-condition - #'(lambda (c) - (declare (ignore c)) - (reset-scan-pointer stream - start-scan-pointer) - (return-from rescan nil)))) - (return-from invoke-with-input-editing - (funcall continuation stream)))))))) + (stream-default-view stream)))) + (input-editing-rescan-loop stream continuation)) (defgeneric input-editing-stream-bounding-rectangle (stream) (:documentation "Return the bounding rectangle of `stream' as

1 0

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

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv1491/Drei Modified Files: lisp-syntax.lisp Log Message: Support :POSSIBILITY-PRINTER for COMPLETE-INPUT. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/22 23:00:04 1.71 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/30 23:24:05 1.72 @@ -2613,8 +2613,9 @@ (with-minibuffer-stream (minibuffer) (let ((*print-escape* nil)) (princ condition minibuffer))) - (setf (offset (point drei)) - (start-offset (form condition)))) + (when (point-mark-view-p (view drei)) + (setf (offset (point (view drei))) + (start-offset (form condition))))) ;;; Handling labels (#n= and #n#) takes a fair bit of machinery, most ;;; of which is located here. We follow an approach similar to that

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 31 Jan '08

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv1491 Modified Files: input-editing.lisp Log Message: Support :POSSIBILITY-PRINTER for COMPLETE-INPUT. --- /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/01/30 22:29:07 1.60 +++ /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/01/30 23:24:06 1.61 @@ -494,11 +494,16 @@ (defun possibilities-for-menu (possibilities) (loop for p in possibilities - for (display . object) = p - if (listp object) - collect `(,display :value ,object) - else - collect p)) + for (display . object) = p + collect `(,display :value ,object))) + +(defun possibility-printer (possibility ptype stream) + "A default function for printing a possibility. Suitable for +used as value of `:possibility-printer' in calls to +`complete-input'" + (destructuring-bind (string object) possibility + (with-output-as-presentation (stream object ptype) + (write-string string stream)))) ;;; Helper returns gesture (or nil if gesture shouldn't be part of the input) ;;; and completion mode, if any. @@ -537,9 +542,9 @@ (defparameter *trace-complete-input* nil) (defun complete-input (stream func &key - partial-completers allow-any-input possibility-printer + partial-completers allow-any-input + (possibility-printer #'possibility-printer) (help-displays-possibilities t)) - (declare (ignore possibility-printer)) (let ((so-far (make-array 1 :element-type 'character :adjustable t :fill-pointer 0)) (*accelerator-gestures* (append *help-gestures* @@ -585,8 +590,17 @@ (when (and (> nmatches 0) (eq mode :possibilities)) (multiple-value-bind (menu-object item event) (menu-choose (possibilities-for-menu possibilities) - :label "Possibilities" - :n-columns 1) + :label "Possibilities" + :n-columns 1 + :printer #'(lambda (possibility stream) + ;; We have to get a + ;; presentation type from + ;; somewhere... + (destructuring-bind (string &key value) possibility + (funcall possibility-printer + (list string value) + (presentation-type-of value) + stream)))) (declare (ignore event)) (if item (setf (values input success object nmatches)

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 31 Jan '08

31 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv1354 Modified Files: menu-choose.lisp Log Message: The :PRINTER function to MENU-CHOOSE should be called with the menu item, not the menu item display. --- /project/mcclim/cvsroot/mcclim/menu-choose.lisp 2007/02/05 03:00:54 1.20 +++ /project/mcclim/cvsroot/mcclim/menu-choose.lisp 2008/01/30 23:22:45 1.21 @@ -226,9 +226,7 @@ (if default-item-p default-item (first items)) - :item-printer (if printer - (lambda (item stream) - (funcall printer (menu-item-display item) stream)) + :item-printer (or printer #'print-menu-item) :max-width max-width :max-height max-height

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 30 Jan '08

30 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv21204 Modified Files: input-editing-drei.lisp input-editing.lisp Log Message: Try to centralise the with-input-editing logic a bit. Make with-input-editing work for input-editing-streams. --- /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2008/01/30 21:21:43 1.9 +++ /project/mcclim/cvsroot/mcclim/input-editing-drei.lisp 2008/01/30 22:29:07 1.10 @@ -124,9 +124,6 @@ (setf (stream-cursor-position real-stream) (values 0 (nth-value 3 (input-editing-stream-bounding-rectangle stream)))))) -(defgeneric invoke-with-input-editing - (stream continuation input-sensitizer initial-contents class)) - (defmethod invoke-with-input-editing :around ((stream extended-output-stream) continuation input-sensitizer @@ -153,24 +150,12 @@ input-sensitizer initial-contents class) - (let ((editing-stream (make-instance class - :stream stream))) - (if (stringp initial-contents) - (replace-input editing-stream initial-contents) - (presentation-replace-input editing-stream - (first initial-contents) - (second initial-contents) - (stream-default-view editing-stream))) - (unwind-protect - (loop - (block rescan - (handler-bind ((rescan-condition - #'(lambda (c) - (declare (ignore c)) - (reset-scan-pointer editing-stream) - (return-from rescan nil)))) - (return-from invoke-with-input-editing - (funcall continuation editing-stream))))) + (let ((editing-stream (make-instance class :stream stream))) + (unwind-protect (with-input-editing (editing-stream + :input-sensitizer input-sensitizer + :initial-contents initial-contents + :class class) + (funcall continuation editing-stream)) (finalize editing-stream input-sensitizer)))) (defmethod immediate-rescan ((stream standard-input-editing-stream)) --- /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/01/30 21:21:44 1.59 +++ /project/mcclim/cvsroot/mcclim/input-editing.lisp 2008/01/30 22:29:07 1.60 @@ -230,11 +230,37 @@ (return-from input-editing-rescan-loop (funcall continuation editing-stream)))))) +(defgeneric invoke-with-input-editing + (stream continuation input-sensitizer initial-contents class) + (:documentation "Implements `with-input-editing'. `Class' is +the class of the input-editing stream to create, if necessary.")) + (defmethod invoke-with-input-editing (stream continuation input-sensitizer initial-contents class) (declare (ignore input-sensitizer initial-contents class)) (funcall continuation stream)) +(defmethod invoke-with-input-editing ((stream input-editing-stream) + continuation input-sensitizer + initial-contents class) + (let ((start-scan-pointer (stream-scan-pointer stream))) + (if (stringp initial-contents) + (replace-input stream initial-contents) + (presentation-replace-input stream + (first initial-contents) + (second initial-contents) + (stream-default-view stream))) + (unwind-protect + (loop (block rescan + (handler-bind ((rescan-condition + #'(lambda (c) + (declare (ignore c)) + (reset-scan-pointer stream + start-scan-pointer) + (return-from rescan nil)))) + (return-from invoke-with-input-editing + (funcall continuation stream)))))))) + (defgeneric input-editing-stream-bounding-rectangle (stream) (:documentation "Return the bounding rectangle of `stream' as four values. This function does not appear in the spec but is

1 0

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

30 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv17467/Drei Modified Files: input-editor.lisp Log Message: Oops, keep Lisp syntax highlighting even after the input has been activated. --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/30 21:41:11 1.30 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/30 22:11:35 1.31 @@ -793,7 +793,7 @@ view &key) (with-drei-options ((drei-instance stream) :syntax "Lisp" - :keep-syntax nil) + :keep-syntax t) (call-next-method))) (define-presentation-method accept :around

1 0

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

30 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv12517/Drei Modified Files: input-editor.lisp Log Message: Make the accept methods for command-or-form work better with things like Structedit. --- /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/30 21:30:02 1.29 +++ /project/mcclim/cvsroot/mcclim/Drei/input-editor.lisp 2008/01/30 21:41:11 1.30 @@ -783,6 +783,28 @@ ;;; ;;; Presentation type specialization. +;;; When starting out with reading `command-or-form', we use Lisp +;;; syntax, so things like Structedit works. If it turns out to be a +;;; command, switch back to Fundamental. + +(define-presentation-method accept :around + ((type command-or-form) + (stream drei-input-editing-mixin) + view &key) + (with-drei-options ((drei-instance stream) + :syntax "Lisp" + :keep-syntax nil) + (call-next-method))) + +(define-presentation-method accept :around + ((type command) + (stream drei-input-editing-mixin) + view &key) + (with-drei-options ((drei-instance stream) + :syntax "Fundamental" + :keep-syntax nil) + (call-next-method))) + (define-presentation-method accept :around ((type expression) (stream drei-input-editing-mixin)

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs January 2008