climacs-cvs

climacs-cvs@common-lisp.net

847 discussions

[climacs-cvs] CVS climacs
by thenriksen 19 May '06

19 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv2122 Modified Files: lisp-syntax.lisp Log Message: Fixed: use status, not package. --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/18 21:43:39 1.74 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/19 11:09:11 1.75 @@ -1999,7 +1999,7 @@ (multiple-value-bind (symbol status) (when package (find-symbol symbol-name package)) - (if (or symbol package) + (if (or symbol status) (values symbol status) (values (make-symbol symbol-name) nil))))))

1 0

[climacs-cvs] CVS climacs
by thenriksen 18 May '06

18 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv26156 Modified Files: lisp-syntax.lisp Log Message: Fixed symbol finding code and removed deprecated string indentation rule. --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/16 21:36:29 1.73 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/18 21:43:39 1.74 @@ -1999,7 +1999,7 @@ (multiple-value-bind (symbol status) (when package (find-symbol symbol-name package)) - (if symbol + (if (or symbol package) (values symbol status) (values (make-symbol symbol-name) nil)))))) @@ -2196,9 +2196,6 @@ ;; inside a subexpression (indent-form syntax (elt-noncomment (children tree) (car path)) (cdr path))))))) -(defmethod indent-form ((syntax lisp-syntax) (tree string-form) path) - (values tree 1)) - (defmethod indent-form ((syntax lisp-syntax) (tree token-form) path) (values tree 0))

1 0

[climacs-cvs] CVS climacs
by dmurray 17 May '06

17 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv32495 Modified Files: search-commands.lisp Log Message: Fixed buglet when reverse-isearching from end of buffer. (It now works.) --- /project/climacs/cvsroot/climacs/search-commands.lisp 2006/05/16 21:08:08 1.4 +++ /project/climacs/cvsroot/climacs/search-commands.lisp 2006/05/17 06:33:12 1.5 @@ -148,7 +148,7 @@ (string char))) (mark (clone-mark (search-mark (first states)))) (forwardp (search-forward-p (first states)))) - (unless forwardp + (unless (or forwardp (end-of-buffer-p mark)) (incf (offset mark))) (isearch-from-mark pane mark string forwardp))) @@ -172,7 +172,7 @@ (buffer-substring buffer (offset start) (offset point))))) - (unless forwardp + (unless (or forwardp (end-of-buffer-p mark)) (incf (offset mark))) (isearch-from-mark pane mark string forwardp)))) @@ -190,7 +190,7 @@ (kill-ring-yank *kill-ring*))) (mark (clone-mark (search-mark (first states)))) (forwardp (search-forward-p (first states)))) - (unless forwardp + (unless (or forwardp (end-of-buffer-p mark)) (incf (offset mark))) (isearch-from-mark pane mark string forwardp)))

1 0

[climacs-cvs] CVS climacs
by thenriksen 16 May '06

16 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv28282 Modified Files: lisp-syntax.lisp Log Message: Removed call to Clouseau (oops again). --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/16 20:38:31 1.72 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/16 21:36:29 1.73 @@ -2058,7 +2058,7 @@ &key no-error (case (readtable-case *readtable*))) (declare (ignore no-error)) - (clouseau:inspector (parse-symbol (token-string syntax token) :case case))) + (parse-symbol (token-string syntax token) :case case)) (defmethod token-to-object (syntax (token number-lexeme) &rest args) (declare (ignore args))

1 0

[climacs-cvs] CVS climacs
by dmurray 16 May '06

16 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv24606 Modified Files: search-commands.lisp Log Message: Preliminary addition of some extra options for isearch: C-j (appends a #\Newline to the search string) C-w (appends the word after point) C-y (appends the remainder of the line after point) M-y (appends the most recent kill) Still work to be done, but useful even now. --- /project/climacs/cvsroot/climacs/search-commands.lisp 2006/05/14 20:35:44 1.3 +++ /project/climacs/cvsroot/climacs/search-commands.lisp 2006/05/16 21:08:08 1.4 @@ -28,6 +28,13 @@ (in-package :climacs-gui) +(defun display-string (string) + (with-output-to-string (result) + (loop for char across string + do (cond ((graphic-char-p char) (princ char result)) + ((char= char #\Space) (princ char result)) + (t (prin1 char result)))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; String search @@ -107,7 +114,7 @@ (- (offset mark2) (length string)) (+ (offset mark2) (length string))))) (display-message "~:[Failing ~;~]Isearch~:[ backward~;~]: ~A" - success forwardp string) + success forwardp (display-string string)) (push (make-instance 'isearch-state :search-string string :search-mark mark @@ -133,18 +140,60 @@ 'search-table '((#\r :control))) -(define-command (com-isearch-append-char :name t :command-table isearch-climacs-table) () +(defun isearch-append-char (char) (let* ((pane (current-window)) (states (isearch-states pane)) (string (concatenate 'string (search-string (first states)) - (string *current-gesture*))) + (string char))) (mark (clone-mark (search-mark (first states)))) (forwardp (search-forward-p (first states)))) (unless forwardp (incf (offset mark))) (isearch-from-mark pane mark string forwardp))) +(define-command (com-isearch-append-char :name t :command-table isearch-climacs-table) () + (isearch-append-char *current-gesture*)) + +(define-command (com-isearch-append-newline :name t :command-table isearch-climacs-table) () + (isearch-append-char #\Newline)) + +(defun isearch-append-text (movement-function) + (let* ((pane (current-window)) + (states (isearch-states pane)) + (buffer (buffer pane)) + (point (point pane)) + (start (clone-mark point)) + (mark (clone-mark (search-mark (first states)))) + (forwardp (search-forward-p (first states)))) + (funcall movement-function point) + (let ((string (concatenate 'string + (search-string (first states)) + (buffer-substring buffer + (offset start) + (offset point))))) + (unless forwardp + (incf (offset mark))) + (isearch-from-mark pane mark string forwardp)))) + +(define-command (com-isearch-append-word :name t :command-table isearch-climacs-table) () + (isearch-append-text #'forward-word)) + +(define-command (com-isearch-append-line :name t :command-table isearch-climacs-table) () + (isearch-append-text #'end-of-line)) + +(define-command (com-isearch-append-kill :name t :command-table isearch-climacs-table) () + (let* ((pane (current-window)) + (states (isearch-states pane)) + (string (concatenate 'string + (search-string (first states)) + (kill-ring-yank *kill-ring*))) + (mark (clone-mark (search-mark (first states)))) + (forwardp (search-forward-p (first states)))) + (unless forwardp + (incf (offset mark))) + (isearch-from-mark pane mark string forwardp))) + (define-command (com-isearch-delete-char :name t :command-table isearch-climacs-table) () (let* ((pane (current-window))) (cond ((null (second (isearch-states pane))) @@ -164,7 +213,7 @@ (length (search-string state))))) (display-message "Isearch~:[ backward~;~]: ~A" (search-forward-p state) - (search-string state))))))) + (display-string (search-string state)))))))) (define-command (com-isearch-search-forward :name t :command-table isearch-climacs-table) () (let* ((pane (current-window)) @@ -200,6 +249,10 @@ (isearch-set-key '(#\Backspace) 'com-isearch-delete-char) (isearch-set-key '(#\s :control) 'com-isearch-search-forward) (isearch-set-key '(#\r :control) 'com-isearch-search-backward) +(isearch-set-key '(#\j :control) 'com-isearch-append-newline) +(isearch-set-key '(#\w :control) 'com-isearch-append-word) +(isearch-set-key '(#\y :control) 'com-isearch-append-line) +(isearch-set-key '(#\y :meta) 'com-isearch-append-kill) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

[climacs-cvs] CVS climacs
by thenriksen 16 May '06

16 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv22841 Modified Files: misc-commands.lisp Log Message: Changed all commands in file to use proper command arguments instead of calling `accept' explicitly. --- /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/05/14 07:14:17 1.12 +++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/05/16 20:59:16 1.13 @@ -817,7 +817,7 @@ (loop until (end-of-line-p mark) while (whitespacep (object-after mark)) repeat count do (forward-object mark) - finally (setf offset (offset mark))) + finally (setf offset (offset mark))) (loop until (end-of-line-p mark) while (whitespacep (object-after mark)) do (forward-object mark)) @@ -838,14 +838,12 @@ (defun goto-position (mark pos) (setf (offset mark) pos)) -(define-command (com-goto-position :name t :command-table movement-table) () +(define-command (com-goto-position :name t :command-table movement-table) + ((position 'integer :prompt "Goto Position")) "Prompts for an integer, and sets the offset of point to that integer." (goto-position (point (current-window)) - (handler-case (accept 'integer :prompt "Goto Position") - (error () (progn (beep) - (display-message "Not a valid position") - (return-from com-goto-position nil)))))) + position)) (defun goto-line (mark line-number) (loop with m = (clone-mark (low-mark (buffer mark)) @@ -859,24 +857,22 @@ finally (beginning-of-line m) (setf (offset mark) (offset m)))) -(define-command (com-goto-line :name t :command-table movement-table) () +(define-command (com-goto-line :name t :command-table movement-table) + ((line-number 'integer :prompt "Goto Line")) "Prompts for a line number, and sets point to the beginning of that line. The first line of the buffer is 1. Giving a number <1 leaves point at the beginning of the buffer. Giving a line number larger than the number of the last line in the buffer leaves point at the beginning of the last line of the buffer." - (goto-line (point (current-window)) - (handler-case (accept 'integer :prompt "Goto Line") - (error () (progn (beep) - (display-message "Not a valid line number") - (return-from com-goto-line nil)))))) - -(define-command (com-browse-url :name t :command-table base-table) () - (let ((url (accept 'url :prompt "Browse URL"))) - #+ (and sbcl darwin) - (sb-ext:run-program "/usr/bin/open" `(,url) :wait nil) - #+ (and openmcl darwin) - (ccl:run-program "/usr/bin/open" `(,url) :wait nil))) + (goto-line (point (current-window)) line-number)) + +(define-command (com-browse-url :name t :command-table base-table) + ((url 'url :prompt "Browse URL")) + (declare (ignorable url)) + #+ (and sbcl darwin) + (sb-ext:run-program "/usr/bin/open" `(,url) :wait nil) + #+ (and openmcl darwin) + (ccl:run-program "/usr/bin/open" `(,url) :wait nil)) (define-command (com-set-mark :name t :command-table marking-table) () "Set mark to the current position of point." @@ -915,15 +911,12 @@ (beep) (display-message "No such syntax: ~A." syntax))))) -(define-command (com-set-syntax :name t :command-table buffer-table) () +(define-command (com-set-syntax :name t :command-table buffer-table) + ((syntax 'syntax + :prompt "Name of syntax")) "Prompts for a syntax to set for the current buffer. -Setting a syntax will cause the buffer to be reparsed using the new syntax." - (let* ((pane (current-window)) - (buffer (buffer pane))) - (handler-case (set-syntax buffer (accept 'syntax :prompt "Set Syntax")) - (input-not-of-required-type - (message) - (display-message "Invalid syntax: ~A." message))))) + Setting a syntax will cause the buffer to be reparsed using the new syntax." + (set-syntax (current-buffer) syntax)) ;;;;;;;;;;;;;;;;;;;; ;; Kill ring commands @@ -979,14 +972,11 @@ 'editing-table '((#\y :meta))) -(define-command (com-resize-kill-ring :name t :command-table editing-table) () +(define-command (com-resize-kill-ring :name t :command-table editing-table) + ((size 'integer :prompt "New kill ring size")) "Prompt for a new size for the kill ring. The default is 5. A number less than 5 will be replaced by 5." - (let ((size (handler-case (accept 'integer :prompt "New kill ring size") - (error () (progn (beep) - (display-message "Not a valid kill ring size") - (return-from com-resize-kill-ring nil)))))) - (setf (kill-ring-max-size *kill-ring*) size))) + (setf (kill-ring-max-size *kill-ring*) size)) (define-command (com-append-next-kill :name t :command-table editing-table) () "Set the kill ring to append the next kill to the previous one." @@ -1336,17 +1326,14 @@ '((#\x :control) (#\=))) (define-command (com-eval-expression :name t :command-table base-table) - ((insertp 'boolean :prompt "Insert?")) + ((exp 'expression :prompt "Eval") + (insertp 'boolean :prompt "Insert?")) "Prompt for and evaluate a lisp expression. With a numeric argument inserts the result at point as a string; otherwise prints the result." (let* ((*package* (find-package :climacs-gui)) - (string (handler-case (accept 'string :prompt "Eval") - (error () (progn (beep) - (display-message "Empty string") - (return-from com-eval-expression nil))))) - (values (multiple-value-list - (handler-case (eval (read-from-string string)) + (values (multiple-value-list + (handler-case (eval exp) (error (condition) (progn (beep) (display-message "~a" condition) (return-from com-eval-expression nil)))))) @@ -1355,7 +1342,7 @@ (insert-sequence (point (current-window)) result) (display-message result)))) -(set-key `(com-eval-expression ,*numeric-argument-p*) +(set-key `(com-eval-expression ,*unsupplied-argument-marker* ,*numeric-argument-p*) 'base-table '((#\: :shift :meta)))

1 0

[climacs-cvs] CVS climacs
by thenriksen 16 May '06

16 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv20950 Modified Files: lisp-syntax.lisp Log Message: Use colors that are more visible on a white background and resembles out-of-the-box GNU Emacs. --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/16 20:13:17 1.71 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/16 20:38:31 1.72 @@ -1372,10 +1372,10 @@ (defparameter *standard-faces* `((:error ,+red+ nil) - (:string ,+coral+ ,(make-text-style nil :italic nil)) - (:keyword ,+dark-violet+ nil) - (:macro ,+cyan+) - (:special-form ,+cyan+) + (:string ,+rosy-brown+ ,(make-text-style nil :italic nil)) + (:keyword ,+orchid+ nil) + (:macro ,+purple+ nil) + (:special-form ,+purple+ nil) (:lambda-list-keyword ,+dark-green+ nil) (:comment ,+maroon+ nil) (:reader-conditional ,+gray50+ nil)))

1 0

[climacs-cvs] CVS climacs
by thenriksen 16 May '06

16 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv17472 Modified Files: lisp-syntax.lisp Log Message: Made the quote-characters use the same face as the rest of the string when displaying string lexemes. --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/16 20:00:50 1.70 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/16 20:13:17 1.71 @@ -1521,13 +1521,14 @@ (end-offset (car (last children 2)))))) (with-output-as-presentation (pane string 'lisp-string :single-box :highlighting) - (display-parse-tree (pop children) syntax pane) (with-face (:string) + (display-parse-tree (pop children) syntax pane) (loop until (null (cdr children)) - do (display-parse-tree (pop children) syntax pane))) - (display-parse-tree (pop children) syntax pane))) - (progn (display-parse-tree (pop children) syntax pane) - (display-parse-tree (pop children) syntax pane))))) + do (display-parse-tree (pop children) syntax pane)) + (display-parse-tree (pop children) syntax pane)))) + (with-face (:string) + (progn (display-parse-tree (pop children) syntax pane) + (display-parse-tree (pop children) syntax pane)))))) (defmethod display-parse-tree ((parse-symbol incomplete-string-form) (syntax lisp-syntax) pane) (let ((children (children parse-symbol))) @@ -1537,11 +1538,12 @@ (end-offset (car (last children)))))) (with-output-as-presentation (pane string 'lisp-string :single-box :highlighting) - (display-parse-tree (pop children) syntax pane) (with-face (:string) + (display-parse-tree (pop children) syntax pane) (loop until (null children) do (display-parse-tree (pop children) syntax pane))))) - (display-parse-tree (pop children) syntax pane)))) + (with-face (:string) + (display-parse-tree (pop children) syntax pane))))) (defmethod display-parse-tree ((parse-symbol line-comment-form) (syntax lisp-syntax) pane) (with-face (:comment)

1 0

[climacs-cvs] CVS climacs
by thenriksen 16 May '06

16 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv16994 Modified Files: lisp-syntax.lisp Log Message: Added ":no-error t" arguments to calls to `token-to-object'. --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/16 19:48:52 1.69 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/16 20:00:50 1.70 @@ -1172,7 +1172,8 @@ (when (typep x 'complete-list-form) (let ((candidate (first-form (children x)))) (and (typep candidate 'token-mixin) - (eq (token-to-object syntax candidate) + (eq (token-to-object syntax candidate + :no-error t) 'cl:in-package)))))) (with-slots (stack-top) syntax (let ((form (find-if #'test (children stack-top)))) @@ -1466,7 +1467,7 @@ (if (> (the fixnum (end-offset parse-symbol)) (the fixnum (start-offset parse-symbol))) (let ((string (token-string syntax parse-symbol))) (multiple-value-bind (symbol status) - (token-to-object syntax parse-symbol) + (token-to-object syntax parse-symbol :no-error t) (with-output-as-presentation (pane (if status symbol string) (if status 'symbol 'unknown-symbol) :single-box :highlighting)

1 0

[climacs-cvs] CVS climacs
by thenriksen 16 May '06

16 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv15202 Modified Files: lisp-syntax.lisp Log Message: Expanded, improved and fixed the `token-to-object' generic function and its methods. --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/16 19:38:49 1.68 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/16 19:48:52 1.69 @@ -2007,15 +2007,15 @@ :case case :no-error t)) -(defgeneric token-to-object (syntax token &key no-error &allow-other-keys) +(defgeneric token-to-object (syntax token &rest args &key no-error package quote &allow-other-keys) (:documentation "Return the Lisp object `token' would evaluate to if read. An attempt will be made to construct objects from incomplete tokens. This function may signal an error if `no-error' is nil and `token' cannot be converted to a Lisp object. Otherwise, nil will be returned.") - (:method :around (syntax token &key no-error package) + (:method :around (syntax token &rest args &key no-error package quote) ;; Ensure that every symbol that is READ will be looked up - ;; in the correct package. + ;; in the correct package. Also handle quoting. (handler-case (let ((*package* (if (and (slot-boundp syntax 'package) (slot-value syntax 'package) (typep (slot-value syntax 'package) 'package)) @@ -2025,8 +2025,13 @@ package (find-package package))) (find-package :common-lisp))))) - (call-next-method)) + (if quote + (progn + (setf (getf args :quote) nil) + `',(call-next-method)) + (call-next-method))) (t () + ;; Needs more usable error. (unless no-error (error "Cannot convert token to Lisp object: ~A" token))))) (:method (syntax (token t) &key no-error) @@ -2034,7 +2039,7 @@ ;; We ignore `no-error' as it is truly a bug in Climacs if no ;; handler method is specialized on this form. (error "Cannot convert token to Lisp object: ~A" - token)) + token)) (:method (syntax (token incomplete-form-mixin) &key no-error) (unless no-error (error "Cannot convert incomplete form to Lisp object: ~A" @@ -2046,30 +2051,31 @@ (declare (ignore no-error)) (parse-symbol (token-string syntax token) :case case)) -(defmethod token-to-object (syntax (token number-lexeme) &key no-error) +(defmethod token-to-object (syntax (token complete-token-form) + &key no-error + (case (readtable-case *readtable*))) (declare (ignore no-error)) + (clouseau:inspector (parse-symbol (token-string syntax token) :case case))) + +(defmethod token-to-object (syntax (token number-lexeme) &rest args) + (declare (ignore args)) (let ((*read-base* (base syntax))) (read-from-string (token-string syntax token)))) -(defmethod token-to-object (syntax (token list-form) &key no-error) - (declare (ignore no-error)) - (mapcar #'(lambda (form) - (token-to-object syntax form)) - (remove-if-not #'(lambda (form) - (typep form 'form)) - (children token)))) +(defmethod token-to-object (syntax (token list-form) &rest args) + (loop for child in (children token) + if (typep child 'comma-at-form) + ;; How should we handle this? + collect (apply #'token-to-object syntax child args) + else if (typep child 'form) + collect (apply #'token-to-object syntax child args))) -(defmethod token-to-object (syntax (token simple-vector-form) &key no-error) - (declare (ignore no-error)) +(defmethod token-to-object (syntax (token simple-vector-form) &key) (apply #'vector - (mapcar #'(lambda (form) - (token-to-object syntax form)) - (remove-if-not #'(lambda (form) - (typep form 'form)) - (children token))))) + (call-next-method))) -(defmethod token-to-object (syntax (token incomplete-string-form) &key no-error) - (declare (ignore no-error)) +(defmethod token-to-object (syntax (token incomplete-string-form) &rest args) + (declare (ignore args)) (read-from-string (concatenate 'string (token-string syntax token) "\""))) @@ -2078,9 +2084,61 @@ (declare (ignore no-error)) (read-from-string (token-string syntax token))) -(defmethod token-to-object (syntax (token quote-form) &key no-error) - (list 'cl:quote - (token-to-object syntax (second (children token)) :no-error no-error))) +(defmethod token-to-object (syntax (token quote-form) &rest args) + (apply #'token-to-object syntax (second (children token)) :quote t args)) + +;; I'm not sure backquotes are handled correctly, but then again, +;; `token-to-object' is not meant to be a perfect Lisp reader, only a +;; convenience function. +(defmethod token-to-object (syntax (token backquote-form) &rest args) + (let ((backquoted-form (first-form (children token)))) + (if (typep backquoted-form 'list-form) + `'(,@(apply #'token-to-object syntax backquoted-form args)) + `',(apply #'token-to-object syntax backquoted-form args)))) + +(defmethod token-to-object (syntax (token comma-form) &rest args) + (apply #'token-to-object syntax (first-form (children token)) args)) + +(defmethod token-to-object (syntax (token comma-at-form) &rest args) + (apply #'token-to-object syntax (first-form (children token)) args)) + +(defmethod token-to-object (syntax (token function-form) &rest args) + (list 'cl:function (apply #'token-to-object syntax (second (children token)) + args))) + +(defmethod token-to-object (syntax (token character-lexeme) &key) + (read-from-string (token-string syntax token))) + +(defmethod token-to-object (syntax (token cons-cell-form) &key) + (let ((components (remove-if #'(lambda (token) + (not (typep token 'form))) + (children token)))) + (if (<= (length components) 2) + (cons (token-to-object syntax (first components)) + (token-to-object syntax (second components))) + (loop for (head . tail) on components + if (rest tail) + collect (token-to-object syntax head) + else if (not (null tail)) + append (cons (token-to-object syntax head) + (token-to-object syntax (first tail))))))) + +;; Perhaps just returning NIL for conditionals whose condition +;; evaluates to NIL isn't such a good idea? I don't think it's very +;; Intuitive. +(defmethod token-to-object (syntax (token reader-conditional-positive-form) &key) + (let ((conditional (second-noncomment (children token)))) + (when (eval-feature-conditional conditional syntax) + (token-to-object syntax (third-noncomment (children token)))))) + +(defmethod token-to-object (syntax (token reader-conditional-negative-form) &key) + (let ((conditional (second-noncomment (children token)))) + (when (not (eval-feature-conditional conditional syntax)) + (token-to-object syntax (third-noncomment (children token)))))) + +(defmethod token-to-object (syntax (token undefined-reader-macro-form) &key) + ;; ??? + nil) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0

← Newer
1
...
21
22
23
24
25
26
27
...
85
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

climacs-cvs