climacs-cvs

climacs-cvs@common-lisp.net

847 discussions

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

16 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv13589 Modified Files: lisp-syntax.lisp Log Message: Oops. Added defclass for dot-lexeme. --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/16 19:33:41 1.67 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/16 19:38:49 1.68 @@ -208,6 +208,7 @@ (defclass comma-lexeme (lisp-lexeme) ()) (defclass comma-at-lexeme (lisp-lexeme) ()) (defclass comma-dot-lexeme (lisp-lexeme) ()) +(defclass dot-lexeme (lisp-lexeme) ()) (defclass form-lexeme (form lisp-lexeme) ()) (defclass incomplete-character-lexeme (form-lexeme incomplete-form-mixin) ()) (defclass character-lexeme (form-lexeme) ())

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-serv13303 Modified Files: lisp-syntax.lisp Log Message: Added syntactical recognition of literal cons cells. May need more work on error-detection. --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/06 19:51:04 1.66 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/05/16 19:33:41 1.67 @@ -450,11 +450,13 @@ ;; May need more work. Can recognize symbols and numbers. (flet ((fo () (forward-object scan))) (let ((could-be-number t) - sign-seen dot-seen slash-seen) + sign-seen dot-seen slash-seen nondot-seen) (flet ((return-token-or-number-lexeme () (return-from lex-token (if could-be-number - (make-instance 'number-lexeme) + (if nondot-seen + (make-instance 'number-lexeme) + (make-instance 'dot-lexeme)) (make-instance 'complete-token-lexeme)))) (this-object () (object-after scan))) @@ -463,6 +465,8 @@ (when (end-of-buffer-p scan) (return-token-or-number-lexeme)) (when (constituentp (object-after scan)) + (when (not (eql (this-object) #\.)) + (setf nondot-seen t)) (cond ((or (eql (this-object) #\+) (eql (this-object) #\-)) (when sign-seen @@ -681,6 +685,42 @@ (define-lisp-action (|( form* | (eql nil)) (reduce-until-type incomplete-list-form left-parenthesis-lexeme)) +;;;;;;;;;;;;;;;; Cons cell +;; Also (foo bar baz . quux) constructs. +;; (foo bar . baz quux) flagged as an error (too aggressively?). + +;;; parse trees +(defclass cons-cell-form (form) ()) +(defclass complete-cons-cell-form (cons-cell-form complete-list-form) ()) +(defclass incomplete-cons-cell-form (cons-cell-form incomplete-list-form) ()) + +(define-parser-state |( form* dot-lexeme | + (lexer-list-state form-may-follow) ()) +(define-parser-state |( form* dot-lexeme form | + (lexer-list-state form-may-follow) ()) +(define-parser-state |( form* dot-lexeme form ) | + (lexer-toplevel-state parser-state) ()) + +(define-new-lisp-state (|( form* | dot-lexeme) + |( form* dot-lexeme |) +(define-new-lisp-state (|( form* dot-lexeme | form) + |( form* dot-lexeme form |) +(define-new-lisp-state (|( form* dot-lexeme | comment) + |( form* dot-lexeme |) +(define-new-lisp-state (|( form* dot-lexeme form | right-parenthesis-lexeme) + |( form* dot-lexeme form ) |) +(define-new-lisp-state (|( form* dot-lexeme form | comment) + |( form* dot-lexeme form |) + +(define-lisp-action (|( form* dot-lexeme form ) | t) + (reduce-until-type complete-cons-cell-form left-parenthesis-lexeme)) + +;;; Reduce at end of buffer. +(define-lisp-action (|( form* dot-lexeme | (eql nil)) + (reduce-until-type incomplete-cons-cell-form left-parenthesis-lexeme)) +(define-lisp-action (|( form* dot-lexeme form | (eql nil)) + (reduce-until-type incomplete-cons-cell-form left-parenthesis-lexeme)) + ;;;;;;;;;;;;;;;; Simple Vector ;;; parse trees

1 0

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

16 May '06

Update of /project/climacs/cvsroot/esa In directory clnet:/tmp/cvs-serv518 Modified Files: esa-command-parser.lisp Log Message: Fixed handling of *unsupplied-argument-marker* for commands with >1 arguments. Previously, every argument would be treated as if it was *unsupplied-argument-marker* if just a single one was. Was this on purpose? It looked like a slight oversight regarding the behavior of DO. --- /project/climacs/cvsroot/esa/esa-command-parser.lisp 2006/05/10 09:52:05 1.1 +++ /project/climacs/cvsroot/esa/esa-command-parser.lisp 2006/05/16 14:45:58 1.2 @@ -108,11 +108,13 @@ (let (result) ;; only required args for now. (do ((required-args required-args (cdr required-args)) - (arg (car required-args) (car required-args)) + (arg (car required-args) (cadr required-args)) (command-args command-args (cdr command-args)) - (command-arg (car command-args) (car command-args))) + (command-arg (car command-args) (cadr command-args))) ((null required-args) (cons command-name (nreverse result))) (destructuring-bind (name ptype &rest args) arg - (push (esa-parse-one-arg stream name ptype args command-arg) + (push (if (eq command-arg *unsupplied-argument-marker*) + (esa-parse-one-arg stream name ptype args command-arg) + command-arg) result) (maybe-clear-input)))))))))

1 0

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

14 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv18370 Modified Files: base.lisp file-commands.lisp packages.lisp pane.lisp search-commands.lisp Log Message: Undo fundamental/basic breakage. Sorry. Also add String Search, Reverse String Search, Word Search and Reverse Word Search commands. --- /project/climacs/cvsroot/climacs/base.lisp 2006/05/12 18:59:05 1.48 +++ /project/climacs/cvsroot/climacs/base.lisp 2006/05/14 20:35:44 1.49 @@ -745,6 +745,11 @@ return i finally (return nil)))) +(defun search-word-backward (mark word) + (let ((offset (buffer-search-word-backward (buffer mark) (offset mark) word))) + (when offset + (setf (offset mark) offset)))) + (defun buffer-search-word-forward (buffer offset word &key (test #'eql)) "Return the smallest offset of BUFFER >= OFFSET containing WORD as a word or NIL if no such offset exists" @@ -757,5 +762,12 @@ (buffer-looking-at buffer i word :test test) (not (and (< j blen) (constituentp (buffer-object buffer j))))) + ;; should this be (+ i wlen)? jqs 2006-05-14 return i finally (return nil)))) + +(defun search-word-forward (mark word) + (let ((wlen (length word)) + (offset (buffer-search-word-forward (buffer mark) (offset mark) word))) + (when offset + (setf (offset mark) (+ offset wlen))))) \ No newline at end of file --- /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/14 07:13:43 1.17 +++ /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/14 20:35:44 1.18 @@ -127,7 +127,7 @@ :test (lambda (x y) (member x y :test #'string-equal)) :key #'climacs-syntax::syntax-description-pathname-types)) - 'fundamental-syntax)) + 'basic-syntax)) (defun evaluate-attributes (buffer options) "Evaluate the attributes `options' and modify `buffer' as --- /project/climacs/cvsroot/climacs/packages.lisp 2006/05/14 09:37:01 1.95 +++ /project/climacs/cvsroot/climacs/packages.lisp 2006/05/14 20:35:44 1.96 @@ -144,7 +144,7 @@ (defpackage :climacs-pane (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev - :climacs-syntax :flexichain :undo :climacs-fundamental-syntax) + :climacs-syntax :flexichain :undo) (:export #:climacs-buffer #:needs-saving #:filepath #:file-saved-p #:file-write-time #:read-only-p #:buffer-read-only @@ -170,7 +170,7 @@ (defpackage :climacs-gui (:use :clim-lisp :clim :climacs-buffer :climacs-base - :climacs-abbrev :climacs-syntax :climacs-fundamental-syntax + :climacs-abbrev :climacs-syntax :climacs-kill-ring :climacs-pane :clim-extensions :undo :esa) ;;(:import-from :lisp-string) (:export :climacs ; Main entry point. --- /project/climacs/cvsroot/climacs/pane.lisp 2006/05/14 07:13:43 1.42 +++ /project/climacs/cvsroot/climacs/pane.lisp 2006/05/14 20:35:44 1.43 @@ -255,7 +255,7 @@ (declare (ignore args)) (with-slots (syntax point) buffer (setf syntax (make-instance - 'fundamental-syntax :buffer (implementation buffer)) + 'basic-syntax :buffer (implementation buffer)) point (clone-mark (low-mark buffer) :right)))) (defmethod (setf syntax) :after (syntax (buffer climacs-buffer)) --- /project/climacs/cvsroot/climacs/search-commands.lisp 2006/05/12 16:52:33 1.2 +++ /project/climacs/cvsroot/climacs/search-commands.lisp 2006/05/14 20:35:44 1.3 @@ -30,6 +30,46 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; String search + +(define-command (com-string-search :name t :command-table search-table) + ((string 'string :prompt "Search string")) + "Prompt for a string and search forward for it. +If found, leaves point after string. If not, leaves point where it is." + (let* ((pane (current-window)) + (point (point pane))) + (search-forward point string))) + +(define-command (com-reverse-string-search :name t :command-table search-table) + ((string 'string :prompt "Search string")) + "Prompt for a string and search backward for it. +If found, leaves point before string. If not, leaves point where it is." + (let* ((pane (current-window)) + (point (point pane))) + (search-backward point string))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Word search + +(define-command (com-word-search :name t :command-table search-table) + ((word 'string :prompt "Search word")) + "Prompt for a whitespace delimited word and search forward for it. +If found, leaves point after the word. If not, leaves point where it is." + (let* ((pane (current-window)) + (point (point pane))) + (climacs-base::search-word-forward point word))) + +(define-command (com-reverse-word-search :name t :command-table search-table) + ((word 'string :prompt "Search word")) + "Prompt for a whitespace delimited word and search backward for it. +If found, leaves point before the word. If not, leaves point where it is." + (let* ((pane (current-window)) + (point (point pane))) + (climacs-base::search-word-backward point word))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; Incremental search (make-command-table 'isearch-climacs-table :errorp nil) @@ -445,5 +485,3 @@ (multiple-query-replace-set-key '(#\q) 'com-query-replace-exit) (multiple-query-replace-set-key '(#\y) 'com-multiple-query-replace-replace) (multiple-query-replace-set-key '(#\n) 'com-multiple-query-replace-skip) - -

1 0

[climacs-cvs] CVS climacs
by crhodes 14 May '06

14 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv25774 Modified Files: gui.lisp Log Message: A few bells and whistles: * add a command argument for kill-buffer, rather than an accept in the body; * when running execute-frame-command, only update syntax etc. when the frame argument is also *application-frame*; * climacs implementations of read-only and modified widgets for the info pane. Ideally that should be ESA functionality, but it didn't look to me that the info pane was well factored yet. * #+sbcl implementation of climacs-as-cl:ed. --- /project/climacs/cvsroot/climacs/gui.lisp 2006/05/13 17:19:10 1.214 +++ /project/climacs/cvsroot/climacs/gui.lisp 2006/05/14 17:42:21 1.215 @@ -223,6 +223,33 @@ (clim-sys:make-process #'run :name process-name) (run)))) +(define-presentation-type read-only ()) +(define-presentation-method highlight-presentation + ((type read-only) record stream state) + nil) +(define-presentation-type modified ()) +(define-presentation-method highlight-presentation + ((type modified) record stream state) + nil) + +(define-command (com-toggle-read-only :name t :command-table base-table) + ((buffer 'buffer)) + (setf (read-only-p buffer) (not (read-only-p buffer)))) +(define-presentation-to-command-translator toggle-read-only + (read-only com-toggle-read-only base-table + :gesture :menu) + (object) + (list object)) + +(define-command (com-toggle-modified :name t :command-table base-table) + ((buffer 'buffer)) + (setf (needs-saving buffer) (not (needs-saving buffer)))) +(define-presentation-to-command-translator toggle-modified + (modified com-toggle-modified base-table + :gesture :menu) + (object) + (list object)) + (defun display-info (frame pane) (let* ((master-pane (master-pane pane)) (buffer (buffer master-pane)) @@ -230,16 +257,24 @@ (top (top master-pane)) (bot (bot master-pane))) (princ " " pane) - (princ (cond ((and (needs-saving buffer) - (read-only-p buffer) - "%*")) - ((needs-saving buffer) "**") - ((read-only-p buffer) "%%") - (t "--")) - pane) + (with-output-as-presentation (pane buffer 'read-only) + (princ (cond + ((read-only-p buffer) "%") + ((needs-saving buffer) "*") + (t "-")) + pane)) + (with-output-as-presentation (pane buffer 'modified) + (princ (cond + ((needs-saving buffer) "*") + ((read-only-p buffer) "%") + (t "-")) + pane)) (princ " " pane) (with-text-face (pane :bold) - (format pane "~25A" (name buffer))) + (with-output-as-presentation (pane buffer 'buffer) + (format pane "~A" (name buffer))) + ;; FIXME: bare 25. + (format pane "~V@T" (- 25 (length (name buffer))))) (format pane " ~A " (cond ((and (mark= size bot) (mark= 0 top)) @@ -305,10 +340,12 @@ (beep) (display-message "Buffer is read only"))))) (defmethod execute-frame-command :after ((frame climacs) command) - (loop for buffer in (buffers frame) - do (update-syntax buffer (syntax buffer)) - do (when (modified-p buffer) - (setf (needs-saving buffer) t)))) + (when (eq frame *application-frame*) + (loop for buffer in (buffers frame) + do (when (syntax buffer) + (update-syntax buffer (syntax buffer))) + do (when (modified-p buffer) + (setf (needs-saving buffer) t))))) (defmethod find-applicable-command-table ((frame climacs)) (or @@ -482,19 +519,38 @@ (defmethod kill-buffer ((symbol (eql 'nil))) (kill-buffer (buffer (current-window)))) -(define-command (com-kill-buffer :name t :command-table pane-table) () +(define-command (com-kill-buffer :name t :command-table pane-table) + ((buffer 'buffer + :prompt "Kill buffer" + :default (buffer (current-window)) + :default-type 'buffer)) "Prompt for a buffer name and kill that buffer. If the buffer needs saving, will prompt you to do so before killing it. Uses the current buffer as a default." - (let ((buffer (accept 'buffer - :prompt "Kill buffer" - :default (buffer (current-window)) - :default-type 'buffer))) - (kill-buffer buffer))) + (kill-buffer buffer)) -(set-key 'com-kill-buffer +(set-key `(com-kill-buffer ,*unsupplied-argument-marker*) 'pane-table '((#\x :control) (#\k))) +#+sbcl +(defun ed-in-climacs (thing) + (let ((frame-manager (find-frame-manager))) + (when frame-manager + (let ((climacs-frame (find-if (lambda (x) (typep x 'climacs)) + (frame-manager-frames frame-manager)))) + (when climacs-frame + (typecase thing + ((or pathname string) + (execute-frame-command + climacs-frame `(com-find-file ,(pathname thing))) + t) + ((or symbol cons) + ;; FIXME: do something + nil))))))) + +#+sbcl +(pushnew 'ed-in-climacs sb-ext:*ed-functions*) + ;;; For the ESA help functions. (defmethod help-stream ((frame climacs) title)

1 0

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

14 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv22453 Modified Files: packages.lisp Log Message: Moved use of :climacs-pane package to after its definition. --- /project/climacs/cvsroot/climacs/packages.lisp 2006/05/14 07:13:43 1.94 +++ /project/climacs/cvsroot/climacs/packages.lisp 2006/05/14 09:37:01 1.95 @@ -127,11 +127,6 @@ #:line-comment-region #:comment-region #:line-uncomment-region #:uncomment-region)) -(defpackage :climacs-fundamental-syntax - (:use :clim-lisp :clim :climacs-buffer :climacs-base - :climacs-syntax :flexichain :climacs-pane) - (:export #:fundamental-syntax)) - (defpackage :climacs-kill-ring (:use :clim-lisp :flexichain) (:export #:kill-ring #:kill-ring-length #:kill-ring-max-size @@ -187,6 +182,11 @@ :mark :insert-character)) +(defpackage :climacs-fundamental-syntax + (:use :clim-lisp :clim :climacs-buffer :climacs-base + :climacs-syntax :flexichain :climacs-pane) + (:export #:fundamental-syntax)) + (defpackage :climacs-html-syntax (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-syntax :flexichain :climacs-pane))

1 0

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

14 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv31514 Modified Files: misc-commands.lisp Log Message: Linebreaks in docstrings. --- /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/05/06 19:51:04 1.11 +++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/05/14 07:14:17 1.12 @@ -30,7 +30,10 @@ (define-command (com-overwrite-mode :name t :command-table editing-table) () "Toggle overwrite mode for the current mode. -When overwrite is on, an object entered on the keyboard will replace the object after the point. When overwrite is off (the default), objects are inserted at point. In both cases point is positioned after the new object." +When overwrite is on, an object entered on the keyboard +will replace the object after the point. +When overwrite is off (the default), objects are inserted at point. +In both cases point is positioned after the new object." (with-slots (overwrite-mode) (current-window) (setf overwrite-mode (not overwrite-mode)))) @@ -40,7 +43,9 @@ (define-command (com-not-modified :name t :command-table buffer-table) () "Clear the modified flag for the current buffer. -The modified flag is automatically set when the contents of the buffer are changed. This flag is consulted, for instance, when deciding whether to prompt you to save the buffer before killing it." +The modified flag is automatically set when the contents +of the buffer are changed. This flag is consulted, for instance, +when deciding whether to prompt you to save the buffer before killing it." (setf (needs-saving (buffer (current-window))) nil)) (set-key 'com-not-modified @@ -50,7 +55,10 @@ (define-command (com-set-fill-column :name t :command-table fill-table) ((column 'integer :prompt "Column Number:")) "Set the fill column to the specified value. -You must supply a numeric argument. The fill column is the column beyond which automatic line-wrapping will occur. The default fill column is 70." +You must supply a numeric argument. The fill column is +the column beyond which automatic line-wrapping will occur. + +The default fill column is 70." (set-fill-column column)) (set-key `(com-set-fill-column ,*numeric-argument-marker*) @@ -123,7 +131,8 @@ ((count 'integer :prompt "Number of Objects") (killp 'boolean :prompt "Kill?")) "Delete the object after point. -With a numeric argument, kill that many objects after (or before, if negative) point." +With a numeric argument, kill that many objects +after (or before, if negative) point." (let* ((point (point (current-window))) (mark (clone-mark point))) (forward-object mark count) @@ -146,7 +155,8 @@ ((count 'integer :prompt "Number of Objects") (killp 'boolean :prompt "Kill?")) "Delete the object before point. -With a numeric argument, kills that many objects before (or after, if negative) point." +With a numeric argument, kills that many objects +before (or after, if negative) point." (let* ((point (point (current-window))) (mark (clone-mark point))) (backward-object mark count) @@ -161,7 +171,7 @@ '(#\Backspace)) (define-command (com-zap-to-object :name t :command-table deletion-table) () - "Prompt for an object and kill the objects between point and the next occurence of that object after point. + "Prompt for an object and kill to the next occurence of that object after point. Characters can be entered in #\ format." (let* ((item (handler-case (accept 't :prompt "Zap to Object") (error () (progn (beep) @@ -174,8 +184,10 @@ (delete-range current-point (- (offset item-mark) current-offset)))) (define-command (com-zap-to-character :name t :command-table deletion-table) () - "Prompt for a character and kill the objects between point and the next occurence of that character after point. -FIXME: Accepts a string (that is, zero or more characters) terminated by a #\NEWLINE. If a zero length string signals an error. If a string of length >1, uses the first character of the string." + "Prompt for a character and kill to the next occurence of that character after point. +FIXME: Accepts a string (that is, zero or more characters) +terminated by a #\NEWLINE. If a zero length string signals an error. +If a string of length >1, uses the first character of the string." (let* ((item-string (handler-case (accept 'string :prompt "Zap to Character") ; Figure out how to get #\d and d. (or 'string 'character)? (error () (progn (beep) (display-message "Not a valid string. ") @@ -206,8 +218,13 @@ (define-command (com-transpose-objects :name t :command-table editing-table) () "Transpose the objects before and after point, advancing point. -At the end of a line transpose the previous two objects without advancing point. At the beginning of the buffer do nothing. At the beginning of any line other than the first effectively move the first object of that line to the end of the previous line. -FIXME: at the end of a single object line at the beginning of the buffer deletes that object." +At the end of a line transpose the previous two objects without +advancing point. At the beginning of the buffer do nothing. +At the beginning of any line other than the first effectively +move the first object of that line to the end of the previous line. + +FIXME: at the end of a single object line at the beginning of +the buffer deletes that object." (transpose-objects (point (current-window)))) (set-key 'com-transpose-objects @@ -217,7 +234,8 @@ (define-command (com-backward-object :name t :command-table movement-table) ((count 'integer :prompt "Number of Objects")) "Move point backward one object. -With a numeric argument, move point backward (or forward, if negative) that number of objects." +With a numeric argument, move point backward (or forward, if negative) +that number of objects." (backward-object (point (current-window)) count)) (set-key `(com-backward-object ,*numeric-argument-marker*) @@ -231,7 +249,8 @@ (define-command (com-forward-object :name t :command-table movement-table) ((count 'integer :prompt "Number of Objects")) "Move point forward one object. -With a numeric argument, move point forward (or backward, if negative) that number of objects." +With a numeric argument, move point forward (or backward, if negative) +that number of objects." (forward-object (point (current-window)) count)) (set-key `(com-forward-object ,*numeric-argument-marker*) @@ -267,8 +286,14 @@ (define-command (com-transpose-words :name t :command-table editing-table) () "Transpose the words around point, leaving point at the end of them. -With point in the whitespace between words, transpose the words before and after point. With point inside a word, transpose that word with the next one. With point before the first word of the buffer, transpose the first two words of the buffer. -FIXME: with point after the penultimate word of the buffer, or if there are <2 words in the buffer, Strange Things (TM) happen (including breaking Climacs)." +With point in the whitespace between words, transpose the words before +and after point. With point inside a word, transpose that word with +the next one. With point before the first word of the buffer, transpose +the first two words of the buffer. + +FIXME: with point after the penultimate word of the buffer, +or if there are <2 words in the buffer, Strange Things (TM) +happen (including breaking Climacs)." (transpose-words (point (current-window)))) (set-key 'com-transpose-words @@ -299,7 +324,9 @@ (define-command (com-transpose-lines :name t :command-table editing-table) () "Transpose current line and previous line, leaving point at the end of them. -If point is in the first line, transpose the first two lines. If point is in the last line of the buffer and there is no final #\Newline, add one." +If point is in the first line, transpose the first two lines. +If point is in the last line of the buffer and there is no +final #\Newline, add one." (transpose-lines (point (current-window)))) (set-key 'com-transpose-lines @@ -309,7 +336,8 @@ (define-command (com-previous-line :name t :command-table movement-table) ((numarg 'integer :prompt "How many lines?")) "Move point to the previous line. -With a numeric argument, move point up (down, if negative) that many lines. Successive line movement commands seek to respect the 'goal column'." +With a numeric argument, move point up (down, if negative) that many lines. +Successive line movement commands seek to respect the 'goal column'." (let* ((window (current-window)) (point (point window))) (unless (or (eq (previous-command window) 'com-previous-line) @@ -330,7 +358,8 @@ (define-command (com-next-line :name t :command-table movement-table) ((numarg 'integer :prompt "How many lines?")) "Move point to the next line. -With a numeric argument, move point down (up, if negative) that many lines. Successive line movement commands seek to respect the 'goal column'." +With a numeric argument, move point down (up, if negative) that many lines. +Successive line movement commands seek to respect the 'goal column'." (let* ((window (current-window)) (point (point window))) (unless (or (eq (previous-command window) 'com-previous-line) @@ -390,7 +419,12 @@ ((numarg 'integer :prompt "Kill how many lines?") (numargp 'boolean :prompt "Kill entire lines?")) "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. With a non-zero numeric argument, kill that many lines forward (backward, if negative) from point. Successive kills append to the kill ring." +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. +With a non-zero numeric argument, kill that many lines forward (backward, +if negative) from point. + +Successive kills append to the kill ring." (let* ((pane (current-window)) (point (point pane)) (concatenate-p (eq (previous-command pane) 'com-kill-line))) @@ -403,7 +437,8 @@ (define-command (com-forward-word :name t :command-table movement-table) ((count 'integer :prompt "Number of words")) "Move point to the next word end. -With a numeric argument, move point forward (backward, if negative) that many words." +With a numeric argument, move point forward (backward, if negative) +that many words." (if (plusp count) (forward-word (point (current-window)) count) (backward-word (point (current-window)) (- count)))) @@ -419,7 +454,8 @@ (define-command (com-backward-word :name t :command-table movement-table) ((count 'integer :prompt "Number of words")) "Move point to the previous word beginning. -With a numeric argument, move point backward (forward, if negative) that many words." +With a numeric argument, move point backward (forward, if negative) +that many words." (backward-word (point (current-window)) count)) (set-key `(com-backward-word ,*numeric-argument-marker*) @@ -459,7 +495,10 @@ (define-command (com-kill-word :name t :command-table deletion-table) ((count 'integer :prompt "Number of words")) "Kill from point until the next word end. -With a numeric argument, kill forward (backward, if negative) that many words. Successive kills append to the kill ring." +With a numeric argument, kill forward (backward, if negative) +that many words. + +Successive kills append to the kill ring." (let* ((pane (current-window)) (point (point pane)) (concatenate-p (eq (previous-command pane) 'com-kill-word))) @@ -472,7 +511,10 @@ (define-command (com-backward-kill-word :name t :command-table deletion-table) ((count 'integer :prompt "Number of words")) "Kill from point until the previous word beginning. -With a numeric argument, kill backward (forward, if negative) that many words. Successive kills append to the kill ring." +With a numeric argument, kill backward (forward, if negative) +that many words. + +Successive kills append to the kill ring." (let* ((pane (current-window)) (point (point pane)) (concatenate-p (eq (previous-command pane) 'com-backward-kill-word))) @@ -485,7 +527,11 @@ (define-command (com-mark-word :name t :command-table marking-table) ((count 'integer :prompt "Number of words")) "Place mark at the next word end. -With a positive numeric argument, place mark at the end of that many words forward. With a negative numeric argument, place mark at the beginning of that many words backward. Successive invocations extend the selection." +With a positive numeric argument, place mark at the end of +that many words forward. With a negative numeric argument, +place mark at the beginning of that many words backward. + +Successive invocations extend the selection." (let* ((pane (current-window)) (point (point pane)) (mark (mark pane))) @@ -540,7 +586,12 @@ (define-command (com-capitalize-word :name t :command-table case-table) () "Capitalize the next word. -If point is in a word, convert the next character to upper case and the remaining letters in the word to lower case. If point is before the start of a word, convert the first character of that word to upper case and the rest of the letters to lower case. Leave point at the word end." +If point is in a word, convert the next character to +upper case and the remaining letters in the word to lower case. +If point is before the start of a word, convert the first character +of that word to upper case and the rest of the letters to lower case. + +Leave point at the word end." (capitalize-word (point (current-window)))) (set-key 'com-capitalize-word @@ -625,7 +676,11 @@ (define-command (com-delete-indentation :name t :command-table indent-table) () "Join current line to previous non-blank line. -Leaves a single space between the last non-whitespace object of the previous line and the first non-whitespace object of the current line, and point after that space. If there is no previous non-blank line, deletes all whitespace at the beginning of the buffer at leaves point there." +Leaves a single space between the last non-whitespace object +of the previous line and the first non-whitespace object of +the current line, and point after that space. If there is no +previous non-blank line, deletes all whitespace at the +beginning of the buffer at leaves point there." (delete-indentation (point (current-window)))) (set-key 'com-delete-indentation @@ -772,6 +827,7 @@ ((count 'integer :prompt "Number of spaces")) "Delete whitespace around point, leaving a single space. With a positive numeric argument, leave that many spaces. + FIXME: should distinguish between types of whitespace." (just-one-space (point (current-window)) count)) @@ -805,7 +861,10 @@ (define-command (com-goto-line :name t :command-table movement-table) () "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." +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) @@ -903,7 +962,9 @@ (define-command (com-rotate-yank :name t :command-table editing-table) () "Replace the immediately previously yanked objects with others. -Must be given immediately following a Yank or Rotate Yank command. The replacement objects are those before the previously yanked objects in the kill ring." +Must be given immediately following a Yank or Rotate Yank command. +The replacement objects are those before the previously yanked +objects in the kill ring." (let* ((pane (current-window)) (point (point pane)) (last-yank (kill-ring-yank *kill-ring*))) @@ -971,7 +1032,9 @@ (define-command (com-dabbrev-expand :name t :command-table editing-table) () "Expand word before point dynamically. -Search from point (first backward to the beginning of the buffer, then forward) for words for which the word before point is a prefix, inserting each in turn at point as an expansion." +Search from point (first backward to the beginning of the buffer, +then forward) for words for which the word before point is a prefix, +inserting each in turn at point as an expansion." (let* ((window (current-window)) (point (point window))) (with-slots (original-prefix prefix-start-offset dabbrev-expansion-mark) window @@ -1015,7 +1078,8 @@ (define-command (com-backward-paragraph :name t :command-table movement-table) ((count 'integer :prompt "Number of paragraphs")) "Move point to the previous paragraph start. -With a numeric argument, move point backward (forward, if negative) that many paragraphs." +With a numeric argument, move point backward (forward, if negative) +that many paragraphs." (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -1030,7 +1094,8 @@ (define-command (com-forward-paragraph :name t :command-table movement-table) ((count 'integer :prompt "Number of paragraphs")) "Move point to the next paragraph end. -With a numeric argument, move point forward (backward, if negative) that many paragraphs." +With a numeric argument, move point forward (backward, if negative) +that many paragraphs." (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -1045,7 +1110,13 @@ (define-command (com-mark-paragraph :name t :command-table marking-table) ((count 'integer :prompt "Number of paragraphs")) "Place point and mark around the current paragraph. -Put point at the beginning of the current paragraph, and mark at the end. With a positive numeric argument, put mark that many paragraphs forward. With a negative numeric argument, put point at the end of the current paragraph and mark that many paragraphs backward. Successive invocations extend the selection. +Put point at the beginning of the current paragraph, and mark at the end. +With a positive numeric argument, put mark that many paragraphs forward. +With a negative numeric argument, put point at the end of the current +paragraph and mark that many paragraphs backward. + +Successive invocations extend the selection. + FIXME: when called with point already at the beginning or end of a paragraph marks 2 paras." (let* ((pane (current-window)) (point (point pane)) @@ -1067,7 +1138,8 @@ (define-command (com-backward-sentence :name t :command-table movement-table) ((count 'integer :prompt "Number of sentences")) "Move point to the previous sentence beginning. -With a numeric argument, move point backward (forward if negative) that many sentences." +With a numeric argument, move point backward (forward if negative) +that many sentences." (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -1082,7 +1154,8 @@ (define-command (com-forward-sentence :name t :command-table movement-table) ((count 'integer :prompt "Number of sentences")) "Move point to the next sentence end. -With a numeric argument, move point forward (backward if negative) that many sentences." +With a numeric argument, move point forward (backward if negative) +that many sentences." (let* ((pane (current-window)) (point (point pane)) (syntax (syntax (buffer pane)))) @@ -1097,7 +1170,8 @@ (define-command (com-kill-sentence :name t :command-table deletion-table) ((count 'integer :prompt "Number of sentences")) "Kill the objects from point to the next sentence end. -With a numeric argument, kill forward (backward if negative) that many sentences." +With a numeric argument, kill forward (backward if negative) +that many sentences." (let* ((pane (current-window)) (point (point pane)) (mark (clone-mark point)) @@ -1115,7 +1189,8 @@ (define-command (com-backward-kill-sentence :name t :command-table deletion-table) ((count 'integer :prompt "Number of sentences")) "Kill the objects from point to the previous sentence beginning. -With a numeric argument, kill backward (forward if negative) that many sentences." +With a numeric argument, kill backward (forward if negative) +that many sentences." (let* ((pane (current-window)) (point (point pane)) (mark (clone-mark point)) @@ -1139,7 +1214,11 @@ (define-command (com-forward-page :name t :command-table movement-table) ((count 'integer :prompt "Number of pages")) "Move point to the beginning of the next page. -With a numeric argument, move point forward (backward if negative) that many pages. When no page delimeter is found, leave point at the end of the buffer. A page is delimited by the sequence #\Newline #\Page." +With a numeric argument, move point forward (backward if negative) +that many pages. When no page delimeter is found, leave point at the + end of the buffer. + +A page is delimited by the sequence #\Newline #\Page." (let* ((pane (current-window)) (point (point pane))) (if (plusp count) @@ -1160,7 +1239,11 @@ (define-command (com-backward-page :name t :command-table movement-table) ((count 'integer :prompt "Number of pages")) "Move point to the end of the previous page. -With a numeric argument, move point backward (forward if negative) that many pages. When no page delimeter is found, leave point at the beginning of the buffer. A page is delimited by the sequence #\Newline #\Page." +With a numeric argument, move point backward (forward if negative) +that many pages. When no page delimeter is found, leave point at the +beginning of the buffer. + [180 lines skipped]

1 0

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

14 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv31448 Modified Files: pane.lisp packages.lisp file-commands.lisp Log Message: Banish Basic syntax in favour of Fundamental (and some region highlighting fiddling). --- /project/climacs/cvsroot/climacs/pane.lisp 2006/05/07 06:40:19 1.41 +++ /project/climacs/cvsroot/climacs/pane.lisp 2006/05/14 07:13:43 1.42 @@ -255,7 +255,7 @@ (declare (ignore args)) (with-slots (syntax point) buffer (setf syntax (make-instance - 'basic-syntax :buffer (implementation buffer)) + 'fundamental-syntax :buffer (implementation buffer)) point (clone-mark (low-mark buffer) :right)))) (defmethod (setf syntax) :after (syntax (buffer climacs-buffer)) @@ -626,76 +626,100 @@ ;; mark or point is above the screen, and point or mark below it ((and (null cursor-y) (null mark-y) (or (and cursor-x (null mark-x)) - (and (null cursor-x) mark-y))) - (updating-output (pane :unique-id -3) - (draw-rectangle* pane - 0 0 - (stream-text-margin pane) (bounding-rectangle-height - (window-viewport pane)) - :ink ink))) + (and (null cursor-x) mark-x))) + (let ((width (stream-text-margin pane)) + (height (bounding-rectangle-height + (window-viewport pane)))) + (updating-output (pane :unique-id -3 + :cache-value (list cursor-y mark-y cursor-x mark-x + height width ink)) + (draw-rectangle* pane + 0 0 + width height + :ink ink)))) ;; mark is above the top of the screen ((and (null mark-y) (null mark-x)) - (updating-output (pane :unique-id -3) - (draw-rectangle* pane - 0 0 - (stream-text-margin pane) cursor-y - :ink ink) - (draw-rectangle* pane - 0 cursor-y - cursor-x (+ cursor-y line-height) - :ink ink))) + (let ((width (stream-text-margin pane))) + (updating-output (pane :unique-id -3 + :cache-value ink) + (updating-output (pane :cache-value (list mark-y mark-x cursor-y width)) + (draw-rectangle* pane + 0 0 + width cursor-y + :ink ink)) + (updating-output (pane :cache-value (list cursor-y cursor-x)) + (draw-rectangle* pane + 0 cursor-y + cursor-x (+ cursor-y line-height) + :ink ink))))) ;; mark is below the bottom of the screen ((and (null mark-y) mark-x) - (updating-output (pane :unique-id -3) - (draw-rectangle* pane - 0 (+ cursor-y line-height) - (stream-text-margin pane) (bounding-rectangle-height - (window-viewport pane)) - :ink ink) - (draw-rectangle* pane - cursor-x cursor-y - (stream-text-margin pane) (+ cursor-y line-height) - :ink ink))) + (let ((width (stream-text-margin pane)) + (height (bounding-rectangle-height + (window-viewport pane)))) + (updating-output (pane :unique-id -3 + :cache-value ink) + (updating-output (pane :cache-value (list cursor-y width height)) + (draw-rectangle* pane + 0 (+ cursor-y line-height) + width height + :ink ink)) + (updating-output (pane :cache-value (list cursor-x cursor-y width)) + (draw-rectangle* pane + cursor-x cursor-y + width (+ cursor-y line-height) + :ink ink))))) ;; mark is at point ((and (= mark-x cursor-x) (= mark-y cursor-y)) nil) ;; mark and point are on the same line ((= mark-y cursor-y) - (updating-output (pane :unique-id -3) + (updating-output (pane :unique-id -3 + :cache-value (list offset1 offset2 ink)) (draw-rectangle* pane mark-x mark-y cursor-x (+ cursor-y line-height) :ink ink))) ;; mark and point are both visible, mark above point ((< mark-y cursor-y) - (updating-output (pane :unique-id -3) - (draw-rectangle* pane - mark-x mark-y - (stream-text-margin pane) (+ mark-y line-height) - :ink ink) - (draw-rectangle* pane - 0 cursor-y - cursor-x (+ cursor-y line-height) - :ink ink) - (draw-rectangle* pane - 0 (+ mark-y line-height) - (stream-text-margin pane) cursor-y - :ink ink))) + (let ((width (stream-text-margin pane))) + (updating-output (pane :unique-id -3 + :cache-value ink) + (updating-output (pane :cache-value (list mark-x mark-y width)) + (draw-rectangle* pane + mark-x mark-y + width (+ mark-y line-height) + :ink ink)) + (updating-output (pane :cache-value (list cursor-x cursor-y)) + (draw-rectangle* pane + 0 cursor-y + cursor-x (+ cursor-y line-height) + :ink ink)) + (updating-output (pane :cache-value (list mark-y cursor-y width)) + (draw-rectangle* pane + 0 (+ mark-y line-height) + width cursor-y + :ink ink))))) ;; mark and point are both visible, point above mark (t - (updating-output (pane :unique-id -3) - (draw-rectangle* pane - cursor-x cursor-y - (stream-text-margin pane) (+ cursor-y line-height) - :ink ink) - (draw-rectangle* pane - 0 mark-y - mark-x (+ mark-y line-height) - :ink ink) - (draw-rectangle* pane - 0 (+ cursor-y line-height) - (stream-text-margin pane) mark-y - :ink ink))))))) + (let ((width (stream-text-margin pane))) + (updating-output (pane :unique-id -3 + :cache-value ink) + (updating-output (pane :cache-value (list cursor-x cursor-y width)) + (draw-rectangle* pane + cursor-x cursor-y + width (+ cursor-y line-height) + :ink ink)) + (updating-output (pane :cache-value (list mark-x mark-y)) + (draw-rectangle* pane + 0 mark-y + mark-x (+ mark-y line-height) + :ink ink)) + (updating-output (pane :cache-value (list cursor-y mark-y width)) + (draw-rectangle* pane + 0 (+ cursor-y line-height) + width mark-y + :ink ink))))))))) (defmethod highlight-region ((pane climacs-pane) (mark1 mark) (mark2 mark) &optional (ink (compose-in +green+ (make-opacity .1)))) --- /project/climacs/cvsroot/climacs/packages.lisp 2006/05/06 19:51:04 1.93 +++ /project/climacs/cvsroot/climacs/packages.lisp 2006/05/14 07:13:43 1.94 @@ -127,6 +127,11 @@ #:line-comment-region #:comment-region #:line-uncomment-region #:uncomment-region)) +(defpackage :climacs-fundamental-syntax + (:use :clim-lisp :clim :climacs-buffer :climacs-base + :climacs-syntax :flexichain :climacs-pane) + (:export #:fundamental-syntax)) + (defpackage :climacs-kill-ring (:use :clim-lisp :flexichain) (:export #:kill-ring #:kill-ring-length #:kill-ring-max-size @@ -144,7 +149,7 @@ (defpackage :climacs-pane (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev - :climacs-syntax :flexichain :undo) + :climacs-syntax :flexichain :undo :climacs-fundamental-syntax) (:export #:climacs-buffer #:needs-saving #:filepath #:file-saved-p #:file-write-time #:read-only-p #:buffer-read-only @@ -170,7 +175,7 @@ (defpackage :climacs-gui (:use :clim-lisp :clim :climacs-buffer :climacs-base - :climacs-abbrev :climacs-syntax + :climacs-abbrev :climacs-syntax :climacs-fundamental-syntax :climacs-kill-ring :climacs-pane :clim-extensions :undo :esa) ;;(:import-from :lisp-string) (:export :climacs ; Main entry point. @@ -182,11 +187,6 @@ :mark :insert-character)) -(defpackage :climacs-fundamental-syntax - (:use :clim-lisp :clim :climacs-buffer :climacs-base - :climacs-syntax :flexichain :climacs-pane) - (:export)) - (defpackage :climacs-html-syntax (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-syntax :flexichain :climacs-pane)) --- /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/10 20:33:45 1.16 +++ /project/climacs/cvsroot/climacs/file-commands.lisp 2006/05/14 07:13:43 1.17 @@ -127,7 +127,7 @@ :test (lambda (x y) (member x y :test #'string-equal)) :key #'climacs-syntax::syntax-description-pathname-types)) - 'basic-syntax)) + 'fundamental-syntax)) (defun evaluate-attributes (buffer options) "Evaluate the attributes `options' and modify `buffer' as

1 0

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

13 May '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv20027 Modified Files: window-commands.lisp gui.lisp Log Message: Changes relating to the new help facilities in ESA. --- /project/climacs/cvsroot/climacs/window-commands.lisp 2006/05/12 10:31:56 1.7 +++ /project/climacs/cvsroot/climacs/window-commands.lisp 2006/05/13 17:19:10 1.8 @@ -103,20 +103,6 @@ (full-redisplay current-window) new-pane)))) -(define-command (com-describe-bindings :name t :command-table climacs-help-table) - ((sort-by-keystrokes 'boolean :prompt "Sort by keystrokes?")) - (let* ((window (current-window)) - (buffer (buffer (current-window))) - (stream (typeout-window - (format nil "~10THelp: Describe Bindings for ~A" (name buffer)))) - (command-table (command-table window))) - (esa::describe-bindings stream command-table - (if sort-by-keystrokes - #'esa::sort-by-keystrokes - #'esa::sort-by-name)))) - -(set-key `(com-describe-bindings ,*numeric-argument-p*) 'climacs-help-table '((#\h :control) (#\b))) - (defun make-pane-constellation (&optional (with-scrollbars *with-scrollbars*)) "make a vbox containing a scroller pane as its first child and an info pane as its second child. The scroller pane contains a viewport --- /project/climacs/cvsroot/climacs/gui.lisp 2006/05/12 10:31:56 1.213 +++ /project/climacs/cvsroot/climacs/gui.lisp 2006/05/13 17:19:10 1.214 @@ -495,48 +495,8 @@ 'pane-table '((#\x :control) (#\k))) -;;; Commands for calling the ESA help functions. +;;; For the ESA help functions. -(define-command (com-describe-binding :name t :command-table help-table) - () - "Display documentation for the command invoked by a giving gesture sequence. -When invoked, this command will wait for user input. If the user inputs a gesture -sequence bound to a command available in the syntax of the current buffer, -documentation and other details will be displayed in a typeout pane." - (let ((command-table (esa:find-applicable-command-table *application-frame*))) - (multiple-value-bind (command gestures) - (esa::read-gestures-for-help command-table) - (let ((gesture-name (format nil "~{~A~#[~; ~; ~]~}" - (mapcar #'esa:gesture-name gestures)))) - (if command - (let ((out-stream (typeout-window (format nil "~10THelp: Describe Binding for ~A" gesture-name)))) - (describe-command-binding-to-stream gesture-name command - :command-table command-table - :stream out-stream)) - (display-message "Unbound gesture: ~A" gesture-name)))))) +(defmethod help-stream ((frame climacs) title) + (typeout-window (format nil "~10T~A" title))) -(define-command (com-describe-command :name t :command-table climacs-help-table) - ((command 'command-name)) - "Display documentation for the given command." - (unless command - (setf command (accept 'command-name))) - (let ((command-table (esa::find-applicable-command-table *application-frame*)) - (out-stream (typeout-window (format nil "~10THelp: Describe Command for ~A" command)))) - (describe-command-to-stream command - :command-table command-table - :stream out-stream))) - -(set-key 'com-describe-binding - 'climacs-help-table - '((#\h :control) (#\k))) - -(set-key '(com-describe-command nil) - 'climacs-help-table - '((#\h :control) (#\f))) - -(define-presentation-to-command-translator describe-command - (command-name com-describe-command climacs-help-table - :gesture :select - :documentation "Describe command") - (object) - (list object))

1 0

[climacs-cvs] CVS esa
by dmurray 13 May '06

13 May '06

Update of /project/climacs/cvsroot/esa In directory clnet:/tmp/cvs-serv19376 Modified Files: packages.lisp Log Message: Some package cleanups from the help changes. --- /project/climacs/cvsroot/esa/packages.lisp 2006/05/10 09:52:05 1.4 +++ /project/climacs/cvsroot/esa/packages.lisp 2006/05/13 17:15:10 1.5 @@ -9,9 +9,7 @@ #:esa-top-level #:simple-command-loop #:global-esa-table #:keyboard-macro-table #:help-table - #:describe-command-binding-to-stream - #:describe-command-to-stream - #:gesture-name + #:help-stream #:set-key #:find-applicable-command-table #:esa-command-parser

1 0

← Newer
1
...
22
23
24
25
26
27
28
...
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