Update of /project/clim-desktop/cvsroot/clim-desktop
In directory common-lisp:/tmp/cvs-serv9265
Modified Files:
swine-cmds.lisp
Log Message:
Merged Troels' patch. Of course, the patch didn't like my local changes, so
I had to merge it by hand. If anything super-breaks, it was me.
--- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/01/06 03:15:45 1.1.1.1
+++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/02/15 05:12:22 1.2
@@ -23,112 +23,111 @@
;;; of some of the editor-centric functionality of slime
;;; using calls to swank functions.
-(in-package :climacs-gui)
+(in-package :climacs-lisp-syntax)
(define-command (com-eval-last-expression :name t :command-table lisp-table) ()
- (climacs-lisp-syntax::eval-last-expression-with-swank (point (current-window))
- (syntax (buffer (current-window)))))
+ (eval-last-expression-with-swank (point (current-window))
+ (syntax (buffer (current-window)))))
-(set-key 'com-eval-last-expression
- 'lisp-table
- '((#\c :control) (#\e :control)))
+(esa:set-key 'com-eval-last-expression
+ 'lisp-table
+ '((#\c :control) (#\e :control)))
(define-command (com-macroexpand-1 :name t :command-table lisp-table) ()
- (climacs-lisp-syntax::macroexpand-with-swank (point (current-window))
- (syntax (buffer (current-window)))))
+ (macroexpand-with-swank (point (current-window))
+ (syntax (buffer (current-window)))))
-(set-key 'com-macroexpand-1
- 'lisp-table
- '((#\c :control) (#\Newline)))
+(esa:set-key 'com-macroexpand-1
+ 'lisp-table
+ '((#\c :control) (#\Newline)))
(set-key 'com-macroexpand-1
- 'lisp-table
- '((#\c :control) (#\m :control)))
+ 'lisp-table
+ '((#\c :control) (#\m :control)))
(define-command (com-macroexpand-all :name t :command-table lisp-table) ()
- (climacs-lisp-syntax::macroexpand-with-swank (point (current-window))
- (syntax (buffer (current-window)))
- t))
-
-(set-key 'com-macroexpand-all
- 'lisp-table
- '((#\c :control) (#\m :meta)))
+ (macroexpand-with-swank (point (current-window))
+ (syntax (buffer (current-window)))))
+
+(esa:set-key 'com-macroexpand-all
+ 'lisp-table
+ '((#\c :control) (#\m :meta)))
(define-command (com-eval-region :name t :command-table lisp-table) ()
- (climacs-lisp-syntax::eval-region-with-swank (point (current-window))
- (mark (current-window))
- (syntax (buffer (current-window)))))
-
-(set-key 'com-eval-region
- 'lisp-table
- '((#\c :control) (#\r :control)))
+ (eval-region-with-swank (point (current-window))
+ (mark (current-window))
+ (syntax (buffer (current-window)))))
+
+(esa:set-key 'com-eval-region
+ 'lisp-table
+ '((#\c :control) (#\r :control)))
(define-command (com-compile-definition :name t :command-table lisp-table) ()
- (climacs-lisp-syntax::compile-defun-with-swank (point (current-window))
- (current-window)
- (syntax (buffer (current-window)))))
-
-(set-key 'com-compile-definition
- 'lisp-table
- '((#\c :control) (#\c :control)))
+ (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) ()
- (climacs-lisp-syntax::compile-file-with-swank (buffer (current-window)) t))
+ (compile-file-with-swank (buffer (current-window)) t))
-(set-key 'com-compile-and-load-file
- 'lisp-table
- '((#\c :control) (#\k :control)))
+(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) ()
- (climacs-lisp-syntax::compile-file-with-swank (buffer (current-window)) nil))
+ (compile-file-with-swank (buffer (current-window)) nil))
-(set-key 'com-compile-file
- 'lisp-table
- '((#\c :control) (#\k :meta)))
+(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))
- (climacs-lisp-syntax::goto-swine-location (climacs-lisp-syntax::location note)))
+ (goto-swine-location (location note)))
(define-presentation-to-command-translator swine-compiler-note-to-goto-location-translator
- (climacs-lisp-syntax::swine-compiler-note com-goto-location lisp-table)
+ (swine-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))
- (climacs-lisp-syntax::goto-swine-location xref))
+ (goto-swine-location xref))
(define-presentation-to-command-translator swine-xref-to-goto-location-translator
- (climacs-lisp-syntax::swine-xref com-goto-xref lisp-table)
- (presentation)
- (list (presentation-object presentation)))
+ (swine-xref com-goto-xref lisp-table)
+ (presentation)
+ (list (presentation-object presentation)))
(define-command (com-edit-definition :name t :command-table lisp-table) ()
- (let ((name (or (climacs-lisp-syntax::symbol-name-at-mark (point (current-window))
- (syntax (buffer (current-window))))
- (accept 'symbol :prompt "Edit symbol"))))
- (climacs-lisp-syntax::edit-definition name (syntax (buffer (current-window))))))
-
-(set-key 'com-edit-definition
- 'lisp-table
- '((#\. :meta)))
+ (let ((name (or (symbol-name-at-mark (point (current-window))
+ (syntax (buffer (current-window))))
+ (accept 'symbol :prompt "Edit symbol"))))
+ (edit-definition name (syntax (buffer (current-window))))))
+
+(esa:set-key 'com-edit-definition
+ 'lisp-table
+ '((#\. :meta)))
(define-command (com-return-from-definition :name t :command-table lisp-table) ()
- (climacs-lisp-syntax::pop-find-definition-stack))
+ (pop-find-definition-stack))
-(set-key 'com-return-from-definition
- 'lisp-table
- '((#\, :meta)))
+(esa:set-key 'com-return-from-definition
+ 'lisp-table
+ '((#\, :meta)))
(define-command (com-hyperspec-lookup :name t :command-table lisp-table) ()
- (let* ((name (or (climacs-lisp-syntax::symbol-name-at-mark (point (current-window))
- (syntax (buffer (current-window))))
- (accept 'string :prompt "Hyperspec lookup for symbol")))
- (*standard-output* *debug-io*)
- (url (clhs-lookup:spec-lookup name)))
- (if (null url) (display-message "Symbol not found.")
- (closure:visit url))))
+ (let* ((name (or (symbol-name-at-mark (point (current-window))
+ (syntax (buffer (current-window))))
+ (accept 'string :prompt "Hyperspec lookup for symbol")))
+ (*standard-output* *debug-io*)
+ (url (clhs-lookup:spec-lookup name)))
+ (if (null url) (display-message "Symbol not found.")
+ (closure:visit url))))
-(set-key 'com-hyperspec-lookup
+(esa:set-key 'com-hyperspec-lookup
'lisp-table
'((#\c :control) (#\d :control) (#\h)))
@@ -136,91 +135,106 @@
(defun show-arglist-silent (symbol)
(if (fboundp symbol)
(let ((arglist (swank::arglist symbol)))
- (display-message (format nil "(~A~{ ~A~})" symbol arglist))
+ (esa:display-message (format nil "(~A~{ ~A~})" symbol arglist))
t)
nil))
(defun show-arglist (symbol name)
(unless (show-arglist-silent symbol)
- (display-message "Function ~a not found." name)))
+ (esa:display-message "Function ~a not found." name)))
(define-command (com-arglist-lookup :name t :command-table lisp-table) ()
- (let* ((name (string-upcase (or (climacs-lisp-syntax::symbol-name-at-mark (point (current-window))
- (syntax (buffer (current-window))))
- (accept 'string :prompt "Arglist lookup for 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))))))
+ (let* ((name (string-upcase (or (symbol-name-at-mark (point (current-window))
+ (syntax (buffer (current-window))))
+ (accept 'string :prompt "Arglist lookup for 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))))))
+
+(esa:set-key 'com-arglist-lookup
+ 'lisp-table
+ '((#\c :control) (#\d :control) (#\a)))
+
-(set-key 'com-arglist-lookup
- 'lisp-table
- '((#\c :control) (#\d :control) (#\a)))
(define-command (com-swine-space :name t :command-table lisp-table)
- ()
- (let* ((name (string-upcase (or (climacs-lisp-syntax::enclosing-list-first-word (point (current-window))
- (syntax (buffer (current-window))))
- (climacs-lisp-syntax::symbol-name-at-mark (point (current-window))
- (syntax (buffer (current-window))))))))
-
- (when name
- (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-silent function-symbol))))
- (insert-character #\Space)
- (climacs-lisp-syntax::clear-completions)))
-
-(set-key 'com-swine-space
- 'lisp-table
- '((#\Space)))
+ ()
+ (let ((mark (point (current-window))))
+ ;; It is important that the space is inserted before we look up
+ ;; any symbols, but at the same time, there must not be a space
+ ;; between the mark and the symbol.
+ (insert-character #\Space)
+ (backward-object mark)
+ (let* ((name (string-upcase (or (enclosing-list-first-word
+ mark
+ (syntax (buffer (current-window))))
+ (symbol-name-at-mark
+ mark
+ (syntax (buffer (current-window))))))))
+ (when name
+ (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) ))
+ (handler-case (if pos2 (find-symbol (subseq name (1+ pos2)) (subseq name 0 pos1))
+ (find-symbol name (or package *package*)))
+ (package-error (e)
+ ;; The specified symbol is in
+ ;; an invalid package.
+ (declare (ignore e))
+ nil)))))
+ (show-arglist-silent function-symbol))))
+ (forward-object mark)
+ (clear-completions))))
+
+(esa:set-key 'com-swine-space
+ 'lisp-table
+ '((#\Space)))
(define-command (com-swine-simple-completion :name t :command-table lisp-table) ()
- (let* ((point-current-window (point (current-window)))
- (name (climacs-lisp-syntax::symbol-name-at-mark point-current-window
- (syntax (buffer (current-window))))))
- (when name
- (let* ((completion (climacs-lisp-syntax::show-simple-completions name))
- (difference (let ((mismatch (mismatch name completion)))
- (if mismatch
- (subseq completion mismatch)
- ""))))
- (insert-sequence point-current-window difference)))))
+ (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) ()
- (let* ((point-current-window (point (current-window)))
- (name (climacs-lisp-syntax::symbol-name-at-mark point-current-window
- (syntax (buffer (current-window))))))
- (when name
- (let ((completion (climacs-lisp-syntax::show-completions name))
- (mark (clone-mark point-current-window)))
- (unless (= (length completion) 0)
- (backward-object mark (length name))
- (delete-region mark point-current-window)
- (insert-sequence point-current-window completion))))))
+ (let* ((point-current-window (point (current-window)))
+ (name (symbol-name-at-mark point-current-window
+ (syntax (buffer (current-window))))))
+ (when name
+ (let ((completion (show-completions name))
+ (mark (clone-mark point-current-window)))
+ (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) ()
- (let* ((point-current-window (point (current-window)))
- (name (climacs-lisp-syntax::symbol-name-at-mark point-current-window
- (syntax (buffer (current-window))))))
- (when name
- (let ((completion (climacs-lisp-syntax::show-fuzzy-completions name))
- (mark (clone-mark point-current-window)))
- (unless (= (length completion) 0)
- (backward-object mark (length name))
- (delete-region mark point-current-window)
- (insert-sequence point-current-window completion))))))
-
-(set-key 'com-swine-completion
- 'lisp-table
- '((#\Tab :meta)))
-
-(set-key 'com-swine-fuzzy-completion
- 'lisp-table
- '((#\c :control) (#\i :meta)))
+ (let* ((point-current-window (point (current-window)))
+ (name (symbol-name-at-mark point-current-window
+ (syntax (buffer (current-window))))))
+ (when name
+ (let ((completion (show-fuzzy-completions name))
+ (mark (clone-mark point-current-window)))
+ (unless (= (length completion) 0)
+ (backward-object mark (length name))
+ (delete-region mark point-current-window)
+ (insert-sequence point-current-window completion))))))
+
+(esa:set-key 'com-swine-completion
+ 'lisp-table
+ '((#\Tab :meta)))
+
+
+(esa:set-key 'com-swine-fuzzy-completion
+ 'lisp-table
+ '((#\c :control) (#\i :meta)))
