Update of /project/clim-desktop/cvsroot/clim-desktop In directory clnet:/tmp/cvs-serv20774

Modified Files: swine.lisp swine-cmds.lisp Log Message: Updated Swine to use the new package selection code in Climacs.

--- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/03 18:14:42 1.23 +++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/06/04 22:25:15 1.24 @@ -143,13 +143,6 @@ (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)))) - ,@body)) - (defmacro evaluating-interactively (&body body) `(handler-case (progn ,@body) (end-of-file () @@ -158,7 +151,7 @@ ;;; Real code:

(defun macroexpand-token (syntax token &optional (all nil)) - (with-syntax-package syntax (package) + (with-syntax-package syntax (start-offset token) (package) (let ((*package* package)) (let* ((string (token-string syntax token)) (expression (read-from-string string)) @@ -204,7 +197,7 @@ (esa:display-message result))))

(defun compile-definition-interactively (mark pane syntax) - (with-syntax-package syntax (package) + (with-syntax-package syntax mark (package) (let* ((token (definition-at-mark mark syntax)) (string (token-string syntax token)) (m (clone-mark mark)) @@ -471,7 +464,7 @@ (when (and (needs-saving buffer) (accept 'boolean :prompt (format nil "Save buffer ~A ?" (name buffer)))) (climacs-gui::save-buffer buffer)) - (with-syntax-package (syntax buffer) (package) + (with-syntax-package (syntax buffer) 0 (package) (multiple-value-bind (result notes) (compile-file-for-climacs (filepath buffer) package load-p) (show-note-counts notes (second result)) @@ -1130,40 +1123,38 @@ (climacs-gui::delete-window *completion-pane*) (setf *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* ((result (funcall fn symbol (package-name (usable-package package)))) - (set (first result)) - (longest (second result))) - (cond ((<= (length set) 1) - (clear-completions)) - (t (let ((stream (or *completion-pane* - (climacs-gui::typeout-window "Simple Completions")))) - (setf *completion-pane* stream) - (window-clear stream) - (format stream "~{~A~%~}" set)))) +(defun show-completions-by-fn (fn symbol package) + (climacs-gui::display-message (format nil "~a completions" symbol)) + (let* ((result (funcall fn symbol (package-name package))) + (set (first result)) + (longest (second result))) + (cond ((<= (length set) 1) + (clear-completions)) + (t (let ((stream (or *completion-pane* + (climacs-gui::typeout-window "Simple Completions")))) + (setf *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 #'simple-completions symbol)) +(defun show-completions (symbol-name package) + (show-completions-by-fn #'simple-completions symbol-name package))

-(defun show-fuzzy-completions (symbol) - (with-syntax-package (syntax (buffer (climacs-gui::current-window))) (package) - (climacs-gui::display-message (format nil "~a completions" symbol)) - (let* ((set (fuzzy-completions symbol package 10)) - (best (caar set))) - (cond ((<= (length set) 1) - (clear-completions)) - (t (let ((stream (or *completion-pane* - (climacs-gui::typeout-window "Simple Completions")))) - (setf *completion-pane* stream) - (window-clear stream) - (loop for completed-string in set - do (format stream "~{~A ~}~%" completed-string))))) +(defun show-fuzzy-completions (symbol-name package) + (climacs-gui::display-message (format nil "~a completions" symbol-name)) + (let* ((set (fuzzy-completions symbol-name package 10)) + (best (caar set))) + (cond ((<= (length set) 1) + (clear-completions)) + (t (let ((stream (or *completion-pane* + (climacs-gui::typeout-window "Simple Completions")))) + (setf *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))

--- /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/06/03 18:14:42 1.21 +++ /project/clim-desktop/cvsroot/clim-desktop/swine-cmds.lisp 2006/06/04 22:25:15 1.22 @@ -32,7 +32,7 @@ (mark (point (current-window))) (token (form-before syntax (offset mark)))) (if token - (with-syntax-package syntax (package) + (with-syntax-package syntax mark (package) (let ((*package* package)) (climacs-gui::com-eval-expression (read-from-string (token-string syntax token)) @@ -238,16 +238,20 @@

If more than one completion is available, a list of possible completions will be displayed." - (let* ((point-current-window (point (current-window))) + (let* ((pane (current-window)) + (buffer (buffer pane)) + (syntax (syntax buffer)) + (point-current-window (point pane)) (name (symbol-name-at-mark point-current-window - (syntax (buffer (current-window)))))) + syntax))) (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)))))) + (with-syntax-package syntax point-current-window (package) + (let ((completion (show-completions name package)) + (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-fuzzily-complete-symbol :name t :command-table lisp-table) () "Attempt to fuzzily complete the abbreviation at mark. @@ -255,16 +259,20 @@ 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))) + (let* ((pane (current-window)) + (buffer (buffer pane)) + (syntax (syntax buffer)) + (point-current-window (point pane)) (name (symbol-name-at-mark point-current-window - (syntax (buffer (current-window)))))) + syntax))) (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)))))) + (with-syntax-package syntax point-current-window (package) + (let ((completion (show-fuzzy-completions name package)) + (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-complete-symbol 'lisp-table