[climacs-cvs] CVS climacs - climacs-cvs@common-lisp.net - mailman3.common-lisp.net

21 Jul 2006

Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv11851
Modified Files:
    lisp-syntax.lisp lisp-syntax-commands.lisp 
Log Message:
Fixed issue where the symbol-completer was a bit too eager in deleting
the original partial symbol.

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

    