climacs-cvs

climacs-cvs@common-lisp.net

847 discussions

[climacs-cvs] CVS climacs
by thenriksen 22 Jul '06

22 Jul '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv14065 Modified Files: gui.lisp Log Message: C-x C-b now behaves as an Emacs user would expect. --- /project/climacs/cvsroot/climacs/gui.lisp 2006/07/21 06:25:45 1.221 +++ /project/climacs/cvsroot/climacs/gui.lisp 2006/07/22 20:35:06 1.222 @@ -432,9 +432,9 @@ (let* ((buffers (buffers *application-frame*)) (position (position buffer buffers)) (pane (current-window))) - (if position - (rotatef (car buffers) (nth position buffers)) - (push buffer (buffers *application-frame*))) + (when position + (setf buffers (delete buffer buffers))) + (push buffer (buffers *application-frame*)) (setf (offset (point (buffer pane))) (offset (point pane))) (setf (buffer pane) buffer) (full-redisplay pane)

1 0

[climacs-cvs] CVS climacs
by thenriksen 22 Jul '06

22 Jul '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv10051 Modified Files: lisp-syntax.lisp Log Message: Fixed bug accidentaly introduced by last commit. --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/07/22 15:59:25 1.94 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/07/22 16:48:20 1.95 @@ -3692,8 +3692,7 @@ (multiple-value-list (find-operand-info ,mark-value-sym ,syntax-value-sym form))))) (or (recurse (parent form)) - (unless (and (typep form 'complete-token-lexeme) - (direct-arg-p form ,syntax-value-sym)) + (unless (direct-arg-p form ,syntax-value-sym) form)))))) (or (recurse (parent immediate-form)) (parent immediate-form))))))

1 0

[climacs-cvs] CVS climacs
by thenriksen 22 Jul '06

22 Jul '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv4596 Modified Files: lisp-syntax.lisp Log Message: Fixed how `indices-match-arglist' handles nonmandatory arguments. --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/07/21 11:35:28 1.93 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/07/22 15:59:25 1.94 @@ -3614,11 +3614,14 @@ (pure-arglist (remove-if #'arglist-keyword-p arglist)) (arg (when (< index (length pure-arglist)) (elt pure-arglist index)))) - (if (and (not (null arg)) - (listp arg) - (rest arg-indices)) - (indices-match-arglist arg (rest arg-indices)) - (null (rest arg-indices))))) + (cond ((and (> index (or (position #'arglist-keyword-p arglist) 0)) + (not (null (rest arg-indices)))) + nil) + ((and (not (null arg)) + (listp arg) + (rest arg-indices)) + (indices-match-arglist arg (rest arg-indices))) + (t (null (rest arg-indices)))))) (defun direct-arg-p (form syntax) "Check whether `form' is a direct argument to one of its @@ -3689,10 +3692,11 @@ (multiple-value-list (find-operand-info ,mark-value-sym ,syntax-value-sym form))))) (or (recurse (parent form)) - (unless (direct-arg-p form ,syntax-value-sym) + (unless (and (typep form 'complete-token-lexeme) + (direct-arg-p form ,syntax-value-sym)) form)))))) (or (recurse (parent immediate-form)) - immediate-form))))) + (parent immediate-form)))))) ;; If we cannot find a form, there's no point in looking ;; up any of this stuff. (,operator-sym (when ,form-sym (form-operator ,form-sym ,syntax-value-sym)))

1 0

[climacs-cvs] CVS climacs
by thenriksen 21 Jul '06

21 Jul '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv25727 Modified Files: lisp-syntax.lisp Log Message: More work on arglist intelligence. I think it works now. Please report any breakage. --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/07/21 09:09:43 1.92 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/07/21 11:35:28 1.93 @@ -3551,18 +3551,21 @@ (worker (parent operand-form))))))))) (nreverse (worker operand-form t))))) -(defun find-operand-info (mark syntax operator-form) - "Returns two values: The operand preceding `mark' and the path - from `operator-form' to the operand." - (let* ((preceding-arg-token (form-before syntax (offset mark))) +(defun find-operand-info (mark-or-offset syntax operator-form) + "Returns two values: The operand preceding `mark-or-offset' and + the path from `operator-form' to the operand." + (let* ((offset (if (numberp mark-or-offset) + mark-or-offset + (offset mark-or-offset))) + (preceding-arg-token (form-before syntax offset)) (indexing-start-arg (let* ((candidate-before preceding-arg-token) (candidate-after (when (null candidate-before) - (let ((after (form-after syntax (offset mark)))) + (let ((after (form-after syntax offset))) (when after (parent after))))) (candidate-around (when (null candidate-after) - (form-around syntax (offset mark)))) + (form-around syntax offset))) (candidate (or candidate-before candidate-after candidate-around))) @@ -3617,6 +3620,32 @@ (indices-match-arglist arg (rest arg-indices)) (null (rest arg-indices))))) +(defun direct-arg-p (form syntax) + "Check whether `form' is a direct argument to one of its + parents." + (labels ((recurse (parent) + (let ((operator (form-operator + parent + syntax))) + (or (and + ;; An operator is not an argument to itself... + (not (= (start-offset form) + (start-offset (first-form (children parent))))) + (valid-operator-p operator) + (indices-match-arglist + (arglist (image syntax) + operator) + (second + (multiple-value-list + (find-operand-info + (start-offset form) + syntax + parent))))) + (when (parent parent) + (recurse (parent parent))))))) + (when (parent form) + (recurse (parent form))))) + (defmacro with-code-insight (mark syntax (&key operator preceding-operand form preceding-operand-indices operands) @@ -3645,21 +3674,25 @@ ;; regard to the structure of the lambda list. If we ;; cannot find a form with a valid operator, just ;; return the form `mark' is in. - (labels ((recurse (form) - (if (and (valid-operator-p (form-operator - form - ,syntax-value-sym)) - (indices-match-arglist - (arglist (image syntax) - (form-operator - form - ,syntax-value-sym)) - (second (multiple-value-list (find-operand-info ,mark-value-sym ,syntax-value-sym form))))) - (or (when (and form (parent form)) - (recurse (parent form))) - form)))) - (or (recurse (when immediate-form (parent immediate-form))) - (when immediate-form (parent immediate-form)))))) + (unless (null immediate-form) + (labels ((recurse (form) + (unless (null form) + (if (and (valid-operator-p (form-operator + form + ,syntax-value-sym)) + (indices-match-arglist + (arglist (image ,syntax-value-sym) + (form-operator + form + ,syntax-value-sym)) + (second + (multiple-value-list + (find-operand-info ,mark-value-sym ,syntax-value-sym form))))) + (or (recurse (parent form)) + (unless (direct-arg-p form ,syntax-value-sym) + form)))))) + (or (recurse (parent immediate-form)) + immediate-form))))) ;; If we cannot find a form, there's no point in looking ;; up any of this stuff. (,operator-sym (when ,form-sym (form-operator ,form-sym ,syntax-value-sym)))

1 0

[climacs-cvs] CVS climacs
by thenriksen 21 Jul '06

21 Jul '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv7707 Modified Files: lisp-syntax.lisp Log Message: Climacs will now check whether the current argument indices are valid when figuring out which operator to display the arglist for. This permits more intelligent display of arglists. For example (with "|" being point): (with-output-to-string (list |) ) Previously, Swine (and SLIME for that matter) would display the arglist for `list', despite the fact that point is really in the arguments for `with-output-to-string'. It it still not perfect, this, for example, confuses it: (with-input-from-string (with-output-to-string (list |))) --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/07/21 06:15:40 1.91 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/07/21 09:09:43 1.92 @@ -3137,6 +3137,10 @@ (defparameter +cl-garbage-keywords+ '(&whole &environment)) +(defun arglist-keyword-p (arg) + "Return T if `arg' is an arglist keyword. NIL otherwise." + (member arg +cl-arglist-keywords+)) + (defun split-arglist-on-keywords (arglist) "Return an alist keying lambda list keywords of `arglist' to the symbols affected by the keywords." @@ -3149,7 +3153,7 @@ (push (subseq arglist 0 2) sing-result) (setf arglist (cddr arglist))) (do ((llk '(&mandatory &optional &key &allow-other-keys &aux &rest &body)) - (args (if (member (first arglist) +cl-arglist-keywords+) + (args (if (arglist-keyword-p (first arglist)) arglist (cons '&mandatory arglist)) (cdr args)) @@ -3597,6 +3601,22 @@ ((listp operator) (eq (first operator) 'cl:lambda)))) +(defun indices-match-arglist (arglist arg-indices) + "Check whether the argument indices `arg-indices' could refer + to a direct argument for the operator with the argument list + `arglist'. Returns T if they could, NIL otherwise. This + functions does not care about the argument quantity, only their + structure." + (let* ((index (first arg-indices)) + (pure-arglist (remove-if #'arglist-keyword-p arglist)) + (arg (when (< index (length pure-arglist)) + (elt pure-arglist index)))) + (if (and (not (null arg)) + (listp arg) + (rest arg-indices)) + (indices-match-arglist arg (rest arg-indices)) + (null (rest arg-indices))))) + (defmacro with-code-insight (mark syntax (&key operator preceding-operand form preceding-operand-indices operands) @@ -3609,7 +3629,7 @@ (operands-sym (or operands (gensym))) (form-sym (or form (gensym))) (operand-indices-sym (or preceding-operand-indices (gensym))) - ;; My kingdom for with-gensyms! + ;; My kingdom for with-gensyms (or once-only)! (mark-value-sym (gensym)) (syntax-value-sym (gensym))) `(let* ((,mark-value-sym ,mark) @@ -3626,12 +3646,18 @@ ;; cannot find a form with a valid operator, just ;; return the form `mark' is in. (labels ((recurse (form) - (if (valid-operator-p (form-operator - form - ,syntax-value-sym)) - form - (when (and form (parent form)) - (recurse (parent form)))))) + (if (and (valid-operator-p (form-operator + form + ,syntax-value-sym)) + (indices-match-arglist + (arglist (image syntax) + (form-operator + form + ,syntax-value-sym)) + (second (multiple-value-list (find-operand-info ,mark-value-sym ,syntax-value-sym form))))) + (or (when (and form (parent form)) + (recurse (parent form))) + form)))) (or (recurse (when immediate-form (parent immediate-form))) (when immediate-form (parent immediate-form)))))) ;; If we cannot find a form, there's no point in looking @@ -3643,15 +3669,15 @@ ,@body)))) (defun show-arglist-for-form-at-mark (mark syntax) - "Display the argument list for the operator of `form'. The + "Display the argument list for the operator of `form'. The list need not be complete. If an argument list cannot be retrieved for the operator, nothing will be displayed." (with-code-insight mark syntax (:operator operator :preceding-operand preceding-operand :preceding-operand-indices preceding-operand-indices :operands operands) - (when (valid-operator-p operator) - (show-arglist-silent operator preceding-operand-indices preceding-operand operands)))) + (when (valid-operator-p operator) + (show-arglist-silent operator preceding-operand-indices preceding-operand operands)))) ;;; Definition editing

1 0

[climacs-cvs] CVS esa
by thenriksen 21 Jul '06

21 Jul '06

Update of /project/climacs/cvsroot/esa In directory clnet:/tmp/cvs-serv29784 Modified Files: esa.lisp Log Message: `com-extended-command' should not be named. --- /project/climacs/cvsroot/esa/esa.lisp 2006/05/13 16:48:04 1.19 +++ /project/climacs/cvsroot/esa/esa.lisp 2006/07/21 07:58:42 1.20 @@ -650,9 +650,6 @@ (set-key 'com-quit 'global-esa-table '((#\x :control) (#\c :control))) (define-command (com-extended-command - ;; FIXME: I don't think it makes any sense for - ;; Extended Command to be named. - :name t :command-table global-esa-table) () "Prompt for a command name and arguments, then run it." @@ -953,6 +950,7 @@ 'command-table :stream stream) (princ "an unknown command table" stream)) + (format stream ".~%") (when (plusp (length keystrokes)) (princ "It is bound to " stream)

1 0

[climacs-cvs] CVS climacs
by thenriksen 21 Jul '06

21 Jul '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv17972 Modified Files: pane.lisp gui.lisp Log Message: Changed `with-undo' so undo works properly for commands that modify buffers that were not the current buffer when the command loop started. A single undo operation still cannot undo for multiple buffers, however, so the user will have to manually invoke undo for each buffer. --- /project/climacs/cvsroot/climacs/pane.lisp 2006/07/06 17:31:50 1.44 +++ /project/climacs/cvsroot/climacs/pane.lisp 2006/07/21 06:25:45 1.45 @@ -103,20 +103,28 @@ :objects (buffer-sequence buffer offset (+ offset n))) (undo-accumulate buffer)))) -(defmacro with-undo ((buffer) &body body) - (let ((buffer-var (gensym))) - `(let ((,buffer-var ,buffer)) - (setf (undo-accumulate ,buffer-var) '()) - (unwind-protect (progn ,@body) - (cond ((null (undo-accumulate ,buffer-var)) nil) - ((null (cdr (undo-accumulate ,buffer-var))) - (add-undo (car (undo-accumulate ,buffer-var)) - (undo-tree ,buffer-var))) - (t - (add-undo (make-instance 'compound-record - :buffer ,buffer-var - :records (undo-accumulate ,buffer-var)) - (undo-tree ,buffer-var)))))))) +(defmacro with-undo ((get-buffers-exp) &body body) + "Evaluate `body', registering any changes to buffer contents in +the undo memory for the respective buffer, permitting individual +undo for each buffer. `get-buffers-exp' should be a form, that +will be evaluated whenever a complete list of buffers is +needed (to set up all buffers to prepare for undo, and to check +them all for changes after `body' has run)." + (let ((buffer-sym (gensym))) + `(progn + (dolist (,buffer-sym ,get-buffers-exp) + (setf (undo-accumulate ,buffer-sym) '())) + (unwind-protect (progn ,@body) + (dolist (,buffer-sym ,get-buffers-exp) + (cond ((null (undo-accumulate ,buffer-sym)) nil) + ((null (cdr (undo-accumulate ,buffer-sym))) + (add-undo (car (undo-accumulate ,buffer-sym)) + (undo-tree ,buffer-sym))) + (t + (add-undo (make-instance 'compound-record + :buffer ,buffer-sym + :records (undo-accumulate ,buffer-sym)) + (undo-tree ,buffer-sym))))))))) (defmethod flip-undo-record :around ((record climacs-undo-record)) (with-slots (buffer) record --- /project/climacs/cvsroot/climacs/gui.lisp 2006/07/11 14:20:20 1.220 +++ /project/climacs/cvsroot/climacs/gui.lisp 2006/07/21 06:25:45 1.221 @@ -299,7 +299,7 @@ (handler-case (progn (if (buffer-pane-p current-window) - (with-undo ((buffer current-window)) + (with-undo ((buffers frame)) (call-next-method)) (call-next-method)) (loop for buffer in (buffers frame)

1 0

[climacs-cvs] CVS climacs
by thenriksen 21 Jul '06

21 Jul '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv11851 Modified Files: lisp-syntax.lisp lisp-syntax-commands.lisp Log Message: Fixed issue where the symbol-completer was a bit too eager in deleting the original partial symbol. --- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/07/11 20:55:08 1.90 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/07/21 06:15:40 1.91 @@ -1575,6 +1575,19 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Useful functions for modifying forms based on the mark. + +(defun replace-symbol-at-mark (mark syntax string) + "Replace the symbol at `mark' with `string' and move `mark' to +after `string'." + (let ((token (symbol-at-mark mark syntax))) + (unless (= (offset mark) (start-offset token)) + (backward-expression mark syntax 1 nil)) + (forward-kill-expression mark syntax) + (insert-sequence mark string))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; display (defvar *white-space-start* nil) --- /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp 2006/07/09 18:44:50 1.8 +++ /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp 2006/07/21 06:15:40 1.9 @@ -245,24 +245,22 @@ (clear-completions))) (define-command (com-complete-symbol :name t :command-table lisp-table) () - "Attempt to complete the symbol at mark. + "Attempt to complete the symbol at mark. If successful, move point +to end of symbol. -If more than one completion is available, a list of possible -completions will be displayed." +If more than one completion is available, a list of +possible completions will be displayed." (let* ((pane (current-window)) (buffer (buffer pane)) (syntax (syntax buffer)) - (point-current-window (point pane)) - (name (symbol-name-at-mark point-current-window + (mark (point pane)) + (name (symbol-name-at-mark mark syntax))) (when name - (with-syntax-package syntax point-current-window (package) - (let ((completion (show-completions syntax name package)) - (mark (clone-mark point-current-window))) + (with-syntax-package syntax mark (package) + (let ((completion (show-completions syntax name package))) (unless (= (length completion) 0) - (backward-object mark (length name)) - (delete-region mark point-current-window) - (insert-sequence point-current-window completion))))))) + (replace-symbol-at-mark mark syntax completion))))))) (define-command (com-fuzzily-complete-symbol :name t :command-table lisp-table) () "Attempt to fuzzily complete the abbreviation at mark. @@ -273,17 +271,14 @@ (let* ((pane (current-window)) (buffer (buffer pane)) (syntax (syntax buffer)) - (point-current-window (point pane)) - (name (symbol-name-at-mark point-current-window + (mark (mark pane)) + (name (symbol-name-at-mark mark syntax))) (when name - (with-syntax-package syntax point-current-window (package) - (let ((completion (show-fuzzy-completions syntax name package)) - (mark (clone-mark point-current-window))) + (with-syntax-package syntax mark (package) + (let ((completion (show-fuzzy-completions syntax name package))) (unless (= (length completion) 0) - (backward-object mark (length name)) - (delete-region mark point-current-window) - (insert-sequence point-current-window completion))))))) + (replace-symbol-at-mark mark syntax completion))))))) (define-presentation-to-command-translator lookup-symbol-arglist (symbol com-lookup-arglist lisp-table

1 0

[climacs-cvs] CVS climacs
by thenriksen 21 Jul '06

21 Jul '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv7710 Modified Files: editing.lisp Log Message: Explicitly use the `stream-default-view' function in the CLIM package. This fix is indicative of a larger problem. --- /project/climacs/cvsroot/climacs/editing.lisp 2006/07/07 23:59:38 1.2 +++ /project/climacs/cvsroot/climacs/editing.lisp 2006/07/21 05:08:26 1.3 @@ -303,7 +303,7 @@ "Indent all lines in the region delimited by `mark1' and `mark2' according to the rules of the active syntax in `pane'." (let* ((buffer (buffer pane)) - (view (stream-default-view pane)) + (view (clim:stream-default-view pane)) (tab-space-count (tab-space-count view)) (tab-width (and (indent-tabs-mode buffer) tab-space-count))

1 0

[climacs-cvs] CVS climacs
by thenriksen 20 Jul '06

20 Jul '06

Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv32749 Removed Files: undo.html undo-en.html skeleton.html skeleton-en.html redisplay.html redisplay-en.html pdp.html index.html climacs.html climacs-en.html buffer.html buffer-en.html Log Message: Removed a bunch of no longer needed and possibly outdated HTML files.

1 0

← Newer
1
...
16
17
18
19
20
21
22
...
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