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)))