From thenriksen at common-lisp.net Tue May 2 14:40:15 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Tue, 2 May 2006 10:40:15 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060502144015.20A135903A@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv6237 Modified Files: swine.lisp Log Message: Cleaned stuff up, removed unused functions, moved some functions to Climacs proper. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/04/30 12:10:05 1.4 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/02 14:40:15 1.5 @@ -27,11 +27,6 @@ ;; Convenience functions: -(defun buffer-substring (buffer start end) - "Return a string of the contents of buffer from `start' to -`end'." - (coerce (buffer-sequence buffer start end) 'string)) - (defun unlisted (obj) (if (listp obj) (first obj) @@ -42,81 +37,29 @@ obj (list obj))) -(defun definition-at-mark (mark syntax) +(defun text-of-definition-at-mark (mark syntax) "Return the text of the definition at mark." - (let* ((definition (form-toplevel (or (form-around syntax (offset mark)) - (form-after syntax (offset mark))) - syntax)) - (definition-pos (start-offset definition))) + (let ((definition (definition-at-mark mark syntax))) (buffer-substring (buffer mark) - definition-pos + (start-offset definition) (end-offset definition)))) -(defun expression-at-mark (mark syntax) - "Return the text of the expression at mark." - (let ((m (clone-mark mark))) - (forward-expression m syntax) - (let ((end (offset m))) - (backward-expression m syntax) - (buffer-substring (buffer mark) (offset m) end)))) +(defun text-of-expression-at-mark (mark syntax) + "Return the text of the expression at mark." + (let ((expression (expression-at-mark mark syntax))) + (buffer-substring (buffer mark) + (start-offset expression) + (end-offset expression)))) (defun symbol-name-at-mark (mark syntax) - "Return the text of the symbol at mark." - (let ((potential-form (or (form-around syntax (offset mark)) - (form-around syntax (1- (offset mark))) - (form-around syntax (1+ (offset mark)))))) - (when (and potential-form - (typep potential-form 'token-mixin)) - (buffer-substring (buffer mark) (start-offset potential-form) - (end-offset potential-form))))) - -(defun find-operator-in-trees (trees list offset) - (cond ((or (null trees) - (>= (start-offset (first-form trees)) offset)) - list) - ((or (< (start-offset (first-form trees)) offset (end-offset (first-form trees))) - (typep (first-form trees) 'incomplete-form-mixin)) - (cons (first-form trees) - (find-operator-in-tree (first-form trees) offset))) - (t (find-operator-in-trees (rest-forms trees) list offset)))) - -(defun find-operator-in-tree (tree offset) - (if (null (children tree)) - '() - (find-operator-in-trees (children tree) nil offset))) - -(defun enclosing-operator-names-at-mark (mark syntax) - "Returns a list of strings being the operator names surrounding mark." - (with-slots (stack-top) syntax - (loop for form in (find-operator-in-tree stack-top (offset mark)) - for token = (and form (second-form (children form))) - when (and (typep form 'list-form) - (typep token 'token-mixin)) - collect (buffer-substring (buffer mark) - (start-offset token) - (end-offset token))))) - -;; Once Dwight understands the syntax facilities better, -;; he should rewrite this to something like the above. - -(defmethod backward-up-list-no-error (mark (syntax lisp-syntax)) - (let ((form (or (form-around syntax (offset mark)) - (form-before syntax (offset mark)) - (form-after syntax (offset mark))))) - (when form - (let ((parent (parent form))) - (if (typep parent 'list-form) - (setf (offset mark) (start-offset parent))))))) - -(defun enclosing-list-first-word (mark syntax) - "Return the text of the expression at mark. Mark need not be in -a complete list form." - ;; This is not very fast, but fast enough. - (first (reverse (enclosing-operator-names-at-mark mark syntax)))) + "Return the text of the symbol at mark." + (symbol-name (token-to-symbol syntax + (expression-at-mark mark syntax) + :preserve))) (defun macroexpand-with-swank (mark syntax &optional (all nil)) (with-slots (package) syntax - (let* ((string (expression-at-mark mark syntax)) + (let* ((string (text-of-expression-at-mark mark syntax)) (swank::*buffer-package* (or package *package*)) (swank::*buffer-readtable* *readtable*) (expansion (if all @@ -159,7 +102,7 @@ (defun compile-defun-with-swank (mark pane syntax) (with-slots (package) syntax - (let* ((string (definition-at-mark mark syntax)) + (let* ((string (text-of-definition-at-mark mark syntax)) (buffer-name (name (buffer pane))) (buffer-file-name (filepath (buffer pane))) (m (clone-mark mark)) @@ -845,7 +788,8 @@ indexing-start-arg operator-form)) (preceding-arg-obj (when preceding-arg-token - (token-to-object syntax preceding-arg-token t)))) + (token-to-object syntax preceding-arg-token + :no-error t)))) (values preceding-arg-obj argument-indices))) ;; This is a generic function in order to facilitate different lambda From thenriksen at common-lisp.net Tue May 2 14:42:05 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Tue, 2 May 2006 10:42:05 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060502144205.111175903A@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv6275 Modified Files: README Log Message: "Fixed" the installation instructions. --- /project/clim-desktop/cvsroot/clim-desktop/README 2006/01/06 03:15:45 1.1.1.1 +++ /project/clim-desktop/cvsroot/clim-desktop/README 2006/05/02 14:42:05 1.2 @@ -1,5 +1,4 @@ -First: edit debugger.lisp to give it the correct path to your -McCLIM distribution's copy of the clim-debugger.lisp. +First: edit EDITME.lisp to give it the correct paths to various stuff. Run make-desktop.sh All of the auto-installation code is commented out, so say N. From thenriksen at common-lisp.net Tue May 2 18:07:16 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Tue, 2 May 2006 14:07:16 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060502180716.ABEA068003@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv1295 Modified Files: swine-cmds.lisp Log Message: Added presentation translators for point-and-click action. --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/04/23 15:34:12 1.8 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/02 18:07:16 1.9 @@ -235,3 +235,38 @@ 'lisp-table '((#\c :control) (#\i :meta))) +;; Translators for clicky goodness: + +(define-presentation-to-command-translator edit-definition + (symbol com-edit-definition lisp-table + :gesture :select + :tester ((object presentation) + (declare (ignore object)) + (not (eq (presentation-type presentation) 'unknown-symbol))) + :documentation "Edit definition") + (object) + (list object)) + +(define-command (com-inspect-symbol :name t :command-table lisp-table) + ((symbol 'symbol :prompt "Edit symbol")) + (clouseau:inspector symbol :new-process t)) + +(define-presentation-to-command-translator inspect-symbol + (symbol com-inspect-symbol lisp-table + :gesture :inspect + :tester ((object presentation) + (declare (ignore object)) + (not (eq (presentation-type presentation) 'unknown-symbol))) + :documentation "Inspect") + (object) + (list object)) + +(define-presentation-to-command-translator lookup-symbol-arglist + (symbol com-arglist-lookup lisp-table + :gesture :describe + :tester ((object presentation) + (declare (ignore object)) + (not (eq (presentation-type presentation) 'unknown-symbol))) + :documentation "Lookup arglist") + (object) + (list object)) \ No newline at end of file From thenriksen at common-lisp.net Mon May 15 14:18:57 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Mon, 15 May 2006 10:18:57 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060515141857.AF8E93900E@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv30644 Modified Files: swine-cmds.lisp Log Message: Added feeble docstrings. --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/02 18:07:16 1.9 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/15 14:18:57 1.10 @@ -25,7 +25,9 @@ (in-package :climacs-lisp-syntax) -(define-command (com-eval-last-expression :name t :command-table lisp-table) () +(define-command (com-eval-last-expression :name t :command-table lisp-table) + () + "Evaluate the expression before point." (eval-last-expression-with-swank (point (current-window)) (syntax (buffer (current-window))))) @@ -33,7 +35,12 @@ 'lisp-table '((#\c :control) (#\e :control))) -(define-command (com-macroexpand-1 :name t :command-table lisp-table) () +(define-command (com-macroexpand-1 :name t :command-table lisp-table) + () + "Macroexpand-1 the expression at point. + +The expanded expression will be displayed in a +\"*Macroexpansion*\"-buffer." (macroexpand-with-swank (point (current-window)) (syntax (buffer (current-window))))) @@ -45,15 +52,18 @@ 'lisp-table '((#\c :control) (#\m :control))) -(define-command (com-macroexpand-all :name t :command-table lisp-table) () - (macroexpand-with-swank (point (current-window)) - (syntax (buffer (current-window))))) +(define-command (com-macroexpand-all :name t :command-table lisp-table) + () + "Completely macroexpand the expression at point. -(esa:set-key 'com-macroexpand-all - 'lisp-table - '((#\c :control) (#\m :meta))) +The expanded expression will be displayed in a +\"*Macroexpansion*\"-buffer." + (macroexpand-with-swank (point (current-window)) + (syntax (buffer (current-window))) t)) -(define-command (com-eval-region :name t :command-table lisp-table) () +(define-command (com-eval-region :name t :command-table lisp-table) + () + "Evaluate the current region." (eval-region-with-swank (point (current-window)) (mark (current-window)) (syntax (buffer (current-window))))) @@ -62,30 +72,46 @@ 'lisp-table '((#\c :control) (#\r :control))) -(define-command (com-compile-definition :name t :command-table lisp-table) () - (compile-defun-with-swank (point (current-window)) - (current-window) - (syntax (buffer (current-window))))) +(define-command (com-compile-definition :name t :command-table lisp-table) + () + "Compile and load definition at point." + (compile-defun-with-swank (point (current-window)) + (current-window) + (syntax (buffer (current-window))))) (esa:set-key 'com-compile-definition 'lisp-table '((#\c :control) (#\c :control))) -(define-command (com-compile-and-load-file :name t :command-table lisp-table) () +(define-command (com-compile-and-load-file :name t :command-table lisp-table) + () + "Compile and load the current file. + +Compiler notes will be displayed in a seperate buffer." (compile-file-with-swank (buffer (current-window)) t)) (esa:set-key 'com-compile-and-load-file 'lisp-table '((#\c :control) (#\k :control))) -(define-command (com-compile-file :name t :command-table lisp-table) () - (compile-file-with-swank (buffer (current-window)) nil)) +(define-command (com-compile-file :name t :command-table lisp-table) + () + "Compile the file open in the current buffer. + +This command does not load the file after it has been compiled." + (compile-file-with-swank (buffer (current-window)) nil)) (esa:set-key 'com-compile-file 'lisp-table '((#\c :control) (#\k :meta))) -(define-command (com-goto-location :name t :command-table lisp-table) ((note 'swine-compiler-note)) +(define-command (com-goto-location :name t :command-table lisp-table) + ((note 'swine-compiler-note)) + "Move point to the part of a given file that caused the +compiler note. + +If the file is not already open, a new buffer will be opened with +that file." (goto-swine-location (location note))) (define-presentation-to-command-translator swine-compiler-note-to-goto-location-translator @@ -93,8 +119,10 @@ (presentation) (list (presentation-object presentation))) -(define-command (com-goto-xref :name t :command-table lisp-table) ((xref 'swine-xref)) - (goto-swine-location xref)) +(define-command (com-goto-xref :name t :command-table lisp-table) + ((xref 'swine-xref)) + "Go to the referenced location of a code cross-reference." + (goto-swine-location xref)) (define-presentation-to-command-translator swine-xref-to-goto-location-translator (swine-xref com-goto-xref lisp-table) @@ -108,6 +136,12 @@ ;; symbol at the current point in the buffer. (define-command (com-edit-definition :name t :command-table lisp-table) ((symbol 'symbol :prompt "Edit symbol")) + "Edit the definition of a symbol. + +If the symbol has been defined more than once (eg. to a function +as well as a class, or as numerous methods), a +mouse-click-sensitive list of available definitions will be +displayed." (flet ((fully-qualified-symbol-name (symbol) (let ((*package* (find-package :keyword))) (format nil "~S" symbol)))) @@ -124,14 +158,19 @@ 'lisp-table '((#\. :meta))) -(define-command (com-return-from-definition :name t :command-table lisp-table) () +(define-command (com-return-from-definition :name t :command-table lisp-table) + () + "Return point to where it was before the previous Edit +Definition command was issued." (pop-find-definition-stack)) (esa:set-key 'com-return-from-definition 'lisp-table '((#\, :meta))) -(define-command (com-hyperspec-lookup :name t :command-table lisp-table) () +(define-command (com-hyperspec-lookup :name t :command-table lisp-table) + () + "Look up a symbol in the Common Lisp HyperSpec." (let* ((name (or (symbol-name-at-mark (point (current-window)) (syntax (buffer (current-window)))) (accept 'string :prompt "Hyperspec lookup for symbol"))) @@ -163,8 +202,9 @@ 'lisp-table '((#\c :control) (#\d :control) (#\a))) -(define-command (com-swine-space :name t :command-table lisp-table) +(define-command (com-swine-space :command-table lisp-table) () + "Insert a space and display argument hints in the minibuffer." (let* ((window (current-window)) (mark (point window)) (syntax (syntax (buffer window)))) @@ -190,7 +230,12 @@ 'lisp-table '((#\Space))) -(define-command (com-swine-simple-completion :name t :command-table lisp-table) () +(define-command (com-swine-simple-completion :name t :command-table lisp-table) + () + "Attempt a simple symbol-completion for the symbol at mark. + +If more than one completion is available, a list of possible +completions will be displayed." (let* ((point-current-window (point (current-window))) (name (symbol-name-at-mark point-current-window (syntax (buffer (current-window)))))) @@ -203,6 +248,10 @@ (insert-sequence point-current-window difference))))) (define-command (com-swine-completion :name t :command-table lisp-table) () + "Attempt to complete the symbol at mark. + +If more than one completion is available, a list of possible +completions will be displayed." (let* ((point-current-window (point (current-window))) (name (symbol-name-at-mark point-current-window (syntax (buffer (current-window)))))) @@ -215,6 +264,11 @@ (insert-sequence point-current-window completion)))))) (define-command (com-swine-fuzzy-completion :name t :command-table lisp-table) () + "Attempt to fuzzily complete the abbreviation at mark. + +Fuzzy completion tries to guess which symbol is abbreviated. If +the abbreviation is ambiguous, a list of possible completions +will be displayed." (let* ((point-current-window (point (current-window))) (name (symbol-name-at-mark point-current-window (syntax (buffer (current-window)))))) From thenriksen at common-lisp.net Thu May 18 15:07:30 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Thu, 18 May 2006 11:07:30 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060518150730.7855A4E009@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv4744 Modified Files: swine-cmds.lisp Log Message: Added Edit This Definition command and removed that functionality from Edit Definition. Fixed name of Inspect Symbol command. --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/15 14:18:57 1.10 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/18 15:07:26 1.11 @@ -129,13 +129,22 @@ (presentation) (list (presentation-object presentation))) -;; This command is a bit convoluted because we want to invoke it as a -;; normal command, by a keystroke (where it automatically picks up a -;; symbol name from the buffer) and by presentation translators. If -;; NIL is passed as the symbol, the command will try looking up a -;; symbol at the current point in the buffer. -(define-command (com-edit-definition :name t :command-table lisp-table) - ((symbol 'symbol :prompt "Edit symbol")) +(define-command (com-edit-this-definition :command-table lisp-table) + () + "Edit definition of the symbol at point. +If there is no symbol at point, this is a no-op." + (let* ((buffer (buffer (current-window))) + (point (point (current-window))) + (syntax (syntax buffer)) + (token (or (form-around syntax (offset point)) + (form-before syntax (offset point)))) + (this-symbol (when token (token-to-object syntax token)))) + (when (and this-symbol (symbolp this-symbol)) + (com-edit-definition this-symbol)))) + +(define-command (com-edit-definition :name t :command-table climacs-gui::global-climacs-table) + ((symbol 'symbol + :prompt "Edit symbol")) "Edit the definition of a symbol. If the symbol has been defined more than once (eg. to a function @@ -143,20 +152,14 @@ mouse-click-sensitive list of available definitions will be displayed." (flet ((fully-qualified-symbol-name (symbol) - (let ((*package* (find-package :keyword))) - (format nil "~S" symbol)))) - (let ((name (or (when symbol - (if (symbolp symbol) - (fully-qualified-symbol-name symbol) - symbol)) - (symbol-name-at-mark (point (current-window)) - (syntax (buffer (current-window)))) - (fully-qualified-symbol-name (accept 'symbol :prompt "Edit symbol"))))) - (edit-definition name (syntax (buffer (current-window))))))) + (let ((*package* (find-package :keyword))) + (format nil "~S" symbol)))) + (let ((name (fully-qualified-symbol-name symbol))) + (edit-definition name (syntax (buffer (current-window))))))) -(esa:set-key '(com-edit-definition nil) - 'lisp-table - '((#\. :meta))) +(esa:set-key `(com-edit-this-definition) + 'lisp-table + '((#\. :meta))) (define-command (com-return-from-definition :name t :command-table lisp-table) () @@ -302,7 +305,7 @@ (list object)) (define-command (com-inspect-symbol :name t :command-table lisp-table) - ((symbol 'symbol :prompt "Edit symbol")) + ((symbol 'symbol :prompt "Inspect symbol")) (clouseau:inspector symbol :new-process t)) (define-presentation-to-command-translator inspect-symbol From thenriksen at common-lisp.net Thu May 18 15:10:24 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Thu, 18 May 2006 11:10:24 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060518151024.3FBBB6A003@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv5555 Modified Files: climacs.lisp Log Message: Slight cleanup, needs more work, probably in Climacs itself. --- /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/01/06 03:15:45 1.1.1.1 +++ /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/18 15:10:24 1.2 @@ -4,11 +4,6 @@ (let ((url (accept 'url :prompt "Browse URL"))) (closure:visit url))) -;;; Stolen from closure, src/gui/clim-gui.lisp -(defun send-climacs-command (process command args) - (clim-sys:process-interrupt process - #'(lambda () (apply command args)))) - (define-command (com-find-file-arg :name t :command-table buffer-table) ((file 'pathname)) (find-file file)) @@ -34,9 +29,8 @@ (flet ((run () (run-frame-top-level frame))) (let ((clim-process (clim-sys:make-process #'run :name (format nil "Climacs: ~A" file)))) - (sleep 1) ;compensate for climacs start time. - (send-climacs-command - clim-process 'com-find-file-arg `(,file)))))) + (sleep 1) + (execute-frame-command frame `(com-find-file ,file)))))) ;; Redefine (ed) From thenriksen at common-lisp.net Thu May 18 21:32:15 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Thu, 18 May 2006 17:32:15 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060518213215.B86C150002@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv25686 Modified Files: swine.lisp swine-cmds.lisp climacs.lisp clim-desktop.asd Log Message: Moved Edit Definition into the global Climacs command table. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/02 14:40:15 1.5 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/18 21:32:15 1.6 @@ -829,16 +829,21 @@ (climacs-gui::goto-position (point (climacs-gui::current-window)) offset)) (pop-find-definition-stack))))) -(defun edit-definition (name syntax) - (with-slots (package) syntax - (let* ((swank::*buffer-package* (or package *package*)) - (swank::*buffer-readtable* *readtable*) - (definitions (swank::find-definitions-for-emacs name))) - (cond ((null definitions) - (climacs-gui::display-message "No known definitions for: ~A" name) - (beep)) - (t - (goto-definition name definitions)))))) +(defun edit-definition (symbol) + (flet ((fully-qualified-symbol-name (symbol) + (let ((*package* (find-package :keyword))) + (format nil "~S" symbol)))) + (let* ((name (fully-qualified-symbol-name symbol)) (swank::*buffer-package* *package*) + (swank::*buffer-readtable* *readtable*) + (definitions (swank::find-definitions-for-emacs name))) + (cond ((null definitions) + (climacs-gui::display-message "No known definitions for: ~A" symbol) + (beep)) + (t + (goto-definition name definitions)))))) + +;; XXX, get Swine into Climacs proper. +(export 'edit-definition) (defun goto-definition (name definitions) (let* ((pane (climacs-gui::current-window)) --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/18 15:07:26 1.11 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/18 21:32:15 1.12 @@ -140,22 +140,7 @@ (form-before syntax (offset point)))) (this-symbol (when token (token-to-object syntax token)))) (when (and this-symbol (symbolp this-symbol)) - (com-edit-definition this-symbol)))) - -(define-command (com-edit-definition :name t :command-table climacs-gui::global-climacs-table) - ((symbol 'symbol - :prompt "Edit symbol")) - "Edit the definition of a symbol. - -If the symbol has been defined more than once (eg. to a function -as well as a class, or as numerous methods), a -mouse-click-sensitive list of available definitions will be -displayed." - (flet ((fully-qualified-symbol-name (symbol) - (let ((*package* (find-package :keyword))) - (format nil "~S" symbol)))) - (let ((name (fully-qualified-symbol-name symbol))) - (edit-definition name (syntax (buffer (current-window))))))) + (edit-definition this-symbol)))) (esa:set-key `(com-edit-this-definition) 'lisp-table @@ -294,16 +279,6 @@ ;; Translators for clicky goodness: -(define-presentation-to-command-translator edit-definition - (symbol com-edit-definition lisp-table - :gesture :select - :tester ((object presentation) - (declare (ignore object)) - (not (eq (presentation-type presentation) 'unknown-symbol))) - :documentation "Edit definition") - (object) - (list object)) - (define-command (com-inspect-symbol :name t :command-table lisp-table) ((symbol 'symbol :prompt "Inspect symbol")) (clouseau:inspector symbol :new-process t)) --- /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/18 15:10:24 1.2 +++ /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/18 21:32:15 1.3 @@ -8,6 +8,30 @@ ((file 'pathname)) (find-file file)) +;; This command and presentation translator exists here, because we +;; want it to be completely ubiquitous in Climacs - specifically, we +;; want to be able to go to the definition of a symbol just by +;; clicking on any properly `present'ed object. +(define-command (com-edit-definition :name t :command-table global-climacs-table) + ((symbol 'symbol + :prompt "Edit symbol")) + "Edit the definition of a symbol. + +If the symbol has been defined more than once (eg. to a function +as well as a class, or as numerous methods), a +mouse-click-sensitive list of available definitions will be +displayed." + (climacs-lisp-syntax:edit-definition symbol)) + +(define-presentation-to-command-translator edit-definition + (symbol com-edit-definition global-climacs-table + :gesture :select + :tester ((object presentation) + (declare (ignore object)) + (not (eq (presentation-type presentation) 'unknown-symbol))) + :documentation "Edit definition") + (object) + (list object)) (define-command (com-inspect-buffer :name "Inspect Buffer" :command-table base-table) () (clouseau:inspector (buffer (current-window)))) --- /project/clim-desktop/cvsroot/clim-desktop/clim-desktop.asd 2006/03/30 10:33:55 1.3 +++ /project/clim-desktop/cvsroot/clim-desktop/clim-desktop.asd 2006/05/18 21:32:15 1.4 @@ -26,7 +26,7 @@ (:file "clhs-lookup" :depends-on ("abbrev")) (:file "misc") (:file "beirc") - (:file "climacs") + (:file "climacs" :depends-on ("swine-cmds")) (:file "debugger" :depends-on ("EDITME")) (:file "listener") (:file "clim-launcher" :depends-on ("packages")) From thenriksen at common-lisp.net Thu May 18 22:13:25 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Thu, 18 May 2006 18:13:25 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060518221325.06E0C63034@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv30373 Modified Files: swine.lisp swine-cmds.lisp Log Message: Changed the macroexpansion code to be more sane, simpler and not use Swank. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/18 21:32:15 1.6 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/18 22:13:24 1.7 @@ -47,9 +47,7 @@ (defun text-of-expression-at-mark (mark syntax) "Return the text of the expression at mark." (let ((expression (expression-at-mark mark syntax))) - (buffer-substring (buffer mark) - (start-offset expression) - (end-offset expression)))) + (token-string syntax expression))) (defun symbol-name-at-mark (mark syntax) "Return the text of the symbol at mark." @@ -57,27 +55,28 @@ (expression-at-mark mark syntax) :preserve))) -(defun macroexpand-with-swank (mark syntax &optional (all nil)) - (with-slots (package) syntax - (let* ((string (text-of-expression-at-mark mark syntax)) - (swank::*buffer-package* (or package *package*)) - (swank::*buffer-readtable* *readtable*) - (expansion (if all - (swank::swank-macroexpand-all string) - (swank::swank-macroexpand string)))) - (let ((buffer (climacs-gui::switch-to-buffer "*Macroexpansion*"))) - (climacs-gui::set-syntax buffer "Lisp")) - (let ((point (point (climacs-gui::current-window))) - (header-string (one-line-ify (subseq string 0 - (min 40 (length string)))))) - (climacs-gui::end-of-buffer point) - (unless (beginning-of-buffer-p point) - (insert-object point #\Newline)) - (insert-sequence point - (format nil ";;; Macroexpand-~:[1~;all~] ~A...~%" - all header-string)) - (insert-sequence point expansion) - (insert-object point #\Newline))))) +(defun macroexpand-token (syntax token &optional (all nil)) + (let* ((string (token-string syntax token)) + (expression (read-from-string string)) + (expansion (funcall (if all + #'macroexpand + #'macroexpand-1) + expression)) + (expansion-string (with-output-to-string (s) + (pprint expansion s)))) + (let ((buffer (climacs-gui::switch-to-buffer "*Macroexpansion*"))) + (climacs-gui::set-syntax buffer "Lisp")) + (let ((point (point (climacs-gui::current-window))) + (header-string (one-line-ify (subseq string 0 + (min 40 (length string)))))) + (climacs-gui::end-of-buffer point) + (unless (beginning-of-buffer-p point) + (insert-object point #\Newline)) + (insert-sequence point + (format nil ";;; Macroexpand-~:[1~;all~] ~A...~%" + all header-string)) + (insert-sequence point expansion-string) + (insert-object point #\Newline)))) (defun last-expression (mark syntax) "Returns the expression before MARK" --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/18 21:32:15 1.12 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/18 22:13:24 1.13 @@ -41,8 +41,11 @@ The expanded expression will be displayed in a \"*Macroexpansion*\"-buffer." - (macroexpand-with-swank (point (current-window)) - (syntax (buffer (current-window))))) + (let* ((syntax (syntax (buffer (current-window)))) + (token (expression-at-mark (point (current-window)) syntax))) + (if token + (macroexpand-token syntax token) + (esa:display-message "Nothing to expand at point.")))) (esa:set-key 'com-macroexpand-1 'lisp-table @@ -58,8 +61,11 @@ The expanded expression will be displayed in a \"*Macroexpansion*\"-buffer." - (macroexpand-with-swank (point (current-window)) - (syntax (buffer (current-window))) t)) + (let* ((syntax (syntax (buffer (current-window)))) + (token (expression-at-mark (point (current-window)) syntax))) + (if token + (macroexpand-token syntax token t) + (esa:display-message "Nothing to expand at point.")))) (define-command (com-eval-region :name t :command-table lisp-table) () From thenriksen at common-lisp.net Fri May 19 10:00:53 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Fri, 19 May 2006 06:00:53 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060519100053.2B0C253010@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv26918 Modified Files: swine.lisp swine-cmds.lisp Log Message: Simplified Eval Last Expression command. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/18 22:13:24 1.7 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/19 10:00:52 1.8 @@ -78,19 +78,6 @@ (insert-sequence point expansion-string) (insert-object point #\Newline)))) -(defun last-expression (mark syntax) - "Returns the expression before MARK" - (let ((m (clone-mark mark))) - (backward-expression m syntax) - (buffer-substring (buffer mark) (offset m) (offset mark)))) - -(defun eval-last-expression-with-swank (mark syntax) - (with-slots (package) syntax - (let* ((swank::*buffer-package* (or package *package*)) - (swank::*buffer-readtable* *readtable*) - (message (swank::interactive-eval (last-expression mark syntax)))) - (climacs-gui::display-message message)))) - (defun eval-region-with-swank (start end syntax) (with-slots (package) syntax (let* ((swank::*buffer-package* (or package *package*)) --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/18 22:13:24 1.13 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/19 10:00:52 1.14 @@ -26,12 +26,19 @@ (in-package :climacs-lisp-syntax) (define-command (com-eval-last-expression :name t :command-table lisp-table) - () + ((insertp 'boolean :prompt "Insert?")) "Evaluate the expression before point." - (eval-last-expression-with-swank (point (current-window)) - (syntax (buffer (current-window))))) + (let* ((syntax (syntax (buffer (current-window)))) + (mark (point (current-window))) + (token (form-before syntax (offset mark)))) + (if token + (let ((*package* (slot-value syntax 'package))) + (climacs-gui::com-eval-expression + (read-from-string (token-string syntax token)) + insertp)) + (esa:display-message "Nothing to evaluate.")))) -(esa:set-key 'com-eval-last-expression +(esa:set-key `(com-eval-last-expression ,esa:*numeric-argument-p*) 'lisp-table '((#\c :control) (#\e :control))) From thenriksen at common-lisp.net Fri May 19 10:03:11 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Fri, 19 May 2006 06:03:11 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060519100311.D1E4153012@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv27281 Modified Files: climacs.lisp Log Message: Added Inspect Syntax convenience command. --- /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/18 21:32:15 1.3 +++ /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/19 10:03:11 1.4 @@ -39,6 +39,9 @@ (define-command (com-inspect-window :name "Inspect Current Window" :command-table base-table) () (clouseau:inspector (current-window))) +(define-command (com-inspect-syntax :name "Inspect Syntax" :command-table base-table) () + (clouseau:inspector (current-window))) + (set-key 'com-inspect-buffer 'base-table '((#\c :control) (#\d :control) (#\b :control))) @@ -47,6 +50,10 @@ 'base-table '((#\c :control) (#\d :control) (#\w :control))) +(set-key 'com-inspect-syntax + 'base-table + '((#\c :control) (#\d :control) (#\s :control))) + (defun climacs-edit (file &key (width 900) (height 400)) "Starts up a climacs session" (let ((frame (make-application-frame 'climacs :width width :height height))) From thenriksen at common-lisp.net Sat May 20 17:30:30 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Sat, 20 May 2006 13:30:30 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060520173030.498357021B@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv25801 Modified Files: swine.lisp swine-cmds.lisp Log Message: De-Swankified and slightly improved Eval Region. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/19 10:00:52 1.8 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/20 17:30:30 1.9 @@ -78,13 +78,30 @@ (insert-sequence point expansion-string) (insert-object point #\Newline)))) -(defun eval-region-with-swank (start end syntax) - (with-slots (package) syntax - (let* ((swank::*buffer-package* (or package *package*)) - (swank::*buffer-readtable* *readtable*) - (message (swank::interactive-eval-region - (buffer-substring (buffer start) (offset start) (offset end))))) - (climacs-gui::display-message message)))) +(defun eval-string (string) + "Evaluate all expressions in STRING and return a list of +results." + (with-input-from-string (stream string) + (loop for form = (read stream nil stream) + while (not (eq form stream)) + collecting (multiple-value-list (eval form))))) + +(defun eval-region (start end syntax) + ;; Must be (mark>= end start). + (with-slots (package) syntax + (let* ((string (buffer-substring (buffer start) + (offset start) + (offset end))) + (values (multiple-value-list + (handler-case (eval-string string) + (error (condition) + (progn (beep) + (esa:display-message "~A" condition) + (return-from eval-region nil)))))) + ;; Enclose each set of values in {}. + (result (apply #'format nil "~{{~:[No values~;~:*~{~S~^,~}~]}~}" + values))) + (esa:display-message result)))) (defun compile-defun-with-swank (mark pane syntax) (with-slots (package) syntax --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/19 10:00:52 1.14 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/20 17:30:30 1.15 @@ -77,9 +77,12 @@ (define-command (com-eval-region :name t :command-table lisp-table) () "Evaluate the current region." - (eval-region-with-swank (point (current-window)) - (mark (current-window)) - (syntax (buffer (current-window))))) + (let ((mark (mark (current-window))) + (point (point (current-window)))) + (when (mark> mark point) + (rotatef mark point)) + (eval-region mark point + (syntax (buffer (current-window)))))) (esa:set-key 'com-eval-region 'lisp-table From thenriksen at common-lisp.net Sat May 20 18:41:27 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Sat, 20 May 2006 14:41:27 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060520184127.91B9F1F012@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv841 Modified Files: climacs.lisp Log Message: Fixed Inspect Syntax command. --- /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/19 10:03:11 1.4 +++ /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/20 18:41:27 1.5 @@ -40,7 +40,7 @@ (clouseau:inspector (current-window))) (define-command (com-inspect-syntax :name "Inspect Syntax" :command-table base-table) () - (clouseau:inspector (current-window))) + (clouseau:inspector (syntax (current-buffer)))) (set-key 'com-inspect-buffer 'base-table From thenriksen at common-lisp.net Sun May 28 12:26:08 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Sun, 28 May 2006 08:26:08 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060528122608.61C0A1E007@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv28292 Modified Files: swine.lisp swine-cmds.lisp Log Message: * Cleaned some of the mechanics of the parameter hinting code, factored some of the hairy bits to a reusable `with-code-insight'-macro. * Begun the construction of a form traits protocol for customizing the parameter hinting of forms. * Fixed handling of values for &optional parameters with default values. * Added parameter hinting for ((lambda (...) ...) ...)-style forms. :-) --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/20 17:30:30 1.9 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/28 12:26:08 1.10 @@ -449,7 +449,7 @@ optional-args-count) provided-args-count)))) (append (mapcar #'cons - (get-args '&optional) + (mapcar #'unlisted (get-args '&optional)) opt-args-values) (loop @@ -667,57 +667,81 @@ operator))) arglist))) -(defun show-arglist-silent (symbol &optional +(defmethod arglist-for-form ((operator list) &optional arguments) + (declare (ignore arguments)) + (case (first operator) + ('cl:lambda (second operator)))) + +(defgeneric operator-for-display (operator) + (:documentation "Return what should be displayed whenever + `operator' is displayed as an operator.") + (:method (operator) + operator)) + +(defmethod operator-for-display ((operator list)) + (case (first operator) + ('cl:lambda '|Lambda-Expression|))) + +(defun display-arglist-to-stream (stream operator arglist + &optional emphasized-symbols + highlighted-symbols) + "Display the operator and arglist to stream, format as + appropriate." + ;; FIXME: This is fairly ugly. + (labels ((display-symbol (symbol) + (with-text-style + (stream + `(nil + ,(cond ((member symbol + highlighted-symbols) + :bold) + ((member symbol + emphasized-symbols) + :italic)) + nil)) + (format stream "~A" symbol))) + (display-list (list) + (if (and (eq (first list) 'quote) + (= (length list) 2)) + (progn + (format stream "'") + (display-argument (second list))) + (progn + (format stream "(") + (display-argument (first list)) + (dolist (arg (rest list)) + (format stream " ") + (display-argument arg)) + (format stream ")")))) + (display-argument (arg) + (if (and (listp arg) + (not (null arg))) + (display-list arg) + (display-symbol arg)))) + (display-argument (cons (operator-for-display operator) + arglist)))) + +(defun show-arglist-silent (operator &optional current-arg-indices preceding-arg arguments) - "Display the arglist for `symbol' in the minibuffer, do not -complain if `symbol' is not bound to a function. + "Display the arglist for `operator' in the minibuffer, do not +complain if `operator' is not bound to, or is not, a function. `Current-arg-index' and `preceding-arg' are used to add extra information to the arglist display. `Arguments' should be either nil or a list of provided arguments in the form housing symbol. Returns NIL if an arglist cannot be displayed." - (when (fboundp symbol) - (multiple-value-bind (arglist emphasized-symbols highlighted-symbols) - (analyze-arglist - (arglist-for-form symbol arguments) - current-arg-indices - preceding-arg - arguments) - ;; FIXME: This is fairly ugly. - (esa:with-minibuffer-stream (minibuffer) - (labels ((display-symbol (symbol) - (with-text-style - (minibuffer - `(nil - ,(cond ((member symbol - highlighted-symbols) - :bold) - ((member symbol - emphasized-symbols) - :italic)) - nil)) - (format minibuffer "~A" symbol))) - (display-list (list) - (if (and (eq (first list) 'quote) - (= (length list) 2)) - (progn - (format minibuffer "'") - (display-argument (second list))) - (progn - (format minibuffer "(") - (display-argument (first list)) - (dolist (arg (rest list)) - (format minibuffer " ") - (display-argument arg)) - (format minibuffer ")")))) - (display-argument (arg) - (if (and (listp arg) - (not (null arg))) - (display-list arg) - (display-symbol arg)))) - (display-argument (cons symbol arglist))))))) + (multiple-value-bind (arglist emphasized-symbols highlighted-symbols) + (analyze-arglist + (arglist-for-form operator arguments) + current-arg-indices + preceding-arg + arguments) + (esa:with-minibuffer-stream (minibuffer) + (display-arglist-to-stream minibuffer operator + arglist emphasized-symbols + highlighted-symbols)))) (defun show-arglist (symbol name) (unless (show-arglist-silent symbol) @@ -795,30 +819,74 @@ :no-error t)))) (values preceding-arg-obj argument-indices))) +(defun valid-operator-p (operator) + "Check whether or not `operator' is a valid + operator. `Operator' is considered a valid operator if it is a + symbol bound to a function." + (and (symbolp operator) + (fboundp operator))) + +(defmacro with-code-insight (mark syntax (&key operator preceding-operand + form preceding-operand-indices + operands) + &body body) + "Evaluate `body' with the provided symbols lexically bound to + interesting details about the code at `mark'. If `mark' is not + within a form, everything will be bound to nil." + (let ((operator-sym (or operator (gensym))) + (preceding-operand-sym (or preceding-operand (gensym))) + (operands-sym (or operands (gensym))) + (form-sym (or form (gensym))) + (operand-indices-sym (or preceding-operand-indices (gensym))) + ;; My kingdom for with-gensyms! + (mark-value-sym (gensym)) + (syntax-value-sym (gensym))) + `(let* ((,mark-value-sym ,mark) + (,syntax-value-sym ,syntax) + (,form-sym + ;; Find a form with a valid (fboundp) operator. + (let ((immediate-form + (or (form-before ,syntax-value-sym (offset ,mark-value-sym)) + (form-around ,syntax-value-sym (offset ,mark-value-sym))))) + ;; Recurse upwards until we find a form with a valid + ;; operator. This could be improved a lot, as we could + ;; inspect the lambda list of the found operator and + ;; check if the position of mark makes sense with + ;; 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 (valid-operator-p (form-operator + form + ,syntax-value-sym)) + form + (when (and form (parent form)) + (recurse (parent 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 + ;; up any of this stuff. + (,operator-sym (when ,form-sym (form-operator ,form-sym ,syntax-value-sym))) + (,operands-sym (when ,form-sym (form-operands ,form-sym ,syntax-value-sym)))) + (multiple-value-bind (,preceding-operand-sym ,operand-indices-sym) + (when ,form-sym (find-operand-info ,mark-value-sym ,syntax-value-sym ,form-sym)) + , at body)))) + ;; This is a generic function in order to facilitate different lambda ;; list types for different form types (I'm not yet sure when this ;; would be useful). -(defgeneric show-arglist-for-form (mark syntax form) +(defgeneric show-arglist-for-form (mark syntax) (:documentation "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.")) -(defmethod show-arglist-for-form (mark syntax form) - (let* ((operator-symbol (form-operator form syntax))) - ;; The user may have provided an invalid function name as the - ;; operator - that should not result in an error. - (if (ignore-errors (fboundp operator-symbol)) - (let* ((form-operands (form-operands form syntax))) - (multiple-value-bind (preceding-operand preceding-operand-indices) - (find-operand-info mark syntax form) - (show-arglist-silent operator-symbol - preceding-operand-indices - preceding-operand - form-operands))) - ;; If the symbol is not bound to a function, we move up - ;; a level and try that lists operator. - (when (parent form) - (show-arglist-for-form mark syntax (parent form)))))) +(defmethod show-arglist-for-form (mark syntax) + (with-code-insight mark syntax (:operator operator + :preceding-operand preceding-operand + :preceding-operand-indices preceding-operand-indices + :operands operands) + ;; The operator is not something usable (it might be a lambda form). + (show-arglist-silent operator preceding-operand-indices preceding-operand operands))) (defparameter *swine-find-definition-stack* '()) --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/20 17:30:30 1.15 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/28 12:26:08 1.16 @@ -221,12 +221,9 @@ ;; the parse tree our insertion of a space character may have ;; done. (update-syntax (buffer syntax) syntax) - ;; Try to find the argument before point, if that is not possibly, + ;; Try to find the argument before point, if that is not possible, ;; find the form that point is in. - (let ((immediate-form (or (form-before syntax (offset mark)) - (form-around syntax (offset mark))))) - (when immediate-form - (show-arglist-for-form mark syntax (parent immediate-form)))) + (show-arglist-for-form mark syntax) (forward-object mark) (clear-completions))) From thenriksen at common-lisp.net Sun May 28 13:37:46 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Sun, 28 May 2006 09:37:46 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060528133746.E472C3300F@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv5295 Modified Files: swine.lisp Log Message: Added list of lambda list keywords that should not be displayed. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/28 12:26:08 1.10 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/28 13:37:46 1.11 @@ -413,6 +413,9 @@ (defparameter +cl-arglist-keywords+ '(&whole &optional &rest &key &allow-other-keys &aux &body &environment)) +(defparameter +cl-garbage-keywords+ + '(&whole &environment)) + (defun find-optional-argument-values (arglist provided-args &optional (split-arglist (split-arglist-on-keywords @@ -565,18 +568,18 @@ ; &aux parameters that should ; not be displayed. - with in-&environment ; If non-NIL, the next - ; argument is an &environment + with in-garbage ; If non-NIL, the next + ; argument is a garbage ; parameter that should not be ; displayed. if (eq arg-element '&aux) do (setf in-&aux t) - else if (eq arg-element '&environment) - do (setf in-&environment t) + else if (member arg-element +cl-garbage-keywords+ :test #'eq) + do (setf in-garbage t) else if (and (listp arg-element) (> mandatory-argument-count index) - (not in-&environment) + (not in-garbage) (not in-&aux)) collect (multiple-value-bind (arglist sublist-emphasized-symbols @@ -604,15 +607,15 @@ emphasized-symbols)))) arglist) else if (and (assoc arg-name user-supplied-arg-values) - (not in-&environment) + (not in-garbage) (not in-&aux)) collect (list arg-name (rest (assoc arg-name user-supplied-arg-values))) else - if in-&environment - do (setf in-&environment nil) + if in-garbage + do (setf in-garbage nil) else if (not in-&aux) collect arg-element))) (setf ret-arglist (generate-arglist arglist))) From thenriksen at common-lisp.net Sun May 28 16:28:42 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Sun, 28 May 2006 12:28:42 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060528162842.E832422007@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv25693 Modified Files: swine.lisp Log Message: Added code to handle the case where `current-arg-indices' is NIL. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/28 13:37:46 1.11 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/28 16:28:42 1.12 @@ -479,54 +479,56 @@ &optional (split-arglist (split-arglist-on-keywords arglist))) "Find the simple arguments of `arglist' that would be affected if an argument was intered at index `current-arg-index' in the - arglist. `Preceding-arg-key' should either be nil or the - argument directly preceding point. `Split-arglist' should - either be a split arglist or nil, in which case `split-arglist' - will be computed from `arglist'. This function returns two - values: The primary value is a list of symbols that should be - emphasized, the secondary value is a list of symbols that - should be highlighted." - (flet ((get-args (keyword) - (rest (assoc keyword split-arglist)))) - (let ((mandatory-argument-count (length (get-args '&mandatory)))) - (cond ((> mandatory-argument-count - current-arg-index) - ;; We are in the main, mandatory, positional arguments. - (let ((relevant-arg (elt (get-args '&mandatory) - current-arg-index))) - ;; We do not handle complex argument lists here, only - ;; pure standard arguments. - (unless (and (listp relevant-arg) - (< current-arg-index mandatory-argument-count)) - (values nil (list (unlisted relevant-arg)))))) - ((> (+ (length (get-args '&optional)) - (length (get-args '&mandatory))) - current-arg-index) - ;; We are in the &optional arguments. - (values nil - (list (unlisted (elt (get-args '&optional) - (- current-arg-index - (length (get-args '&mandatory)))))))) - (t - (let ((body-or-rest-args (or (get-args '&rest) - (get-args '&body))) - (key-arg (find (format nil "~A" preceding-arg) - (get-args '&key) - :test #'string= - :key #'(lambda (arg) - (symbol-name (unlisted arg)))))) - ;; We are in the &body, &rest or &key arguments. - (values - ;; Only emphasize the &key - ;; symbol if we are in a position to add a new - ;; keyword-value pair, and not just in a position to - ;; specify a value for a keyword. - (when (and (null key-arg) - (get-args '&key)) - '(&key)) - (append (when key-arg - (list (unlisted key-arg))) - body-or-rest-args)))))))) + arglist. If `current-arg-index' is nil, no calculation will be + done (this function will just return nil). `Preceding-arg' + should either be nil or the argument directly preceding + point. `Split-arglist' should either be a split arglist or nil, + in which case `split-arglist' will be computed from + `arglist'. This function returns two values: The primary value + is a list of symbols that should be emphasized, the secondary + value is a list of symbols that should be highlighted." + (when current-arg-index + (flet ((get-args (keyword) + (rest (assoc keyword split-arglist)))) + (let ((mandatory-argument-count (length (get-args '&mandatory)))) + (cond ((> mandatory-argument-count + current-arg-index) + ;; We are in the main, mandatory, positional arguments. + (let ((relevant-arg (elt (get-args '&mandatory) + current-arg-index))) + ;; We do not handle complex argument lists here, only + ;; pure standard arguments. + (unless (and (listp relevant-arg) + (< current-arg-index mandatory-argument-count)) + (values nil (list (unlisted relevant-arg)))))) + ((> (+ (length (get-args '&optional)) + (length (get-args '&mandatory))) + current-arg-index) + ;; We are in the &optional arguments. + (values nil + (list (unlisted (elt (get-args '&optional) + (- current-arg-index + (length (get-args '&mandatory)))))))) + (t + (let ((body-or-rest-args (or (get-args '&rest) + (get-args '&body))) + (key-arg (find (format nil "~A" preceding-arg) + (get-args '&key) + :test #'string= + :key #'(lambda (arg) + (symbol-name (unlisted arg)))))) + ;; We are in the &body, &rest or &key arguments. + (values + ;; Only emphasize the &key + ;; symbol if we are in a position to add a new + ;; keyword-value pair, and not just in a position to + ;; specify a value for a keyword. + (when (and (null key-arg) + (get-args '&key)) + '(&key)) + (append (when key-arg + (list (unlisted key-arg))) + body-or-rest-args))))))))) (defun analyze-arglist-impl (arglist current-arg-indices preceding-arg provided-args) "The implementation for `analyze-arglist'." @@ -537,7 +539,9 @@ split-arglist)) (mandatory-argument-count (length (rest (assoc '&mandatory split-arglist)))) - (current-arg-index (or (first current-arg-indices) 0)) + + (current-arg-index (or (first current-arg-indices) + 0)) ret-arglist emphasized-symbols highlighted-symbols) @@ -546,18 +550,23 @@ ;; arguments will be handled specially. (multiple-value-bind (es hs) (find-affected-simple-arguments arglist - current-arg-index + ;; if `current-arg-indices' is + ;; nil, that means that we do + ;; not have enough information + ;; to properly highlight + ;; symbols in the arglist. + (and current-arg-indices + current-arg-index) preceding-arg split-arglist) (setf emphasized-symbols es) (setf highlighted-symbols hs)) - ;; We loop over the arglist and build a new list, and if we - ;; have a default value for a given argument, we insert it into - ;; the list. Also, whenever we encounter a list in a mandatory - ;; argument position, we assume that it is a destructuring - ;; arglist and recursively calls `analyze-arglist' on it - ;; to find the arglist and emphasized and highlighted symbols for - ;; it. + ;; We loop over the arglist and build a new list, and if we have a + ;; default value for a given argument, we insert it into the + ;; list. Also, whenever we encounter a list in a mandatory + ;; argument position, we assume that it is a destructuring arglist + ;; and recursively calls `analyze-arglist' on it to find the + ;; arglist and emphasized and highlighted symbols for it. (labels ((generate-arglist (arglist) (loop for arg-element in arglist @@ -589,10 +598,16 @@ preceding-arg (when (< index (length provided-args)) (listed (elt provided-args index)))) - ;; Unless our `current-arg-index' actually - ;; refers to this sublist, its highlighted - ;; and emphasized symbols are ignored. - (if (= index current-arg-index) + ;; Unless our `current-arg-index' + ;; actually refers to this sublist, its + ;; highlighted and emphasized symbols + ;; are ignored. Also, if + ;; `current-arg-indices' is nil, that + ;; means that we do not have enough + ;; information to properly highlight + ;; symbols in the arglist. + (when (and current-arg-indices + (= index current-arg-index)) (if (and (rest current-arg-indices)) (setf emphasized-symbols (union (mapcar #'unlisted From thenriksen at common-lisp.net Sun May 28 16:48:46 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Sun, 28 May 2006 12:48:46 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060528164846.DF0DD3300A@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv28990 Modified Files: swine.lisp swine-cmds.lisp Log Message: Changed the name of the command Arglist Lookup to Lookup Arglist and cleaned it a bit. Factored the lookup-arglist-at-point functionality into a command imaginatively named com-lookup-arglist-for-this-symbol. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/28 16:28:42 1.12 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/28 16:48:46 1.13 @@ -761,9 +761,10 @@ arglist emphasized-symbols highlighted-symbols)))) -(defun show-arglist (symbol name) - (unless (show-arglist-silent symbol) - (esa:display-message "Function ~a not found." name))) +(defun show-arglist (symbol) + (unless (and (fboundp symbol) + (show-arglist-silent symbol)) + (esa:display-message "Function ~a not found." symbol))) (defun find-argument-indices-for-operand (syntax operand-form operator-form) "Return a list of argument indices for `argument-form' relative --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/28 12:26:08 1.16 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/28 16:48:46 1.17 @@ -187,22 +187,25 @@ 'lisp-table '((#\c :control) (#\d :control) (#\h))) -(define-command (com-arglist-lookup :name t :command-table lisp-table) +(define-command (com-lookup-arglist-for-this-symbol :command-table lisp-table) + () + "Show argument list for symbol at point." + (let* ((pane (current-window)) + (buffer (buffer pane)) + (syntax (syntax buffer)) + (mark (point pane)) + (token (or (form-before syntax (offset mark)) + (form-around syntax (offset mark))))) + (if (and token (typep token 'complete-token-lexeme)) + (com-lookup-arglist (token-to-object syntax token)) + (esa:display-message "Could not find symbol at point.")))) + +(define-command (com-lookup-arglist :name t :command-table lisp-table) ((symbol 'symbol :prompt "Symbol")) - "Show argument list for given symbol. If the provided argument -is nil, this command will attempt to find a token at point." - (let* ((name (string-upcase (or symbol - (symbol-name-at-mark (point (current-window)) - (syntax (buffer (current-window)))) - (accept 'symbol :prompt "Symbol"))))) - (with-slots (package) (syntax (buffer (current-window))) - (let ((function-symbol (let* ((pos2 (position #\: name :from-end t)) - (pos1 (if (and pos2 (char= (elt name (1- pos2)) #\:)) (1- pos2) pos2) )) - (if pos2 (find-symbol (subseq name (1+ pos2)) (subseq name 0 pos1)) - (find-symbol name (or package *package*)))))) - (show-arglist function-symbol (string-upcase name)))))) + "Show argument list for a given symbol." + (show-arglist symbol)) -(esa:set-key '(com-arglist-lookup nil) +(esa:set-key `(com-lookup-arglist-for-this-symbol) 'lisp-table '((#\c :control) (#\d :control) (#\a))) @@ -307,7 +310,7 @@ (list object)) (define-presentation-to-command-translator lookup-symbol-arglist - (symbol com-arglist-lookup lisp-table + (symbol com-lookup-arglist lisp-table :gesture :describe :tester ((object presentation) (declare (ignore object)) From thenriksen at common-lisp.net Tue May 30 20:38:58 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Tue, 30 May 2006 16:38:58 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060530203858.213EA7E05A@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv5224 Modified Files: swine.lisp swine-cmds.lisp Log Message: Factored selection of "this" form into an inventively named `this-form' function. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/28 16:48:46 1.13 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/30 20:38:58 1.14 @@ -55,6 +55,12 @@ (expression-at-mark mark syntax) :preserve))) +(defun this-form (mark syntax) + "Return a form at mark. This function defines which + forms the COM-FOO-this commands affect." + (or (form-around syntax (offset mark)) + (form-before syntax (offset mark)))) + (defun macroexpand-token (syntax token &optional (all nil)) (let* ((string (token-string syntax token)) (expression (read-from-string string)) @@ -865,8 +871,7 @@ (,form-sym ;; Find a form with a valid (fboundp) operator. (let ((immediate-form - (or (form-before ,syntax-value-sym (offset ,mark-value-sym)) - (form-around ,syntax-value-sym (offset ,mark-value-sym))))) + (this-form (offset ,mark-value-sym) ,syntax-value-sym))) ;; Recurse upwards until we find a form with a valid ;; operator. This could be improved a lot, as we could ;; inspect the lambda list of the found operator and --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/28 16:48:46 1.17 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/30 20:38:58 1.18 @@ -152,8 +152,7 @@ (let* ((buffer (buffer (current-window))) (point (point (current-window))) (syntax (syntax buffer)) - (token (or (form-around syntax (offset point)) - (form-before syntax (offset point)))) + (token (this-form point syntax)) (this-symbol (when token (token-to-object syntax token)))) (when (and this-symbol (symbolp this-symbol)) (edit-definition this-symbol)))) @@ -194,8 +193,7 @@ (buffer (buffer pane)) (syntax (syntax buffer)) (mark (point pane)) - (token (or (form-before syntax (offset mark)) - (form-around syntax (offset mark))))) + (token (this-form mark syntax))) (if (and token (typep token 'complete-token-lexeme)) (com-lookup-arglist (token-to-object syntax token)) (esa:display-message "Could not find symbol at point.")))) From thenriksen at common-lisp.net Tue May 30 21:50:40 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Tue, 30 May 2006 17:50:40 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060530215040.6AD51710F2@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv14851 Modified Files: climacs.lisp Log Message: Cooler `ed' - now also handles symbols, and an Edit Definition translator is now globally accessible in all CLIM applications when running CLIM-Desktop. --- /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/20 18:41:27 1.5 +++ /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/30 21:50:40 1.6 @@ -54,22 +54,74 @@ 'base-table '((#\c :control) (#\d :control) (#\s :control))) -(defun climacs-edit (file &key (width 900) (height 400)) - "Starts up a climacs session" - (let ((frame (make-application-frame 'climacs :width width :height height))) - (flet ((run () - (run-frame-top-level frame))) - (let ((clim-process (clim-sys:make-process #'run :name (format nil "Climacs: ~A" file)))) - (sleep 1) - (execute-frame-command frame `(com-find-file ,file)))))) +(defmacro with-climacs-frame ((frame-symbol) &body body) + (let ((frame-manager-sym (gensym))) + `(let ((,frame-manager-sym (find-frame-manager))) + (when ,frame-manager-sym + (let ((,frame-symbol (find-if (lambda (x) (typep x 'climacs)) + (frame-manager-frames ,frame-manager-sym)))) + , at body))))) +(defun ensure-climacs () + "Ensure Climacs is running, start it in a new process if it +isn't." + (with-climacs-frame (frame) + (unless frame + (climacs :new-process t) + ;; FIXME: The new frame must be ready, this is a hack. + (sleep 1)))) + +(defgeneric edit-in-climacs (thing) + (:documentation "Edit thing in Climacs, start Climacs if is not + running.") + (:method :before (thing) + (declare (ignore thing)) + (ensure-climacs))) + +(defmethod edit-in-climacs ((thing pathname)) + (when (wild-pathname-p thing) + (error 'file-error :pathname thing + "Cannot edit wild pathname.")) + (with-climacs-frame (frame) + (when frame + (execute-frame-command + frame `(com-find-file ,thing))))) + +(defmethod edit-in-climacs ((thing string)) + ;; Hope it is a pathname. + (edit-in-climacs (pathname thing))) + +(defmethod edit-in-climacs ((thing symbol)) + (with-climacs-frame (frame) + (when frame + (execute-frame-command + frame `(com-edit-definition ,thing))))) ;; Redefine (ed) (handler-bind ((#+sbcl sb-ext:package-lock-violation #+cmucl lisp::package-locked-error #-sbcl simple-error #'(lambda (c) + (declare (ignore c)) (invoke-restart 'continue)))) - (defun ed (foo) - (climacs-edit foo))) + (defun ed (&optional foo) + (if (not (null foo)) + (edit-in-climacs foo) + (progn + (ensure-climacs) + (with-climacs-frame (frame) + (raise-frame frame)))))) + +(define-command (com-edit-in-climacs :command-table global-command-table) + ((thing t)) + (edit-in-climacs thing)) +(define-presentation-to-command-translator global-edit-definition + (symbol com-edit-in-climacs global-command-table + :gesture :select + :tester ((object presentation) + (declare (ignore object)) + (not (eq (presentation-type presentation) 'unknown-symbol))) + :documentation "Edit definition") + (object) + (list object)) \ No newline at end of file From thenriksen at common-lisp.net Tue May 30 21:59:25 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Tue, 30 May 2006 17:59:25 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060530215925.EC170762F7@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv15024 Modified Files: climacs.lisp Log Message: Added presentation translators for commands and command names. --- /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/30 21:50:40 1.6 +++ /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/30 21:59:25 1.7 @@ -122,6 +122,20 @@ :tester ((object presentation) (declare (ignore object)) (not (eq (presentation-type presentation) 'unknown-symbol))) - :documentation "Edit definition") + :documentation "Edit Definition") (object) - (list object)) \ No newline at end of file + (list object)) + +(define-presentation-to-command-translator global-edit-definition + (command-name com-edit-in-climacs global-command-table + :gesture :select + :documentation "Edit Definition Of Command") + (object) + (list object)) + +(define-presentation-to-command-translator global-edit-definition + (command com-edit-in-climacs global-command-table + :gesture :select + :documentation "Edit Definition Of Command") + (object) + (list (command-name object))) \ No newline at end of file From thenriksen at common-lisp.net Tue May 30 22:18:17 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Tue, 30 May 2006 18:18:17 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060530221817.7488F7081@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv19156 Modified Files: climacs.lisp Log Message: Use the :edit gesture instead of :select for editing. --- /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/30 21:59:25 1.7 +++ /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/30 22:18:17 1.8 @@ -118,24 +118,24 @@ (define-presentation-to-command-translator global-edit-definition (symbol com-edit-in-climacs global-command-table - :gesture :select :tester ((object presentation) (declare (ignore object)) (not (eq (presentation-type presentation) 'unknown-symbol))) + :gesture :edit :documentation "Edit Definition") (object) (list object)) (define-presentation-to-command-translator global-edit-definition (command-name com-edit-in-climacs global-command-table - :gesture :select + :gesture :edit :documentation "Edit Definition Of Command") (object) (list object)) (define-presentation-to-command-translator global-edit-definition (command com-edit-in-climacs global-command-table - :gesture :select + :gesture :edit :documentation "Edit Definition Of Command") (object) (list (command-name object))) \ No newline at end of file From thenriksen at common-lisp.net Tue May 30 23:09:44 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Tue, 30 May 2006 19:09:44 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060530230944.3BB1A3D011@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv25913 Modified Files: swine.lisp Log Message: `This-form' uses a mark, not an offset. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/30 20:38:58 1.14 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/30 23:09:44 1.15 @@ -871,7 +871,7 @@ (,form-sym ;; Find a form with a valid (fboundp) operator. (let ((immediate-form - (this-form (offset ,mark-value-sym) ,syntax-value-sym))) + (this-form ,mark-value-sym ,syntax-value-sym))) ;; Recurse upwards until we find a form with a valid ;; operator. This could be improved a lot, as we could ;; inspect the lambda list of the found operator and From thenriksen at common-lisp.net Tue May 30 23:22:39 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Tue, 30 May 2006 19:22:39 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060530232239.884507D022@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv27804 Modified Files: swine.lisp Log Message: Fixed issue with symbol-completion and invalid package designators. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/30 23:09:44 1.15 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/30 23:22:39 1.16 @@ -61,6 +61,11 @@ (or (form-around syntax (offset mark)) (form-before syntax (offset mark)))) +(defun usable-package (package-designator) + "Return a usable package based on `package-designator'." + (or (find-package package-designator) + *package*)) + (defun macroexpand-token (syntax token &optional (all nil)) (let* ((string (token-string syntax token)) (expression (read-from-string string)) @@ -999,25 +1004,23 @@ (climacs-gui::delete-window *swine-completion-pane*) (setf *swine-completion-pane* nil))) - (defun show-completions-by-fn (fn symbol) - (with-slots (package) (syntax (buffer (climacs-gui::current-window))) - (climacs-gui::display-message (format nil "~a completions" symbol)) - (let* ((swank-result (funcall fn symbol (package-name (or package *package*)))) +(defun show-completions-by-fn (fn symbol) + (with-slots (package) (syntax (buffer (climacs-gui::current-window))) + (climacs-gui::display-message (format nil "~a completions" symbol)) + (let* ((swank-result (funcall fn symbol (package-name (usable-package package)))) (set (first swank-result)) (longest (second swank-result))) - (cond ((<= (length set) 1) - (clear-completions)) - (t (let ((stream (or *swine-completion-pane* - (climacs-gui::typeout-window "Simple Completions")))) - (setf *swine-completion-pane* stream) - (window-clear stream) - (format stream "~{~A~%~}" set)))) + (cond ((<= (length set) 1) + (clear-completions)) + (t (let ((stream (or *swine-completion-pane* + (climacs-gui::typeout-window "Simple Completions")))) + (setf *swine-completion-pane* stream) + (window-clear stream) + (format stream "~{~A~%~}" set)))) - (climacs-gui::display-message (format nil "Longest is ~a|" longest)) - longest))) - - + (climacs-gui::display-message (format nil "Longest is ~a|" longest)) + longest))) (defun show-completions (symbol) (show-completions-by-fn #'swank::completions symbol)) @@ -1025,21 +1028,21 @@ (defun show-simple-completions (symbol) (show-completions-by-fn #'swank::simple-completions symbol)) - (defun show-fuzzy-completions (symbol) - (with-slots (package) (syntax (buffer (climacs-gui::current-window))) - (climacs-gui::display-message (format nil "~a completions" symbol)) - (let* ((set (swank::fuzzy-completions symbol (package-name (or package *package*)) 10)) - (best (caar set))) +(defun show-fuzzy-completions (symbol) + (with-slots (package) (syntax (buffer (climacs-gui::current-window))) + (climacs-gui::display-message (format nil "~a completions" symbol)) + (let* ((set (swank::fuzzy-completions symbol (package-name (usable-package package)) 10)) + (best (caar set))) - (cond ((<= (length set) 1) - (clear-completions)) - (t (let ((stream (or *swine-completion-pane* - (climacs-gui::typeout-window "Simple Completions")))) - (setf *swine-completion-pane* stream) - (window-clear stream) - (loop for completed-string in set - do (format stream "~{~A ~}~%" completed-string))))) + (cond ((<= (length set) 1) + (clear-completions)) + (t (let ((stream (or *swine-completion-pane* + (climacs-gui::typeout-window "Simple Completions")))) + (setf *swine-completion-pane* stream) + (window-clear stream) + (loop for completed-string in set + do (format stream "~{~A ~}~%" completed-string))))) - (climacs-gui::display-message (format nil "Best is ~a|" best)) - best))) + (climacs-gui::display-message (format nil "Best is ~a|" best)) + best))) From thenriksen at common-lisp.net Wed May 31 11:11:08 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Wed, 31 May 2006 07:11:08 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060531111108.2D913742F6@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv25527 Modified Files: climacs.lisp Log Message: Cleanups and the removal of Climacs' own Edit Definition command. I think everything works now. --- /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/30 22:18:17 1.8 +++ /project/clim-desktop/cvsroot/clim-desktop/climacs.lisp 2006/05/31 11:11:08 1.9 @@ -8,31 +8,6 @@ ((file 'pathname)) (find-file file)) -;; This command and presentation translator exists here, because we -;; want it to be completely ubiquitous in Climacs - specifically, we -;; want to be able to go to the definition of a symbol just by -;; clicking on any properly `present'ed object. -(define-command (com-edit-definition :name t :command-table global-climacs-table) - ((symbol 'symbol - :prompt "Edit symbol")) - "Edit the definition of a symbol. - -If the symbol has been defined more than once (eg. to a function -as well as a class, or as numerous methods), a -mouse-click-sensitive list of available definitions will be -displayed." - (climacs-lisp-syntax:edit-definition symbol)) - -(define-presentation-to-command-translator edit-definition - (symbol com-edit-definition global-climacs-table - :gesture :select - :tester ((object presentation) - (declare (ignore object)) - (not (eq (presentation-type presentation) 'unknown-symbol))) - :documentation "Edit definition") - (object) - (list object)) - (define-command (com-inspect-buffer :name "Inspect Buffer" :command-table base-table) () (clouseau:inspector (buffer (current-window)))) @@ -112,11 +87,22 @@ (with-climacs-frame (frame) (raise-frame frame)))))) +(define-command (com-edit-definition :name t :command-table global-climacs-table) + ((symbol 'symbol + :prompt "Edit symbol")) + "Edit the definition of a symbol. + +If the symbol has been defined more than once (eg. to a function +as well as a class, or as numerous methods), a +mouse-click-sensitive list of available definitions will be +displayed." + (climacs-lisp-syntax:edit-definition symbol)) + (define-command (com-edit-in-climacs :command-table global-command-table) ((thing t)) (edit-in-climacs thing)) -(define-presentation-to-command-translator global-edit-definition +(define-presentation-to-command-translator global-edit-symbol-definition (symbol com-edit-in-climacs global-command-table :tester ((object presentation) (declare (ignore object)) @@ -126,14 +112,14 @@ (object) (list object)) -(define-presentation-to-command-translator global-edit-definition +(define-presentation-to-command-translator global-edit-command-name-definition (command-name com-edit-in-climacs global-command-table :gesture :edit :documentation "Edit Definition Of Command") (object) (list object)) -(define-presentation-to-command-translator global-edit-definition +(define-presentation-to-command-translator global-edit-command-definition (command com-edit-in-climacs global-command-table :gesture :edit :documentation "Edit Definition Of Command") From thenriksen at common-lisp.net Wed May 31 18:01:05 2006 From: thenriksen at common-lisp.net (thenriksen) Date: Wed, 31 May 2006 14:01:05 -0400 (EDT) Subject: [clim-desktop-cvs] CVS clim-desktop Message-ID: <20060531180105.58E3D420C@common-lisp.net> Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv22315 Modified Files: swine.lisp swine-cmds.lisp Log Message: De-Swankified Swine. Moved all direct calls to Swank functions to a small Swank-interface-layer and changed names of functions to downplay Swank (this also involved removing the name Swine from various commands). The purpose of this is to make the use of Swank more transparent and manageable, and to make Swine seem more integrated with the Lisp syntax and not appear like a separate library. The ultimate goal is, of course, to get Swine into Climacs itself. --- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/30 23:22:39 1.16 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/31 18:01:04 1.17 @@ -25,7 +25,80 @@ (in-package :climacs-lisp-syntax) -;; Convenience functions: +;;; Swank interface functions: + +(defun compile-string-for-climacs (string package buffer buffer-mark) + "Compile and evaluate `string' in `package'. Two values are +returned: The result of evaluating `string' and a list of +compiler notes. `Buffer' and `buffer-mark' will be used for +hyperlinking the compiler notes to the source code." + (let* ((buffer-name (name buffer)) + (buffer-file-name (filepath buffer)) + ;; swank::compile-string-for-emacs binds *compile-verbose* to t + ;; so we need to do this to avoid scribbles on the pane + (*standard-output* *debug-io*) + (swank::*buffer-package* package) + (swank::*buffer-readtable* *readtable*)) + (let ((result (swank::compile-string-for-emacs + string buffer-name (offset buffer-mark) buffer-file-name)) + (notes (loop for note in (swank::compiler-notes-for-emacs) + collect (make-compiler-note note)))) + (values result notes)))) + +(defun compile-form-for-climacs (form buffer buffer-mark) + "Compile and evaluate `form', which must be a valid Lisp +form. Two values are returned: The result of evaluating `string' +and a list of compiler notes. `Buffer' and `buffer-mark' will be +used for hyperlinking the compiler notes to the source code." + (compile-string-for-climacs (write-to-string form) *package* buffer buffer-mark)) + +(defun compile-file-for-climacs (filepath package &optional load-p) + "Compile the file at `filepath' in `package'. If `load-p' is +non-NIL, also load the file at `filepath'. Two values will be +returned: the result of compiling the file and a list of compiler +notes." + (let* ((swank::*buffer-package* package) + (swank::*buffer-readtable* *readtable*) + (*compile-verbose* nil) + (result (swank::compile-file-for-emacs filepath load-p)) + (notes (loop for note in (swank::compiler-notes-for-emacs) + collect (make-compiler-note note)))) + (values result notes))) + +(defun find-definitions-for-climacs (symbol) + "Return list of definitions for `symbol'." + (flet ((fully-qualified-symbol-name (symbol) + (let ((*package* (find-package :keyword))) + (format nil "~S" symbol)))) + (let* ((name (fully-qualified-symbol-name symbol)) + (swank::*buffer-package* *package*) + (swank::*buffer-readtable* *readtable*)) + (swank::find-definitions-for-emacs name)))) + +(defun get-class-keyword-parameters (class) + "Get a list of keyword parameters (possibly along with any +default values) that can be used in a `make-instance' form for +`class'." + (loop for arg in (swank::extra-keywords/make-instance 'make-instance class) + if (swank::keyword-arg.default-arg arg) + collect (list (swank::keyword-arg.arg-name arg) + (swank::keyword-arg.default-arg arg)) + else collect (swank::keyword-arg.arg-name arg))) + +(defun arglist (symbol) + "Get plain arglist for symbol." + (swank::arglist symbol)) + +(defun simple-completions (string default-package) + "Return a list of simple symbol-completions for `string' in +`default-package'." + (swank::completions string (package-name default-package))) + +(defun fuzzy-completions (symbol-name default-package &optional limit) + "Return a list of fuzzy completions for `symbol-name'." + (swank::fuzzy-completions symbol-name (package-name default-package) limit)) + +;;; Convenience functions: (defun unlisted (obj) (if (listp obj) @@ -51,9 +124,8 @@ (defun symbol-name-at-mark (mark syntax) "Return the text of the symbol at mark." - (symbol-name (token-to-symbol syntax - (expression-at-mark mark syntax) - :preserve))) + (token-string syntax + (symbol-at-mark mark syntax))) (defun this-form (mark syntax) "Return a form at mark. This function defines which @@ -66,6 +138,15 @@ (or (find-package package-designator) *package*)) +(defmacro with-syntax-package (syntax (package-sym) + &body body) + "Evaluate `body' with `package-sym' bound to a valid package, + preferably taken from `syntax'." + `(let ((,package-sym (usable-package (slot-value ,syntax 'package)))) + , at body)) + +;;; Real code: + (defun macroexpand-token (syntax token &optional (all nil)) (let* ((string (token-string syntax token)) (expression (read-from-string string)) @@ -114,29 +195,26 @@ values))) (esa:display-message result)))) -(defun compile-defun-with-swank (mark pane syntax) - (with-slots (package) syntax - (let* ((string (text-of-definition-at-mark mark syntax)) - (buffer-name (name (buffer pane))) - (buffer-file-name (filepath (buffer pane))) - (m (clone-mark mark)) - ;; swank::compile-string-for-emacs binds *compile-verbose* to t - ;; so we need to do this to avoid scribbles on the pane - (*standard-output* *debug-io*) - (swank::*buffer-package* (or package *package*)) - (swank::*buffer-readtable* *readtable*)) - (end-of-definition m syntax) - (beginning-of-definition m syntax) - (let ((result (swank::compile-string-for-emacs - string buffer-name (offset m) buffer-file-name)) - (notes (loop for note in (swank::compiler-notes-for-emacs) - collect (make-swine-compiler-note note)))) - (show-swine-note-counts notes (second result)) - (when notes - (show-swine-notes notes buffer-name - (one-line-ify (subseq string 0 (max (length string) 20))))))))) +(defun compile-definition-interactively (mark pane syntax) + (with-syntax-package syntax (package) + (let* ((token (definition-at-mark mark syntax)) + (string (token-string syntax token)) + (m (clone-mark mark)) + (buffer-name (name (buffer pane)))) + (end-of-definition m syntax) + (beginning-of-definition m syntax) + (multiple-value-bind (result notes) + (compile-form-for-climacs (token-to-object syntax token + :read t + :package package) + (buffer pane) + m) + (show-note-counts notes (second result)) + (when notes + (show-notes notes buffer-name + (one-line-ify (subseq string 0 (min (length string) 20))))))))) -(defun make-swine-compiler-note (note-list) +(defun make-compiler-note (note-list) (let ((severity (getf note-list :severity)) (message (getf note-list :message)) (location (getf note-list :location)) @@ -144,148 +222,148 @@ (short-message (getf note-list :short-message))) (make-instance (ecase severity - (:error 'swine-error-compiler-note) - (:read-error 'swine-read-error-compiler-note) - (:warning 'swine-warning-compiler-note) - (:style-warning 'swine-style-warning-compiler-note) - (:note 'swine-note-compiler-note)) + (:error 'error-compiler-note) + (:read-error 'read-error-compiler-note) + (:warning 'warning-compiler-note) + (:style-warning 'style-warning-compiler-note) + (:note 'note-compiler-note)) :message message :location location :references references :short-message short-message))) -(defclass swine-compiler-note () +(defclass compiler-note () ((message :initarg :message :initform nil :accessor message) (location :initarg :location :initform nil :accessor location) (references :initarg :references :initform nil :accessor references) (short-message :initarg :short-message :initform nil :accessor short-message)) - (:documentation "The base for all swine-compiler-notes.")) + (:documentation "The base for all compiler-notes.")) -(defclass swine-error-compiler-note (swine-compiler-note) ()) +(defclass error-compiler-note (compiler-note) ()) -(defclass swine-read-error-compiler-note (swine-compiler-note) ()) +(defclass read-error-compiler-note (compiler-note) ()) -(defclass swine-warning-compiler-note (swine-compiler-note) ()) +(defclass warning-compiler-note (compiler-note) ()) -(defclass swine-style-warning-compiler-note (swine-compiler-note) ()) +(defclass style-warning-compiler-note (compiler-note) ()) -(defclass swine-note-compiler-note (swine-compiler-note) ()) +(defclass note-compiler-note (compiler-note) ()) -(defclass swine-location ()() - (:documentation "The base for all swine-locations.")) +(defclass location ()() + (:documentation "The base for all locations.")) -(defclass swine-error-location (swine-location) +(defclass error-location (location) ((error-message :initarg :error-message :accessor error-message))) -(defclass swine-actual-location (swine-location) +(defclass actual-location (location) ((source-position :initarg :position :accessor source-position) (snippet :initarg :snippet :accessor snippet :initform nil)) - (:documentation "The base for all non-error swine-locations.")) + (:documentation "The base for all non-error locations.")) -(defclass swine-buffer-location (swine-actual-location) +(defclass buffer-location (actual-location) ((buffer-name :initarg :buffer :accessor buffer-name))) -(defclass swine-file-location (swine-actual-location) +(defclass file-location (actual-location) ((file-name :initarg :file :accessor file-name))) -(defclass swine-source-location (swine-actual-location) +(defclass source-location (actual-location) ((source-form :initarg :source-form :accessor source-form))) -(defclass swine-position () () - (:documentation "The base for all swine-positions.")) +(defclass basic-position () () + (:documentation "The base for all positions.")) -(defclass swine-char-position (swine-position) +(defclass char-position (basic-position) ((char-position :initarg :position :accessor char-position) (align-p :initarg :align-p :initform nil :accessor align-p))) -(defun make-swine-char-position (position-list) - (make-instance 'swine-char-position :position (second position-list) +(defun make-char-position (position-list) + (make-instance 'char-position :position (second position-list) :align-p (third position-list))) -(defclass swine-line-position (swine-position) +(defclass line-position (basic-position) ((start-line :initarg :line :accessor start-line) (end-line :initarg :end-line :initform nil :accessor end-line))) -(defun make-swine-line-position (position-list) - (make-instance 'swine-line-position :line (second position-list) +(defun make-line-position (position-list) + (make-instance 'line-position :line (second position-list) :end-line (third position-list))) -(defclass swine-function-name-position (swine-position) +(defclass function-name-position (basic-position) ((function-name :initarg :function-name))) -(defun make-swine-function-name-position (position-list) - (make-instance 'swine-function-name-position :function-name (second position-list))) +(defun make-function-name-position (position-list) + (make-instance 'function-name-position :function-name (second position-list))) -(defclass swine-source-path-position (swine-position) +(defclass source-path-position (basic-position) ((path :initarg :source-path :accessor path) (start-position :initarg :start-position :accessor start-position))) -(defun make-swine-source-path-position (position-list) - (make-instance 'swine-source-path-position :source-path (second position-list) +(defun make-source-path-position (position-list) + (make-instance 'source-path-position :source-path (second position-list) :start-position (third position-list))) -(defclass swine-text-anchored-position (swine-position) +(defclass text-anchored-position (basic-position) ((start :initarg :text-anchored :accessor start) (text :initarg :text :accessor text) (delta :initarg :delta :accessor delta))) -(defun make-swine-text-anchored-position (position-list) - (make-instance 'swine-text-anchored-position :text-anchored (second position-list) +(defun make-text-anchored-position (position-list) + (make-instance 'text-anchored-position :text-anchored (second position-list) :text (third position-list) :delta (fourth position-list))) -(defclass swine-method-position (swine-position) +(defclass method-position (basic-position) ((name :initarg :method :accessor name) (specializers :initarg :specializers :accessor specializers) (qualifiers :initarg :qualifiers :accessor qualifiers))) -(defun make-swine-method-position (position-list) - (make-instance 'swine-method-position :method (second position-list) +(defun make-method-position (position-list) + (make-instance 'method-position :method (second position-list) :specializers (third position-list) :qualifiers (last position-list))) -(defun make-swine-location (location-list) +(defun make-location (location-list) (ecase (first location-list) - (:error (make-instance 'swine-error-location :error-message (second location-list))) + (:error (make-instance 'error-location :error-message (second location-list))) (:location (destructuring-bind (l buf pos hints) location-list (declare (ignore l)) (let ((location (apply #'make-instance (ecase (first buf) - (:file 'swine-file-location) - (:buffer 'swine-buffer-location) - (:source-form 'swine-source-location)) + (:file 'file-location) + (:buffer 'buffer-location) + (:source-form 'source-location)) buf)) (position (funcall (ecase (first pos) - (:position #'make-swine-char-position) - (:line #'make-swine-line-position) - (:function-name #'make-swine-function-name-position) - (:source-path #'make-swine-source-path-position) - (:text-anchored #'make-swine-text-anchored-position) - (:method #'make-swine-method-position)) + (:position #'make-char-position) + (:line #'make-line-position) + (:function-name #'make-function-name-position) + (:source-path #'make-source-path-position) + (:text-anchored #'make-text-anchored-position) + (:method #'make-method-position)) pos))) (setf (source-position location) position) (when hints (setf (snippet location) (rest hints))) location))))) -(defmethod initialize-instance :after ((note swine-compiler-note) &rest args) +(defmethod initialize-instance :after ((note compiler-note) &rest args) (declare (ignore args)) - (setf (location note) (make-swine-location (location note)))) + (setf (location note) (make-location (location note)))) -(defun show-swine-note-counts (notes &optional seconds) +(defun show-note-counts (notes &optional seconds) (loop with nerrors = 0 with nwarnings = 0 with nstyle-warnings = 0 with nnotes = 0 for note in notes do (etypecase note - (swine-error-compiler-note (incf nerrors)) - (swine-read-error-compiler-note (incf nerrors)) - (swine-warning-compiler-note (incf nwarnings)) - (swine-style-warning-compiler-note (incf nstyle-warnings)) - (swine-note-compiler-note (incf nnotes))) + (error-compiler-note (incf nerrors)) + (read-error-compiler-note (incf nerrors)) + (warning-compiler-note (incf nwarnings)) + (style-warning-compiler-note (incf nstyle-warnings)) + (note-compiler-note (incf nnotes))) finally (climacs-gui::display-message "Compilation finished: ~D error~:P ~ ~D warning~:P ~D style-warning~:P ~D note~:P ~ @@ -325,17 +403,17 @@ `(defmethod print-for-menu ((object ,class) stream) (print-note-for-menu object stream ,name ,colour))) -(def-print-for-menu swine-error-compiler-note "Error" +red+) -(def-print-for-menu swine-read-error-compiler-note "Read Error" +red+) -(def-print-for-menu swine-warning-compiler-note "Warning" +dark-red+) -(def-print-for-menu swine-style-warning-compiler-note "Style Warning" +brown+) -(def-print-for-menu swine-note-compiler-note "Note" +brown+) +(def-print-for-menu error-compiler-note "Error" +red+) +(def-print-for-menu read-error-compiler-note "Read Error" +red+) +(def-print-for-menu warning-compiler-note "Warning" +dark-red+) +(def-print-for-menu style-warning-compiler-note "Style Warning" +brown+) +(def-print-for-menu note-compiler-note "Note" +brown+) -(defun show-swine-notes (notes buffer-name definition) +(defun show-notes (notes buffer-name definition) (let ((stream (climacs-gui::typeout-window (format nil "~10TCompiler Notes: ~A ~A" buffer-name definition)))) (loop for note in notes - do (with-output-as-presentation (stream note 'swine-compiler-note) + do (with-output-as-presentation (stream note 'compiler-note) (print-for-menu note stream)) (terpri stream) count note into length @@ -343,23 +421,23 @@ :height (* length (stream-line-height stream))) (scroll-extent stream 0 0)))) -(defgeneric goto-swine-location (swine-location)) +(defgeneric goto-location (location)) [284 lines skipped] --- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/30 20:38:58 1.18 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/05/31 18:01:04 1.19 @@ -32,10 +32,11 @@ (mark (point (current-window))) (token (form-before syntax (offset mark)))) (if token - (let ((*package* (slot-value syntax 'package))) - (climacs-gui::com-eval-expression - (read-from-string (token-string syntax token)) - insertp)) + (with-syntax-package syntax (package) + (let ((*package* package)) + (climacs-gui::com-eval-expression + (read-from-string (token-string syntax token)) + insertp))) (esa:display-message "Nothing to evaluate.")))) (esa:set-key `(com-eval-last-expression ,esa:*numeric-argument-p*) @@ -91,9 +92,9 @@ (define-command (com-compile-definition :name t :command-table lisp-table) () "Compile and load definition at point." - (compile-defun-with-swank (point (current-window)) - (current-window) - (syntax (buffer (current-window))))) + (compile-definition-interactively (point (current-window)) + (current-window) + (syntax (buffer (current-window))))) (esa:set-key 'com-compile-definition 'lisp-table @@ -104,7 +105,7 @@ "Compile and load the current file. Compiler notes will be displayed in a seperate buffer." - (compile-file-with-swank (buffer (current-window)) t)) + (compile-file-interactively (buffer (current-window)) t)) (esa:set-key 'com-compile-and-load-file 'lisp-table @@ -115,33 +116,33 @@ "Compile the file open in the current buffer. This command does not load the file after it has been compiled." - (compile-file-with-swank (buffer (current-window)) nil)) + (compile-file-interactively (buffer (current-window)) nil)) (esa:set-key 'com-compile-file 'lisp-table '((#\c :control) (#\k :meta))) (define-command (com-goto-location :name t :command-table lisp-table) - ((note 'swine-compiler-note)) + ((note 'compiler-note)) "Move point to the part of a given file that caused the compiler note. If the file is not already open, a new buffer will be opened with that file." - (goto-swine-location (location note))) + (goto-location (location note))) -(define-presentation-to-command-translator swine-compiler-note-to-goto-location-translator - (swine-compiler-note com-goto-location lisp-table) - (presentation) - (list (presentation-object presentation))) +(define-presentation-to-command-translator compiler-note-to-goto-location-translator + (compiler-note com-goto-location lisp-table) + (presentation) + (list (presentation-object presentation))) (define-command (com-goto-xref :name t :command-table lisp-table) - ((xref 'swine-xref)) + ((xref 'xref)) "Go to the referenced location of a code cross-reference." - (goto-swine-location xref)) + (goto-location xref)) -(define-presentation-to-command-translator swine-xref-to-goto-location-translator - (swine-xref com-goto-xref lisp-table) +(define-presentation-to-command-translator xref-to-goto-location-translator + (xref com-goto-xref lisp-table) (presentation) (list (presentation-object presentation))) @@ -207,7 +208,7 @@ 'lisp-table '((#\c :control) (#\d :control) (#\a))) -(define-command (com-swine-space :command-table lisp-table) +(define-command (com-space :command-table lisp-table) () "Insert a space and display argument hints in the minibuffer." (let* ((window (current-window)) @@ -228,28 +229,11 @@ (forward-object mark) (clear-completions))) -(esa:set-key 'com-swine-space +(esa:set-key 'com-space 'lisp-table '((#\Space))) -(define-command (com-swine-simple-completion :name t :command-table lisp-table) - () - "Attempt a simple symbol-completion for the symbol at mark. - -If more than one completion is available, a list of possible -completions will be displayed." - (let* ((point-current-window (point (current-window))) - (name (symbol-name-at-mark point-current-window - (syntax (buffer (current-window)))))) - (when name - (let* ((completion (show-simple-completions name)) - (difference (let ((mismatch (mismatch name completion))) - (if mismatch - (subseq completion mismatch) - "")))) - (insert-sequence point-current-window difference))))) - -(define-command (com-swine-completion :name t :command-table lisp-table) () +(define-command (com-complete-symbol :name t :command-table lisp-table) () "Attempt to complete the symbol at mark. If more than one completion is available, a list of possible @@ -260,12 +244,12 @@ (when name (let ((completion (show-completions name)) (mark (clone-mark point-current-window))) - (unless (= (length completion) 0) + (unless (= (length completion) 0) (backward-object mark (length name)) (delete-region mark point-current-window) (insert-sequence point-current-window completion)))))) -(define-command (com-swine-fuzzy-completion :name t :command-table lisp-table) () +(define-command (com-fuzzily-complete-symbol :name t :command-table lisp-table) () "Attempt to fuzzily complete the abbreviation at mark. Fuzzy completion tries to guess which symbol is abbreviated. If @@ -282,12 +266,11 @@ (delete-region mark point-current-window) (insert-sequence point-current-window completion)))))) -(esa:set-key 'com-swine-completion +(esa:set-key 'com-complete-symbol 'lisp-table '((#\Tab :meta))) - -(esa:set-key 'com-swine-fuzzy-completion +(esa:set-key 'com-fuzzily-complete-symbol 'lisp-table '((#\c :control) (#\i :meta)))