December 2007 - mcclim-cvs@common-lisp.net

[mcclim-cvs] CVS mcclim/Drei/Tests
by thenriksen 20 Dec '07

20 Dec '07

Update of /project/mcclim/cvsroot/mcclim/Drei/Tests In directory clnet:/tmp/cvs-serv4077/Drei/Tests Modified Files: lisp-syntax-tests.lisp motion-tests.lisp Log Message: Fixed some problems with retrieving forms in Lisp syntax. --- /project/mcclim/cvsroot/mcclim/Drei/Tests/lisp-syntax-tests.lisp 2007/12/19 17:17:37 1.9 +++ /project/mcclim/cvsroot/mcclim/Drei/Tests/lisp-syntax-tests.lisp 2007/12/20 10:33:35 1.10 @@ -820,29 +820,36 @@ (buffer-is "(with-output-to-string (s \"foo\" :element-type 'character ") (is (= 45 (offset mark)))))) -(motion-fun-one-test expression (51 0 (11 28 7) - "(defun list (&rest elements) -(append elements nil))" :syntax lisp-syntax)) - -(motion-fun-one-test list (64 4 (22 41 11) - "foo (defun (barbaz) list (&rest elements) -(append elements nil))" :syntax lisp-syntax)) - -(motion-fun-one-test down (1 53 (15 16 13) - "(defun list () (&rest elements) -(append elements nil))" :syntax lisp-syntax)) - -(motion-fun-one-test up (nil nil (13 14 12) - "(defun list () (&rest elements) -(append elements nil))" :syntax lisp-syntax) - (nil nil (17 19 12) - "(defun list (x y z) -(list x y z))" :syntax lisp-syntax)) - -(motion-fun-one-test definition (51 52 (35 51 0) - "(defun list (&rest elements) -(append elements nil)) (defun second (list) (cadr list))" -:syntax lisp-syntax)) +(motion-fun-one-test (expression lisp-syntax) + (51 0 (11 28 7) + "(defun list (&rest elements) +(append elements nil))")) + +(motion-fun-one-test (list lisp-syntax) + (64 4 (22 41 11) + "foo (defun (barbaz) list (&rest elements) +(append elements nil))")) + +(motion-fun-one-test (down lisp-syntax) + (1 53 (15 16 13) + "(defun list () (&rest elements) +(append elements nil))")) + +(motion-fun-one-test (up lisp-syntax) + (nil nil (13 14 12) + "(defun list () (&rest elements) +(append elements nil))") + (nil nil (17 19 12) + "(defun list (x y z) +(list x y z))" ) + (nil nil (21 24 0) + "(defun list (x y z) + )")) + +(motion-fun-one-test (definition lisp-syntax) + (51 52 (35 51 0) + "(defun list (&rest elements) +(append elements nil)) (defun second (list) (cadr list))")) (test in-string-p "Test the `in-string-p' function of Lisp syntax." --- /project/mcclim/cvsroot/mcclim/Drei/Tests/motion-tests.lisp 2007/12/19 17:17:37 1.6 +++ /project/mcclim/cvsroot/mcclim/Drei/Tests/motion-tests.lisp 2007/12/20 10:33:35 1.7 @@ -86,96 +86,106 @@ (backward-to-word-boundary m2r syntax) (is (= (offset m2r) 0)))))) -(defmacro motion-fun-one-test (unit &rest test-specs) +(defmacro motion-fun-one-test ((unit &optional (syntax 'drei-fundamental-syntax::fundamental-syntax)) + &body test-specs) (let ((forward (intern (format nil "FORWARD-ONE-~S" unit))) (backward (intern (format nil "BACKWARD-ONE-~S" unit)))) `(progn ,@(loop for test in test-specs nconc - (destructuring-bind (forward-begin-offset - backward-end-offset - (offset goal-forward-offset goal-backward-offset) - initial-contents - &key (syntax 'drei-fundamental-syntax::fundamental-syntax)) - test - (check-type forward-begin-offset (or integer null)) - (check-type backward-end-offset (or integer null)) - (check-type offset integer) - (check-type goal-forward-offset integer) - (check-type goal-backward-offset integer) - (list - `(test ,(intern (format nil "~A-~A" syntax forward) #.*package*) - (with-buffer (buffer :initial-contents ,initial-contents) - (with-view (view :buffer buffer :syntax ',syntax) - (let ((syntax (syntax view)) - (m0l (make-buffer-mark buffer 0 :left)) - (m0r (make-buffer-mark buffer 0 :right)) - (m1l (make-buffer-mark buffer ,offset :left)) - (m1r (make-buffer-mark buffer ,offset :right)) - (m2l (make-buffer-mark buffer (size buffer) :left)) - (m2r (make-buffer-mark buffer (size buffer) :right))) - (declare (ignore ,@(unless forward-begin-offset '(m0l)) - ,@(unless backward-end-offset '(m0r)))) - ,(when forward-begin-offset - `(progn - (is-true (,forward m0l syntax)) - (is (= ,forward-begin-offset (offset m0l))))) - ,(when backward-end-offset - `(progn - (is-true (,forward m0r syntax)) - (is (= ,forward-begin-offset (offset m0r))))) - (is-true (,forward m1l syntax)) - (is (= ,goal-forward-offset (offset m1l))) - (is-true (,forward m1r syntax)) - (is (= ,goal-forward-offset (offset m1r))) - (is-false (,forward m2l syntax)) - (is (= (size buffer) (offset m2l))) - (is-false (,forward m2r syntax)) - (is (= (size buffer) (offset m2r))))))) - `(test ,(intern (format nil "~A-~A" syntax backward) #.*package*) - (with-buffer (buffer :initial-contents ,initial-contents) - (with-view (view :buffer buffer :syntax ',syntax) - (let ((syntax (syntax view)) - (m0l (make-buffer-mark buffer 0 :left)) - (m0r (make-buffer-mark buffer 0 :right)) - (m1l (make-buffer-mark buffer ,offset :left)) - (m1r (make-buffer-mark buffer ,offset :right)) - (m2l (make-buffer-mark buffer (size buffer) :left)) - (m2r (make-buffer-mark buffer (size buffer) :right))) - (declare (ignore ,@(unless backward-end-offset '(m2l m2r)))) - (is-false (,backward m0l syntax)) - (is (= 0 (offset m0l))) - (is-false (,backward m0r syntax)) - (is (= 0 (offset m0r))) - (is-true (,backward m1l syntax)) - (is (= ,goal-backward-offset (offset m1l))) - (is-true (,backward m1r syntax)) - (is (= ,goal-backward-offset (offset m1r))) - ,(when backward-end-offset - `(progn - (is-true (,backward m2l syntax)) - (is (= ,backward-end-offset (offset m2l))))) - ,(when backward-end-offset - `(progn - (is-true (,backward m2r syntax)) - (is (= ,backward-end-offset (offset m2r))))))))))))))) + (list + `(test ,(intern (format nil "~A-~A" syntax forward) #.*package*) + ,@(loop for test in test-specs + collecting + (destructuring-bind (forward-begin-offset + backward-end-offset + (offset goal-forward-offset goal-backward-offset) + initial-contents) + test + (check-type forward-begin-offset (or integer null)) + (check-type backward-end-offset (or integer null)) + (check-type offset integer) + (check-type goal-forward-offset integer) + (check-type goal-backward-offset integer) + `(with-buffer (buffer :initial-contents ,initial-contents) + (with-view (view :buffer buffer :syntax ',syntax) + (let ((syntax (syntax view)) + (m0l (make-buffer-mark buffer 0 :left)) + (m0r (make-buffer-mark buffer 0 :right)) + (m1l (make-buffer-mark buffer ,offset :left)) + (m1r (make-buffer-mark buffer ,offset :right)) + (m2l (make-buffer-mark buffer (size buffer) :left)) + (m2r (make-buffer-mark buffer (size buffer) :right))) + (declare (ignore ,@(unless forward-begin-offset '(m0l)) + ,@(unless backward-end-offset '(m0r)))) + ,(when forward-begin-offset + `(progn + (is-true (,forward m0l syntax)) + (is (= ,forward-begin-offset (offset m0l))))) + ,(when backward-end-offset + `(progn + (is-true (,forward m0r syntax)) + (is (= ,forward-begin-offset (offset m0r))))) + (is-true (,forward m1l syntax)) + (is (= ,goal-forward-offset (offset m1l))) + (is-true (,forward m1r syntax)) + (is (= ,goal-forward-offset (offset m1r))) + (is-false (,forward m2l syntax)) + (is (= (size buffer) (offset m2l))) + (is-false (,forward m2r syntax)) + (is (= (size buffer) (offset m2r))))))))) + `(test ,(intern (format nil "~A-~A" syntax backward) #.*package*) + ,@(loop for test in test-specs + collecting + (destructuring-bind (forward-begin-offset + backward-end-offset + (offset goal-forward-offset goal-backward-offset) + initial-contents) + test + (declare (ignore forward-begin-offset goal-forward-offset)) + `(with-buffer (buffer :initial-contents ,initial-contents) + (with-view (view :buffer buffer :syntax ',syntax) + (let ((syntax (syntax view)) + (m0l (make-buffer-mark buffer 0 :left)) + (m0r (make-buffer-mark buffer 0 :right)) + (m1l (make-buffer-mark buffer ,offset :left)) + (m1r (make-buffer-mark buffer ,offset :right)) + (m2l (make-buffer-mark buffer (size buffer) :left)) + (m2r (make-buffer-mark buffer (size buffer) :right))) + (declare (ignore ,@(unless backward-end-offset '(m2l m2r)))) + (is-false (,backward m0l syntax)) + (is (= 0 (offset m0l))) + (is-false (,backward m0r syntax)) + (is (= 0 (offset m0r))) + (is-true (,backward m1l syntax)) + (is (= ,goal-backward-offset (offset m1l))) + (is-true (,backward m1r syntax)) + (is (= ,goal-backward-offset (offset m1r))) + ,(when backward-end-offset + `(progn + (is-true (,backward m2l syntax)) + (is (= ,backward-end-offset (offset m2l))))) + ,(when backward-end-offset + `(progn + (is-true (,backward m2r syntax)) + (is (= ,backward-end-offset (offset m2r)))))))))))))))) -(motion-fun-one-test word (9 10 (5 9 2) +(motion-fun-one-test (word) (9 10 (5 9 2) " climacs climacs")) -(motion-fun-one-test line (17 22 (25 47 8) +(motion-fun-one-test (line) (17 22 (25 47 8) "Climacs-Climacs! climacsclimacsclimacs... Drei!")) -(motion-fun-one-test page (19 42 (22 40 21) +(motion-fun-one-test (page) (19 42 (22 40 21) "This is about Drei! Drei is Cool Stuff. ")) -(motion-fun-one-test paragraph (21 67 (30 64 23) +(motion-fun-one-test (paragraph) (21 67 (30 64 23) "Climacs is an editor. It is based on the Drei editor substrate.

1 0

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

20 Dec '07

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv4077/Drei Modified Files: lisp-syntax.lisp Log Message: Fixed some problems with retrieving forms in Lisp syntax. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2007/12/19 17:17:37 1.37 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2007/12/20 10:33:36 1.38 @@ -2103,11 +2103,14 @@ (defun up-list (mark syntax fn) (let ((form (form-around syntax (offset mark)))) - (when form - (let ((new-offset (find-list-parent-offset form fn))) - (when new-offset - (setf (offset mark) new-offset) - t))))) + (when (if (and (form-list-p form) + (/= (start-offset form) (offset mark)) + (/= (end-offset form) (offset mark))) + (setf (offset mark) (funcall fn form)) + (let ((new-offset (find-list-parent-offset form fn))) + (when new-offset + (setf (offset mark) new-offset)))) + t))) (defmethod backward-one-up (mark (syntax lisp-syntax)) (up-list mark syntax #'start-offset))

1 0

[mcclim-cvs] CVS mcclim/Apps/Inspector
by thenriksen 20 Dec '07

20 Dec '07

Update of /project/mcclim/cvsroot/mcclim/Apps/Inspector In directory clnet:/tmp/cvs-serv4077/Apps/Inspector Modified Files: inspector.lisp Log Message: Fixed some problems with retrieving forms in Lisp syntax. --- /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2007/12/08 11:18:20 1.36 +++ /project/mcclim/cvsroot/mcclim/Apps/Inspector/inspector.lisp 2007/12/20 10:33:35 1.37 @@ -47,7 +47,7 @@ :display-function 'display-app) (int :interactor :width 600 :height 100 :max-height 100)) (:layouts - (default (vertically () (scrolling () app) int)))) + (default (vertically () (scrolling () app) #+nil int)))) (defmethod initialize-instance :after ((frame inspector) &rest args) (declare (ignore args))

1 0

[mcclim-cvs] CVS mcclim
by thenriksen 20 Dec '07

20 Dec '07

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv8545 Modified Files: mcclim.asd Log Message: Made base.lisp depend on delegating-buffer.lisp --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/12/18 10:54:21 1.64 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2007/12/20 08:07:16 1.65 @@ -286,9 +286,11 @@ (:module "Drei" :depends-on ("cl-automaton" "Persistent") :components ((:file "packages") (:file "buffer" :depends-on ("packages")) + (:file "delegating-buffer" :depends-on ("packages" "buffer")) (:file "motion" :depends-on ("packages" "buffer" "syntax")) (:file "editing" :depends-on ("packages" "buffer" "syntax" "motion" "kill-ring")) - (:file "base" :depends-on ("packages" "buffer" "persistent-buffer" "kill-ring")) + (:file "base" :depends-on ("packages" "buffer" "persistent-buffer" "kill-ring" + "delegating-buffer")) (:file "syntax" :depends-on ("packages" "buffer" "base")) (:file "views" :depends-on ("packages" "buffer" "base" "syntax" "persistent-undo" "persistent-buffer" "undo" "abbrev" @@ -300,7 +302,6 @@ (:file "abbrev" :depends-on ("packages")) (:file "kill-ring" :depends-on ("packages")) (:file "undo" :depends-on ("packages")) - (:file "delegating-buffer" :depends-on ("packages" "buffer")) (:file "basic-commands" :depends-on ("drei-clim" "motion" "editing")) (:file "core" :depends-on ("drei")) (:file "fundamental-syntax" :depends-on ("packages" "drei-redisplay" "core"))

1 0

[mcclim-cvs] CVS mcclim/Drei/Tests
by thenriksen 19 Dec '07

19 Dec '07

Update of /project/mcclim/cvsroot/mcclim/Drei/Tests In directory clnet:/tmp/cvs-serv9380/Drei/Tests Modified Files: lisp-syntax-tests.lisp motion-tests.lisp Log Message: Added a bunch of neat convenience functions to Lisp syntax. --- /project/mcclim/cvsroot/mcclim/Drei/Tests/lisp-syntax-tests.lisp 2007/12/08 08:53:48 1.8 +++ /project/mcclim/cvsroot/mcclim/Drei/Tests/lisp-syntax-tests.lisp 2007/12/19 17:17:37 1.9 @@ -834,7 +834,10 @@ (motion-fun-one-test up (nil nil (13 14 12) "(defun list () (&rest elements) -(append elements nil))" :syntax lisp-syntax)) +(append elements nil))" :syntax lisp-syntax) + (nil nil (17 19 12) + "(defun list (x y z) +(list x y z))" :syntax lisp-syntax)) (motion-fun-one-test definition (51 52 (35 51 0) "(defun list (&rest elements) @@ -844,12 +847,12 @@ (test in-string-p "Test the `in-string-p' function of Lisp syntax." (testing-lisp-syntax (" \"foobar!\" ") - (is-false (drei-lisp-syntax::in-string-p 0 (current-syntax))) - (is-false (drei-lisp-syntax::in-string-p 1 (current-syntax))) - (is-true (drei-lisp-syntax::in-string-p 2 (current-syntax))) - (is-true (drei-lisp-syntax::in-string-p 6 (current-syntax))) - (is-true (drei-lisp-syntax::in-string-p 9 (current-syntax))) - (is-false (drei-lisp-syntax::in-string-p 10 (current-syntax))))) + (is-false (in-string-p (current-syntax) 0)) + (is-false (in-string-p (current-syntax) 1)) + (is-true (in-string-p (current-syntax) 2)) + (is-true (in-string-p (current-syntax) 6)) + (is-true (in-string-p (current-syntax) 9)) + (is-false (in-string-p (current-syntax) 10)))) (test in-comment-p "Test the `in-comment-p' function of Lisp syntax." @@ -858,17 +861,98 @@ #| I'm a - BLOCK - comment |#") - (is-false (drei-lisp-syntax::in-comment-p 0 (current-syntax))) - (is-false (drei-lisp-syntax::in-comment-p 1 (current-syntax))) - (is-true (drei-lisp-syntax::in-comment-p 2 (current-syntax))) - (is-false (drei-lisp-syntax::in-comment-p 16 (current-syntax))) - (is-false (drei-lisp-syntax::in-comment-p 17 (current-syntax))) - (is-true (drei-lisp-syntax::in-comment-p 18 (current-syntax))) - (is-false (drei-lisp-syntax::in-comment-p 40 (current-syntax))) - (is-true (drei-lisp-syntax::in-comment-p 41 (current-syntax))) - (is-true (drei-lisp-syntax::in-comment-p 50 (current-syntax))) - (is-true (drei-lisp-syntax::in-comment-p 60 (current-syntax))) - (is-false (drei-lisp-syntax::in-comment-p 69 (current-syntax))))) + (is-false (in-comment-p (current-syntax) 0)) + (is-false (in-comment-p (current-syntax) 1)) + (is-true (in-comment-p (current-syntax) 2)) + (is-true (in-comment-p (current-syntax) 16)) + (is-false (in-comment-p (current-syntax) 17)) + (is-true (in-comment-p (current-syntax) 18)) + (is-false (in-comment-p (current-syntax) 40)) + (is-false (in-comment-p (current-syntax) 41)) + (is-true (in-comment-p (current-syntax) 50)) + (is-true (in-comment-p (current-syntax) 60)) + (is-false (in-comment-p (current-syntax) 68)) + (is-false (in-comment-p (current-syntax) 69)))) + +(test in-character-p + "Test the `in-character-p' function of Lisp syntax." + (testing-lisp-syntax ("#\\C #\\( +#\\# +#\\ +hello") + (is-false (in-character-p (current-syntax) 0)) + (is-false (in-character-p (current-syntax) 1)) + (is-true (in-character-p (current-syntax) 2)) + (is-false (in-character-p (current-syntax) 4)) + (is-false (in-character-p (current-syntax) 5)) + (is-true (in-character-p (current-syntax) 6)) + (is-true (in-character-p (current-syntax) 10)) + (is-true (in-character-p (current-syntax) 14)) + (is-false (in-character-p (current-syntax) 16)))) + +(test location-at-beginning-of-form-list + "Test the `location-at-beginning-of-form' function for lists." + (testing-lisp-syntax ("(a b c (d e f) g") + (is-false (location-at-beginning-of-form (current-syntax) 0)) + (is-true (location-at-beginning-of-form (current-syntax) 1)) + (is-false (location-at-beginning-of-form (current-syntax) 2)) + (is-false (location-at-beginning-of-form (current-syntax) 7)) + (is-true (location-at-beginning-of-form (current-syntax) 8)))) + +(test location-at-end-of-form-list + "Test the `location-at-end-of-form' function for lists." + (testing-lisp-syntax ("(a b c (d e f) g)") + (is-false (location-at-end-of-form (current-syntax) 0)) + (is-false (location-at-end-of-form (current-syntax) 1)) + (is-false (location-at-end-of-form (current-syntax) 12)) + (is-true (location-at-end-of-form (current-syntax) 13)) + (is-false (location-at-end-of-form (current-syntax) 14)) + (is-true (location-at-end-of-form (current-syntax) 16)))) + +(test location-at-beginning-of-form-string + "Test the `location-at-beginning-of-form' function for strings." + (testing-lisp-syntax ("\"a b c \"d e f\" g") + (is-false (location-at-beginning-of-form (current-syntax) 0)) + (is-true (location-at-beginning-of-form (current-syntax) 1)) + (is-false (location-at-beginning-of-form (current-syntax) 2)) + (is-false (location-at-beginning-of-form (current-syntax) 7)) + (is-false (location-at-beginning-of-form (current-syntax) 8)) + (is-true (location-at-beginning-of-form (current-syntax) 14)) + (is-false (location-at-beginning-of-form (current-syntax) 15)))) + +(test location-at-end-of-form-string + "Test the `location-at-end-of-form' function for strings." + (testing-lisp-syntax ("\"a b c \"d e f\" g)\"") + (is-false (location-at-end-of-form (current-syntax) 0)) + (is-false (location-at-end-of-form (current-syntax) 1)) + (is-false (location-at-end-of-form (current-syntax) 6)) + (is-true (location-at-end-of-form (current-syntax) 7)) + (is-false (location-at-end-of-form (current-syntax) 8)) + (is-false (location-at-end-of-form (current-syntax) 16)) + (is-true (location-at-end-of-form (current-syntax) 17)) + (is-false (location-at-end-of-form (current-syntax) 18)))) + +(test location-at-beginning-of-form-simple-vector + "Test the `location-at-beginning-of-form' function for simple +vectors." + (testing-lisp-syntax ("#(a b c #(d e f) g") + (is-false (location-at-beginning-of-form (current-syntax) 0)) + (is-false (location-at-beginning-of-form (current-syntax) 1)) + (is-true (location-at-beginning-of-form (current-syntax) 2)) + (is-false (location-at-beginning-of-form (current-syntax) 3)) + (is-false (location-at-beginning-of-form (current-syntax) 9)) + (is-true (location-at-beginning-of-form (current-syntax) 10)))) + +(test location-at-end-of-form-simple-vector + "Test the `location-at-end-of-form' function for simple-vectors." + (testing-lisp-syntax ("#(a b c #(d e f) g)") + (is-false (location-at-end-of-form (current-syntax) 0)) + (is-false (location-at-end-of-form (current-syntax) 1)) + (is-false (location-at-end-of-form (current-syntax) 2)) + (is-false (location-at-end-of-form (current-syntax) 14)) + (is-true (location-at-end-of-form (current-syntax) 15)) + (is-false (location-at-end-of-form (current-syntax) 16)) + (is-true (location-at-end-of-form (current-syntax) 18)))) ;; For some tests, we need various functions, classes and ;; macros. Define them here and pray we don't clobber anything --- /project/mcclim/cvsroot/mcclim/Drei/Tests/motion-tests.lisp 2007/12/08 08:53:48 1.5 +++ /project/mcclim/cvsroot/mcclim/Drei/Tests/motion-tests.lisp 2007/12/19 17:17:37 1.6 @@ -86,74 +86,79 @@ (backward-to-word-boundary m2r syntax) (is (= (offset m2r) 0)))))) -(defmacro motion-fun-one-test (unit (forward-begin-offset - backward-end-offset - (offset goal-forward-offset goal-backward-offset) - initial-contents - &key (syntax 'drei-fundamental-syntax:fundamental-syntax))) - (check-type forward-begin-offset (or integer null)) - (check-type backward-end-offset (or integer null)) - (check-type offset integer) - (check-type goal-forward-offset integer) - (check-type goal-backward-offset integer) +(defmacro motion-fun-one-test (unit &rest test-specs) (let ((forward (intern (format nil "FORWARD-ONE-~S" unit))) (backward (intern (format nil "BACKWARD-ONE-~S" unit)))) `(progn - (test ,(intern (format nil "~A-~A" syntax forward) #.*package*) - (with-buffer (buffer :initial-contents ,initial-contents) - (with-view (view :buffer buffer :syntax ',syntax) - (let ((syntax (syntax view)) - (m0l (make-buffer-mark buffer 0 :left)) - (m0r (make-buffer-mark buffer 0 :right)) - (m1l (make-buffer-mark buffer ,offset :left)) - (m1r (make-buffer-mark buffer ,offset :right)) - (m2l (make-buffer-mark buffer (size buffer) :left)) - (m2r (make-buffer-mark buffer (size buffer) :right))) - (declare (ignore ,@(unless forward-begin-offset '(m0l)) - ,@(unless backward-end-offset '(m0r)))) - ,(when forward-begin-offset - `(progn - (is-true (,forward m0l syntax)) - (is (= ,forward-begin-offset (offset m0l))))) - ,(when backward-end-offset - `(progn - (is-true (,forward m0r syntax)) - (is (= ,forward-begin-offset (offset m0r))))) - (is-true (,forward m1l syntax)) - (is (= ,goal-forward-offset (offset m1l))) - (is-true (,forward m1r syntax)) - (is (= ,goal-forward-offset (offset m1r))) - (is-false (,forward m2l syntax)) - (is (= (size buffer) (offset m2l))) - (is-false (,forward m2r syntax)) - (is (= (size buffer) (offset m2r))))))) - (test ,(intern (format nil "~A-~A" syntax backward) #.*package*) - (with-buffer (buffer :initial-contents ,initial-contents) - (with-view (view :buffer buffer :syntax ',syntax) - (let ((syntax (syntax view)) - (m0l (make-buffer-mark buffer 0 :left)) - (m0r (make-buffer-mark buffer 0 :right)) - (m1l (make-buffer-mark buffer ,offset :left)) - (m1r (make-buffer-mark buffer ,offset :right)) - (m2l (make-buffer-mark buffer (size buffer) :left)) - (m2r (make-buffer-mark buffer (size buffer) :right))) - (declare (ignore ,@(unless backward-end-offset '(m2l m2r)))) - (is-false (,backward m0l syntax)) - (is (= 0 (offset m0l))) - (is-false (,backward m0r syntax)) - (is (= 0 (offset m0r))) - (is-true (,backward m1l syntax)) - (is (= ,goal-backward-offset (offset m1l))) - (is-true (,backward m1r syntax)) - (is (= ,goal-backward-offset (offset m1r))) - ,(when backward-end-offset - `(progn - (is-true (,backward m2l syntax)) - (is (= ,backward-end-offset (offset m2l))))) - ,(when backward-end-offset - `(progn - (is-true (,backward m2r syntax)) - (is (= ,backward-end-offset (offset m2r)))))))))))) + ,@(loop for test in test-specs + nconc + (destructuring-bind (forward-begin-offset + backward-end-offset + (offset goal-forward-offset goal-backward-offset) + initial-contents + &key (syntax 'drei-fundamental-syntax::fundamental-syntax)) + test + (check-type forward-begin-offset (or integer null)) + (check-type backward-end-offset (or integer null)) + (check-type offset integer) + (check-type goal-forward-offset integer) + (check-type goal-backward-offset integer) + (list + `(test ,(intern (format nil "~A-~A" syntax forward) #.*package*) + (with-buffer (buffer :initial-contents ,initial-contents) + (with-view (view :buffer buffer :syntax ',syntax) + (let ((syntax (syntax view)) + (m0l (make-buffer-mark buffer 0 :left)) + (m0r (make-buffer-mark buffer 0 :right)) + (m1l (make-buffer-mark buffer ,offset :left)) + (m1r (make-buffer-mark buffer ,offset :right)) + (m2l (make-buffer-mark buffer (size buffer) :left)) + (m2r (make-buffer-mark buffer (size buffer) :right))) + (declare (ignore ,@(unless forward-begin-offset '(m0l)) + ,@(unless backward-end-offset '(m0r)))) + ,(when forward-begin-offset + `(progn + (is-true (,forward m0l syntax)) + (is (= ,forward-begin-offset (offset m0l))))) + ,(when backward-end-offset + `(progn + (is-true (,forward m0r syntax)) + (is (= ,forward-begin-offset (offset m0r))))) + (is-true (,forward m1l syntax)) + (is (= ,goal-forward-offset (offset m1l))) + (is-true (,forward m1r syntax)) + (is (= ,goal-forward-offset (offset m1r))) + (is-false (,forward m2l syntax)) + (is (= (size buffer) (offset m2l))) + (is-false (,forward m2r syntax)) + (is (= (size buffer) (offset m2r))))))) + `(test ,(intern (format nil "~A-~A" syntax backward) #.*package*) + (with-buffer (buffer :initial-contents ,initial-contents) + (with-view (view :buffer buffer :syntax ',syntax) + (let ((syntax (syntax view)) + (m0l (make-buffer-mark buffer 0 :left)) + (m0r (make-buffer-mark buffer 0 :right)) + (m1l (make-buffer-mark buffer ,offset :left)) + (m1r (make-buffer-mark buffer ,offset :right)) + (m2l (make-buffer-mark buffer (size buffer) :left)) + (m2r (make-buffer-mark buffer (size buffer) :right))) + (declare (ignore ,@(unless backward-end-offset '(m2l m2r)))) + (is-false (,backward m0l syntax)) + (is (= 0 (offset m0l))) + (is-false (,backward m0r syntax)) + (is (= 0 (offset m0r))) + (is-true (,backward m1l syntax)) + (is (= ,goal-backward-offset (offset m1l))) + (is-true (,backward m1r syntax)) + (is (= ,goal-backward-offset (offset m1r))) + ,(when backward-end-offset + `(progn + (is-true (,backward m2l syntax)) + (is (= ,backward-end-offset (offset m2l))))) + ,(when backward-end-offset + `(progn + (is-true (,backward m2r syntax)) + (is (= ,backward-end-offset (offset m2r))))))))))))))) (motion-fun-one-test word (9 10 (5 9 2) " climacs

1 0

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

19 Dec '07

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv9380/Drei Modified Files: lisp-syntax.lisp lr-syntax.lisp packages.lisp views.lisp Log Message: Added a bunch of neat convenience functions to Lisp syntax. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2007/12/13 07:30:37 1.36 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2007/12/19 17:17:37 1.37 @@ -1315,6 +1315,10 @@ "Returns the third formw in list." (nth-form 2 list)) +(defun form-children (form) + "Return the children of `form' that are themselves forms." + (remove-if-not #'formp (children form))) + (defgeneric form-operator (syntax form) (:documentation "Return the operator of `form' as a token. Returns nil if none can be found.") @@ -1448,6 +1452,9 @@ (define-form-predicate form-comma-p (comma-form)) (define-form-predicate form-comma-at-p (comma-at-form)) (define-form-predicate form-comma-dot-p (comma-dot-form)) +(define-form-predicate form-character-p (complete-character-lexeme + incomplete-character-lexeme)) +(define-form-predicate form-simple-vector-p (simple-vector-form)) (define-form-predicate comment-p (comment)) @@ -1460,6 +1467,176 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Asking about parse state at some point + +(defun in-type-p-in-children (children offset type) + (loop for child in children + do (cond ((<= (start-offset child) offset (end-offset child)) + (return (if (typep child type) + child + (in-type-p-in-children (children child) offset type)))) + ((<= offset (start-offset child)) + (return nil)) + (t nil)))) + +(defun in-type-p (syntax mark-or-offset type) + (as-offsets ((offset mark-or-offset)) + (update-parse syntax 0 offset) + (with-slots (stack-top) syntax + (if (or (null (start-offset stack-top)) + (> offset (end-offset stack-top)) + (< offset (start-offset stack-top))) + nil + (in-type-p-in-children (children stack-top) offset type))))) + +(defun in-string-p (syntax mark-or-offset) + "Return true if `mark-or-offset' is inside a Lisp string." + (as-offsets ((offset mark-or-offset)) + (let ((string (in-type-p syntax offset 'string-form))) + (and string + (< (start-offset string) offset) + (< offset (end-offset string)))))) + +(defun in-comment-p (syntax mark-or-offset) + "Return true if `mark-or-offset' is inside a Lisp +comment (line-based or long form)." + (as-offsets ((offset mark-or-offset)) + (let ((comment (in-type-p syntax mark-or-offset 'comment))) + (and comment + (or (when (typep comment 'line-comment-form) + (< (start-offset comment) offset)) + (when (typep comment 'complete-long-comment-form) + (< (1+ (start-offset comment) ) offset + (1- (end-offset comment)))) + (when (typep comment 'incomplete-long-comment-form) + (< (1+ (start-offset comment)) offset))))))) + +(defun in-character-p (syntax mark-or-offset) + "Return true if `mark-or-offset' is inside a Lisp character lexeme." + (as-offsets ((offset mark-or-offset)) + (let ((form (form-around syntax offset))) + (typecase form + (complete-character-lexeme + (> (end-offset form) offset (+ (start-offset form) 1))) + (incomplete-character-lexeme + (= offset (end-offset form))))))) + +(defgeneric at-beginning-of-form-p (syntax form offset) + (:documentation "Return true if `offset' is at the beginning of +the list-like `form', false otherwise. \"Beginning\" is defined +at the earliest point the contents could be entered, for example +right after the opening parenthesis for a list.") + (:method ((syntax lisp-syntax) (form form) (offset integer)) + nil) + (:method :before ((syntax lisp-syntax) (form form) (offset integer)) + (update-parse syntax 0 offset))) + +(defgeneric at-end-of-form-p (syntax form offset) + (:documentation "Return true if `offset' is at the end of the +list-like `form', false otherwise.") + (:method ((syntax lisp-syntax) (form form) (offset integer)) + nil) + (:method :before ((syntax lisp-syntax) (form form) (offset integer)) + (update-parse syntax 0 offset))) + +(defmethod at-beginning-of-form-p ((syntax lisp-syntax) (form list-form) + (offset integer)) + (= offset (1+ (start-offset form)))) + +(defmethod at-end-of-form-p ((syntax lisp-syntax) (form list-form) + (offset integer)) + (= offset (1- (end-offset form)))) + +(defmethod at-beginning-of-form-p ((syntax lisp-syntax) (form string-form) + (offset integer)) + (= offset (1+ (start-offset form)))) + +(defmethod at-end-of-form-p ((syntax lisp-syntax) (form string-form) + (offset integer)) + (= offset (1- (end-offset form)))) + +(defmethod at-beginning-of-form-p ((syntax lisp-syntax) (form simple-vector-form) + (offset integer)) + (= offset (+ 2 (start-offset form)))) + +(defmethod at-end-of-form-p ((syntax lisp-syntax) (form simple-vector-form) + (offset integer)) + (= offset (1- (end-offset form)))) + +(defun location-at-beginning-of-form (syntax mark-or-offset) + "Return true if the position `mark-or-offset' is at the +beginning of some structural form, false otherwise. \"Beginning\" +is defined by what type of form is at `mark-or-offset', but for a +list form, it would be right after the opening parenthesis." + (as-offsets ((offset mark-or-offset)) + (update-parse syntax 0 offset) + (let ((form-around (form-around syntax offset))) + (when form-around + (labels ((recurse (form) + (or (at-beginning-of-form-p syntax form offset) + (unless (form-at-top-level-p form) + (recurse (parent form)))))) + (recurse form-around)))))) + +(defun location-at-end-of-form (syntax mark-or-offset) + "Return true if the position `mark-or-offset' is at the +end of some structural form, false otherwise. \"End\" +is defined by what type of form is at `mark-or-offset', but for a +list form, it would be right before the closing parenthesis." + (as-offsets ((offset mark-or-offset)) + (update-parse syntax 0 offset) + (let ((form-around (form-around syntax offset))) + (when form-around + (labels ((recurse (form) + (or (at-end-of-form-p syntax form offset) + (unless (form-at-top-level-p form) + (recurse (parent form)))))) + (recurse form-around)))))) + +(defun at-beginning-of-list-p (syntax mark-or-offset) + "Return true if the position `mark-or-offset' is at the +beginning of a list-like form, false otherwise. \"Beginning\" is +defined as the earliest point the contents could be entered, for +example right after the opening parenthesis for a list." + (as-offsets ((offset mark-or-offset)) + (update-parse syntax 0 offset) + (let ((form-around (form-around syntax offset))) + (when (form-list-p form-around) + (at-beginning-of-form-p syntax form-around offset))))) + +(defun at-end-of-list-p (syntax mark-or-offset) + "Return true if the position `mark-or-offset' is at the end of +a list-like form, false otherwise. \"End\" is defined as the +latest point the contents could be entered, for example right +before the closing parenthesis for a list." + (as-offsets ((offset mark-or-offset)) + (update-parse syntax 0 offset) + (let ((form-around (form-around syntax offset))) + (when (form-list-p form-around) + (at-end-of-form-p syntax (form-around syntax offset) offset))))) + +(defun at-beginning-of-string-p (syntax mark-or-offset) + "Return true if the position `mark-or-offset' is at the +beginning of a string form, false otherwise. \"Beginning\" is +right after the opening double-quote." + (as-offsets ((offset mark-or-offset)) + (update-parse syntax 0 offset) + (let ((form-around (form-around syntax offset))) + (when (form-string-p form-around) + (at-beginning-of-form-p syntax form-around offset))))) + +(defun at-end-of-string-p (syntax mark-or-offset) + "Return true if the position `mark-or-offset' is at the end of +a list-like form, false otherwise. \"End\" is right before the +ending double-quote." + (as-offsets ((offset mark-or-offset)) + (update-parse syntax 0 offset) + (let ((form-around (form-around syntax offset))) + (when (form-string-p form-around) + (at-end-of-form-p syntax form-around offset))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; Useful functions for modifying forms based on the mark. (defgeneric replace-symbol-at-mark (syntax mark string) @@ -1832,7 +2009,7 @@ a list parent cannot be found, return nil" (let ((parent (parent form))) (typecase parent - (list-form (funcall fn form)) + (list-form (funcall fn parent)) ((or form* null) nil) (t (find-list-parent-offset parent fn))))) @@ -1956,31 +2133,6 @@ do (setf (offset mark) (end-offset form)) and do (return t)))) -(defun in-type-p-in-children (children offset type) - (loop for child in children - do (cond ((< (start-offset child) offset (end-offset child)) - (return (if (typep child type) - child - (in-type-p-in-children (children child) offset type)))) - ((<= offset (start-offset child)) - (return nil)) - (t nil)))) - -(defun in-type-p (mark-or-offset syntax type) - (as-offsets ((offset mark-or-offset)) - (with-slots (stack-top) syntax - (if (or (null (start-offset stack-top)) - (>= offset (end-offset stack-top)) - (<= offset (start-offset stack-top))) - nil) - (in-type-p-in-children (children stack-top) offset type)))) - -(defun in-string-p (mark-or-offset syntax) - (in-type-p mark-or-offset syntax 'string-form)) - -(defun in-comment-p (mark-or-offset syntax) - (in-type-p mark-or-offset syntax 'comment)) - (defmethod eval-defun ((mark mark) (syntax lisp-syntax)) (with-slots (stack-top) syntax (loop for form in (children stack-top) --- /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2007/12/10 21:25:12 1.4 +++ /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2007/12/19 17:17:37 1.5 @@ -84,7 +84,7 @@ (defclass parser-symbol () ((start-mark :initform nil :initarg :start-mark :reader start-mark) - (size :initform nil :initarg :size) + (size :initform nil :initarg :size :reader size) (parent :initform nil :accessor parent) (children :initform '() :initarg :children :reader children) (preceding-parse-tree :initform nil :reader preceding-parse-tree) --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2007/12/18 08:39:43 1.22 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2007/12/19 17:17:37 1.23 @@ -492,12 +492,49 @@ :drei-syntax :drei-fundamental-syntax :flexichain :drei :drei-motion :drei-editing :esa-utils :esa :drei-core :esa-io :drei-lr-syntax) - (:export #:lisp-syntax + (:export #:lisp-syntax #:lisp-table #:lisp-string #:edit-definition #:form #:form-to-object + ;; Selecting forms based on mark + #:form-around #:form-before #:form-after + #:expression-at-mark + #:definition-at-mark + #:symbol-at-mark + #:fully-quoted-form + #:fully-unquoted-form + #:this-form + + ;; Querying forms + #:formp #:form-list-p + #:form-incomplete-p #:form-complete-p + #:form-token-p #:form-string-p + #:form-quoted-p + #:form-comma-p #:form-comma-at-p #:form-comma-dot-p + #:form-character-p + #:form-simple-vector-p + #:comment-p + #:form-at-top-level-p + + ;; Querying form data + #:form-children + #:form-operator #:form-operands + #:form-toplevel + #:form-operator-p + + ;; Querying about state at mark + #:in-string-p + #:in-comment-p + #:in-character-p + #:location-at-beginning-of-form + #:location-at-end-of-form + #:at-beginning-of-list-p + #:at-end-of-list-p + #:at-beginning-of-string-p + #:at-end-of-string-p + ;; Lambda list classes. #:lambda-list #:semiordinary-lambda-list --- /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2007/12/18 08:39:43 1.6 +++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp 2007/12/19 17:17:37 1.7 @@ -520,7 +520,11 @@ (%suffix-size :accessor suffix-size :initform 0 :documentation "The number of unchanged objects -at the end of the buffer.")) +at the end of the buffer.") + (%recorded-buffer-size :accessor buffer-size + :initform 0 + :documentation "The size of the buffer +the last time the view was synchronized.")) (:documentation "A buffer-view that maintains a parse tree of the buffer, or otherwise pays attention to the syntax of the buffer.")) @@ -552,6 +556,7 @@ (point point) (mark mark) (suffix-size suffix-size) (prefix-size prefix-size) + (buffer-size buffer-size) (bot bot) (top top)) view (setf point (clone-mark (point buffer)) mark (clone-mark (point buffer) :right) @@ -559,6 +564,7 @@ view-syntax (make-syntax-for-view view (class-of view-syntax)) prefix-size 0 suffix-size 0 + buffer-size (size buffer) ;; Also set the top and bot marks. top (make-buffer-mark buffer 0 :left) bot (make-buffer-mark buffer (size buffer) :right)) @@ -573,7 +579,8 @@ ;; We need to reparse the buffer completely. Might as well do it ;; now. (setf (prefix-size view) 0 - (suffix-size view) 0) + (suffix-size view) 0 + (buffer-size view) (size (buffer view))) (synchronize-view view :force-p t)) (defmethod observer-notified ((view drei-syntax-view) (buffer drei-buffer) @@ -588,7 +595,8 @@ (defmethod synchronize-view :around ((view drei-syntax-view) &key force-p) ;; If nothing changed, then don't call the other methods. - (unless (and (= (prefix-size view) (suffix-size view) (size (buffer view))) + (unless (and (= (prefix-size view) (suffix-size view) + (size (buffer view)) (buffer-size view)) (not force-p)) (call-next-method))) @@ -603,7 +611,8 @@ ;; Reset here so if `update-syntax' calls `update-parse' itself, ;; we won't end with infinite recursion. (setf (prefix-size view) (size (buffer view)) - (suffix-size view) (size (buffer view))) + (suffix-size view) (size (buffer view)) + (buffer-size view) (size (buffer view))) (update-syntax (syntax view) prefix-size suffix-size begin end)))

1 0

[mcclim-cvs] CVS mcclim/ESA
by thenriksen 19 Dec '07

19 Dec '07

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv18011/ESA Modified Files: packages.lisp Log Message: *numeric-argument-p* no longer exists, so don't export it. --- /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2007/12/08 08:53:48 1.6 +++ /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2007/12/19 15:10:20 1.7 @@ -59,7 +59,7 @@ #:esa-pane-mixin #:previous-command #:info-pane #:master-pane #:esa-frame-mixin #:recordingp #:executingp - #:*esa-abort-gestures* #:*numeric-argument-p* #:*current-gesture* #:*command-processor* + #:*esa-abort-gestures* #:*current-gesture* #:*command-processor* #:unbound-gesture-sequence #:gestures #:command-processor #:instant-macro-execution-mixin #:asynchronous-command-processor #:command-loop-command-processor

1 0

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

19 Dec '07

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv29422/Drei Modified Files: unicode-commands.lisp misc-commands.lisp lisp-syntax-commands.lisp editing.lisp core-commands.lisp basic-commands.lisp Log Message: Use the default value of the parameter for parameters specified to use the value of the numeric argument, when no numeric argument is provided. Changed Drei command definitions to handle this. --- /project/mcclim/cvsroot/mcclim/Drei/unicode-commands.lisp 2006/11/08 01:15:33 1.1 +++ /project/mcclim/cvsroot/mcclim/Drei/unicode-commands.lisp 2007/12/19 11:02:01 1.2 @@ -34,7 +34,7 @@ 'self-insert-table (list (code-char i)))) (define-command (com-insert-charcode :name t :command-table self-insert-table) - ((code 'integer :prompt "Code point") (count 'integer)) + ((code 'integer :prompt "Code point") (count 'integer :default 1)) (let ((char (code-char code))) (loop repeat count do (insert-character char)))) --- /project/mcclim/cvsroot/mcclim/Drei/misc-commands.lisp 2007/11/19 20:28:43 1.3 +++ /project/mcclim/cvsroot/mcclim/Drei/misc-commands.lisp 2007/12/19 11:02:01 1.4 @@ -32,7 +32,7 @@ (define-command (com-eval-expression :name t :command-table editor-table) ((exp 'expression :prompt "Eval") - (insertp 'boolean :prompt "Insert?")) + (insertp 'boolean :prompt "Insert?" :default nil)) "Prompt for and evaluate a lisp expression. With a numeric argument inserts the result at point as a string; otherwise prints the result." @@ -66,7 +66,7 @@ (chars (abs (- (offset (point)) (offset (mark)))))) (display-message "Region has ~D line~:P, ~D character~:P." (1+ lines) chars))) -(set-key `(com-eval-expression ,*unsupplied-argument-marker* ,*numeric-argument-p*) +(set-key `(com-eval-expression ,*unsupplied-argument-marker* ,*numeric-argument-marker*) 'editor-table '((#\: :shift :meta))) --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-commands.lisp 2007/12/17 06:47:13 1.13 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-commands.lisp 2007/12/19 11:02:02 1.14 @@ -70,7 +70,7 @@ t))))) (define-command (com-indent-expression :name t :command-table lisp-table) - ((count 'integer :prompt "Number of expressions")) + ((count 'integer :prompt "Number of expressions" :default 1)) (let ((mark (point))) (if (plusp count) (loop repeat count do (forward-expression mark (current-syntax))) @@ -150,7 +150,7 @@ (eval-region mark point (current-syntax)))) (define-command (com-eval-last-expression :name t :command-table pane-lisp-table) - ((insertp 'boolean :prompt "Insert?")) + ((insertp 'boolean :prompt "Insert?" :default nil)) "Evaluate the expression before point in the local Lisp image." (let ((token (form-before (current-syntax) (offset (point))))) (if token @@ -240,7 +240,7 @@ 'pane-lisp-table '((#\c :control) (#\r :control))) -(set-key `(com-eval-last-expression ,*numeric-argument-p*) +(set-key `(com-eval-last-expression ,*numeric-argument-marker*) 'pane-lisp-table '((#\c :control) (#\e :control))) --- /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2007/12/08 08:53:50 1.7 +++ /project/mcclim/cvsroot/mcclim/Drei/editing.lisp 2007/12/19 11:02:02 1.8 @@ -254,7 +254,7 @@ (defun backward-kill-object (mark &optional (count 1) concatenate-p limit-action) "Kill `count' objects backwards beginning from `mark'." (let ((start (offset mark))) - (handler-case (progn (forward-object mark count) + (handler-case (progn (backward-object mark count) (if concatenate-p (if (plusp count) (kill-ring-concatenating-push --- /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2007/12/17 06:47:13 1.10 +++ /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp 2007/12/19 11:02:05 1.11 @@ -99,7 +99,7 @@ '((#\z :meta))) (define-command (com-open-line :name t :command-table editing-table) - ((numarg 'integer :prompt "How many lines?")) + ((numarg 'integer :prompt "How many lines?" :default 1)) "Insert a #\Newline and leave point before it. With a numeric argument greater than 1, insert that many #\Newlines." (open-line (point) numarg)) @@ -125,7 +125,7 @@ `(define-command (,(symbol "COM-MARK-" unit) :name t :command-table ,command-table) - ((count 'integer :prompt ,(concat "Number of " plural))) + ((count 'integer :prompt ,(concat "Number of " plural) :default 1)) ,(if (not (null move-point)) (concat "Place point and mark around the current " noun ". Put point at the beginning of the current " noun ", and mark at the end. @@ -349,17 +349,17 @@ (define-command (com-delete-horizontal-space :name t :command-table deletion-table) ((backward-only-p - 'boolean :prompt "Delete backwards only?")) + 'boolean :prompt "Delete backwards only?" :default nil)) "Delete whitespace around point. With a numeric argument, only delete whitespace before point." (delete-horizontal-space (point) (current-syntax) backward-only-p)) -(set-key `(com-delete-horizontal-space ,*numeric-argument-p*) +(set-key `(com-delete-horizontal-space ,*numeric-argument-marker*) 'deletion-table '((#\\ :meta))) (define-command (com-just-one-space :name t :command-table deletion-table) - ((count 'integer :prompt "Number of spaces")) + ((count 'integer :prompt "Number of spaces" :default 1)) "Delete whitespace around point, leaving a single space. With a positive numeric argument, leave that many spaces. @@ -402,7 +402,7 @@ '((#\x :control) (#\x :control))) (define-command (com-sort-lines :name t :command-table editing-table) - ((sort-ascending 'boolean :prompt "Sort in ascending order")) + ((sort-ascending 'boolean :prompt "Sort in ascending order" :default nil)) "Sort the lines in the region delimited by current point and mark. The lines will be lexicographically sorted, ignoring all non-character objects in the lines. When the command is run, it @@ -481,7 +481,7 @@ '((#\y :meta))) (define-command (com-resize-kill-ring :name t :command-table editing-table) - ((size 'integer :prompt "New kill ring size")) + ((size 'integer :prompt "New kill ring size" :default 5)) "Prompt for a new size for the kill ring. The default is 5. A number less than 5 will be replaced by 5." (setf (kill-ring-max-size *kill-ring*) size)) @@ -572,8 +572,8 @@ '((#\/ :meta))) (define-command (com-mark-page :name t :command-table marking-table) - ((count 'integer :prompt "Move how many pages") - (numargp 'boolean :prompt "Move to another page?")) + ((count 'integer :prompt "Move how many pages" :default 1) + (numargp 'boolean :prompt "Move to another page?" :default nil)) "Place point and mark around the current page. With a numeric argument, move point that many pages forward (backward if negative) before marking the @@ -589,7 +589,7 @@ (setf (offset (mark)) (offset (point))) (forward-page (mark) (current-syntax) 1)) -(set-key `(com-mark-page ,*numeric-argument-marker* ,*numeric-argument-p*) +(set-key `(com-mark-page ,*numeric-argument-marker* ,*numeric-argument-marker*) 'marking-table '((#\x :control) (#\p :control))) @@ -608,15 +608,15 @@ (insert-pair mark syntax count #\( #\))) (define-command (com-insert-parentheses :name t :command-table editing-table) - ((count 'integer :prompt "Number of expressions") - (wrap-p 'boolean :prompt "Wrap expressions?")) + ((count 'integer :prompt "Number of expressions" :default 1) + (wrap-p 'boolean :prompt "Wrap expressions?" :default nil)) "Insert a pair of parentheses, leaving point in between. With a numeric argument, enclose that many expressions forward (backward if negative)." (unless wrap-p (setf count 0)) (insert-parentheses (point) (current-syntax) count)) -(set-key `(com-insert-parentheses ,*numeric-argument-marker* ,*numeric-argument-p*) +(set-key `(com-insert-parentheses ,*numeric-argument-marker* ,*numeric-argument-marker*) 'editing-table '((#\( :meta))) --- /project/mcclim/cvsroot/mcclim/Drei/basic-commands.lisp 2007/12/08 08:53:50 1.8 +++ /project/mcclim/cvsroot/mcclim/Drei/basic-commands.lisp 2007/12/19 11:02:05 1.9 @@ -85,7 +85,7 @@ `(PROGN (DEFINE-COMMAND (,com-forward :NAME T :COMMAND-TABLE ,command-table) - ((COUNT 'INTEGER :PROMPT ,(concat "Number of " plural))) + ((COUNT 'INTEGER :PROMPT ,(concat "Number of " plural) :default 1)) ,(concat "Move point forward by one " noun ". With a numeric argument N, move point forward by N " plural ". With a negative argument -N, move point backward by N " plural ".") @@ -93,10 +93,9 @@ (,forward (point) (current-syntax) COUNT))) - (DEFINE-COMMAND (,com-backward - :NAME T + (DEFINE-COMMAND (,com-backward :NAME T :COMMAND-TABLE ,command-table) - ((COUNT 'INTEGER :PROMPT ,(concat "Number of " plural))) + ((COUNT 'INTEGER :PROMPT ,(concat "Number of " plural) :default 1)) ,(concat "Move point backward by one " noun ". With a numeric argument N, move point backward by N " plural ". With a negative argument -N, move point forward by N " plural ".") @@ -119,7 +118,7 @@ ;; and BACKWARD-OBJECT is part of the buffer protocol, not the ;; high-level motion abstraction. (define-command (com-forward-object :name t :command-table movement-table) - ((count 'integer :prompt "Number of objects")) + ((count 'integer :prompt "Number of objects" :default 1)) "Move point forward by one object. With a numeric argument N, move point forward by N objects. With a negative argument -N, move point backward by M objects." @@ -128,7 +127,7 @@ count))) (define-command (com-backward-object :name t :command-table movement-table) - ((count 'integer :prompt "number of objects")) + ((count 'integer :prompt "number of objects" :default 1)) "Move point backward by one object. With a numeric argument N, move point backward by N objects. With a negative argument -N, move point forward by N objects." @@ -278,7 +277,7 @@ ;; Kill Unit (define-command (,com-kill :name t :command-table ,command-table) - ((count 'integer :prompt ,(concat "Number of " plural))) + ((count 'integer :prompt ,(concat "Number of " plural) :default 1)) ,(concat "Kill " plural " up to the next " noun " end. With a numeric argument, kill forward (backward if negative) that many " plural ". @@ -294,7 +293,7 @@ (define-command (,com-backward-kill :name t :command-table ,command-table) - ((count 'integer :prompt ,(concat "Number of " plural))) + ((count 'integer :prompt ,(concat "Number of " plural) :default 1)) ,(concat "Kill from point until the previous " noun " beginning. With a numeric argument, kill backward (forward, if negative) that many " plural ". @@ -308,14 +307,14 @@ ;; Delete Unit (define-command (,com-delete :name t :command-table ,command-table) - ((count 'integer :prompt ,(concat "Number of " plural))) + ((count 'integer :prompt ,(concat "Number of " plural) :default 1)) ,(concat "Delete from point until the next " noun " end. With a positive numeric argument, delete that many " plural " forward.") (,backward-delete (point) (current-syntax) count)) ;; Backward Delete Unit (define-command (,com-backward-delete :name t :command-table ,command-table) - ((count 'integer :prompt ,(concat "Number of " plural))) + ((count 'integer :prompt ,(concat "Number of " plural) :default 1)) ,(concat "Delete from point until the previous " noun " beginning. With a positive numeric argument, delete that many " plural " backward.") (,backward-delete (point) (current-syntax) count))))))) @@ -363,8 +362,8 @@ (transpose-objects (point))) (define-command (com-delete-object :name t :command-table deletion-table) - ((count 'integer :prompt "Number of Objects") - (killp 'boolean :prompt "Kill?")) + ((count 'integer :prompt "Number of Objects" :default 1) + (killp 'boolean :prompt "Kill?" :default nil)) "Delete the object after point. With a numeric argument, kill that many objects after (or before, if negative) point." @@ -374,8 +373,8 @@ (forward-delete-object (point) count)))) (define-command (com-backward-delete-object :name t :command-table deletion-table) - ((count 'integer :prompt "Number of Objects") - (killp 'boolean :prompt "Kill?")) + ((count 'integer :prompt "Number of Objects" :default 1) + (killp 'boolean :prompt "Kill?" :default nil)) "Delete the object before point. With a numeric argument, kills that many objects before (or after, if negative) point." @@ -415,8 +414,8 @@ (delete-region start mark)))) (define-command (com-kill-line :name t :command-table deletion-table) - ((numarg 'integer :prompt "Kill how many lines?") - (numargp 'boolean :prompt "Kill entire lines?")) + ((numarg 'integer :prompt "Kill how many lines?" :default 1) + (numargp 'boolean :prompt "Kill entire lines?" :default nil)) "Kill the objects on the current line after point. When at the end of a line, kill the #\\Newline. With a numeric argument of 0, kill the objects on the current line before point. @@ -456,17 +455,17 @@ '((#\x :control) (#\t :control))) (set-key `(com-delete-object ,*numeric-argument-marker* - ,*numeric-argument-p*) + ,*numeric-argument-marker*) 'deletion-table '(#\Rubout)) (set-key `(com-delete-object ,*numeric-argument-marker* - ,*numeric-argument-p*) + ,*numeric-argument-marker*) 'deletion-table '((#\d :control))) (set-key `(com-backward-delete-object ,*numeric-argument-marker* - ,*numeric-argument-p*) + ,*numeric-argument-marker*) 'deletion-table '(#\Backspace)) @@ -474,7 +473,7 @@ 'editing-table '((#\t :control))) -(set-key `(com-kill-line ,*numeric-argument-marker* ,*numeric-argument-p*) +(set-key `(com-kill-line ,*numeric-argument-marker* ,*numeric-argument-marker*) 'deletion-table '((#\k :control))) @@ -485,7 +484,7 @@ ;;; These are what do the basic keypress->character inserted in buffer ;;; mapping. -(define-command com-self-insert ((count 'integer)) +(define-command com-self-insert ((count 'integer :default 1)) (loop repeat count do (insert-character *current-gesture*))) (loop for code from (char-code #\Space) to (char-code #\~)

1 0

[mcclim-cvs] CVS mcclim/ESA
by thenriksen 19 Dec '07

19 Dec '07

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv29422/ESA Modified Files: esa.lisp esa-command-parser.lisp Log Message: Use the default value of the parameter for parameters specified to use the value of the numeric argument, when no numeric argument is provided. Changed Drei command definitions to handle this. --- /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/12/08 08:53:48 1.12 +++ /project/mcclim/cvsroot/mcclim/ESA/esa.lisp 2007/12/19 11:01:57 1.13 @@ -353,8 +353,6 @@ "While a command is being run, this symbol will be dynamically bound to the current command processor.") -(defvar *numeric-argument-p* (list nil)) - (defun find-gestures (gestures start-table) (loop with table = (find-command-table start-table) for (gesture . rest) on gestures @@ -623,9 +621,6 @@ (t (values 1 nil (when first-gesture (cons first-gesture gestures))))))) -(defun substitute-numeric-argument-p (command numargp) - (substitute numargp *numeric-argument-p* command :test #'eq)) - (defgeneric process-gestures (command-processor) (:documentation "Process the gestures accumulated in `command-processor', returning T if there are no gestures @@ -655,14 +650,14 @@ (*current-gesture* (first (last gestures)))) (unless (consp command) (setf command (list command))) - (setf command (substitute-numeric-argument-marker command prefix-arg)) - (setf command (substitute-numeric-argument-p command prefix-p)) - (unwind-protect (when (member *unsupplied-argument-marker* command :test #'eq) - (setq command - (funcall - *partial-command-parser* - (command-table command-processor) - *standard-input* command 0))) + ;; Call `*partial-command-parser*' to handle numeric + ;; argument. + (unwind-protect (setq command + (funcall + *partial-command-parser* + (command-table command-processor) + *standard-input* command 0 (when prefix-p + prefix-arg))) ;; If we are macrorecording, store whatever the user ;; did to invoke this command. (when (recordingp command-processor) @@ -1316,8 +1311,7 @@ (mapcar #'(lambda (arg) (cond ((eq arg *unsupplied-argument-marker*) "unsupplied-argument") - ((or (eq arg *numeric-argument-marker*) - (eq arg *numeric-argument-p*)) + ((eq arg *numeric-argument-marker*) "numeric-argument") (t arg))) command-args))) (terpri stream) @@ -1402,7 +1396,7 @@ #'sort-by-keystrokes #'sort-by-name)))) -(set-key `(com-describe-bindings ,*numeric-argument-p*) 'help-table '((#\h :control) (#\b))) +(set-key `(com-describe-bindings ,*numeric-argument-marker*) 'help-table '((#\h :control) (#\b))) (define-command (com-describe-key :name t :command-table help-table) () --- /project/mcclim/cvsroot/mcclim/ESA/esa-command-parser.lisp 2006/11/08 01:10:16 1.1 +++ /project/mcclim/cvsroot/mcclim/ESA/esa-command-parser.lisp 2007/12/19 11:02:00 1.2 @@ -89,7 +89,8 @@ (push (esa-parse-one-arg stream name ptype args) result) (maybe-clear-input))))))))) -(defun esa-partial-command-parser (command-table stream command position) +(defun esa-partial-command-parser (command-table stream command position + &optional numeric-argument) (declare (ignore command-table position)) (let ((command-name (car command)) (command-args (cdr command))) @@ -114,8 +115,10 @@ (command-arg (car command-args) (car command-args))) ((null required-args) (cons command-name (nreverse result))) (destructuring-bind (name ptype &rest args) arg - (push (if (eq command-arg *unsupplied-argument-marker*) - (esa-parse-one-arg stream name ptype args) - command-arg) + (push (cond ((eq command-arg *unsupplied-argument-marker*) + (esa-parse-one-arg stream name ptype args)) + ((eq command-arg *numeric-argument-marker*) + (or numeric-argument (getf args :default))) + (t command-arg)) result) (maybe-clear-input)))))))))

1 0

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

19 Dec '07

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv20615 Modified Files: core.lisp Log Message: Forgot to commit this part of my tabify-changes. --- /project/mcclim/cvsroot/mcclim/Drei/core.lisp 2007/12/10 21:25:12 1.10 +++ /project/mcclim/cvsroot/mcclim/Drei/core.lisp 2007/12/19 10:22:16 1.11 @@ -69,7 +69,7 @@ (defun indent-current-line (view point) (indent-line point (proper-line-indentation view point) - (and (indent-tabs-mode (buffer view)) + (and (use-tabs view) (tab-space-count view)))) (defun insert-pair (mark syntax &optional (count 0) (open #\() (close #\))) @@ -178,7 +178,8 @@ function." (do-buffer-region-lines (line mark1 mark2) (let ((indentation (proper-line-indentation view line))) - (indent-line line indentation (tab-space-count view))))) + (indent-line line indentation (and (use-tabs view) + (tab-space-count view)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0