[climacs-cvs] CVS update: climacs/base.lisp climacs/gui.lisp - climacs-cvs@common-lisp.net - mailman3.common-lisp.net

20 Jan 2005

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv19202
Modified Files:
    base.lisp gui.lisp 
Log Message:
Fixed bug in fill-line with words longer than fill-column
Date: Thu Jan 20 11:12:49 2005
Author: mvilleneuve
Index: climacs/base.lisp
diff -u climacs/base.lisp:1.22 climacs/base.lisp:1.23

--- climacs/base.lisp:1.22	Wed Jan 19 12:04:39 2005
+++ climacs/base.lisp	Thu Jan 20 11:12:48 2005
@@ -401,6 +401,7 @@
   (let ((begin-mark (clone-mark mark)))
     (beginning-of-line begin-mark)
     (loop with column = 0
+          with line-beginning-offset = (offset begin-mark)
           with walking-mark = (clone-mark begin-mark)
           while (mark< walking-mark mark)
           as object = (object-after walking-mark)
@@ -413,13 +414,15 @@
                 (incf column (- tab-width (mod column tab-width))))
                (t
                 (incf column)))
-             (when (>= column fill-column)
+             (when (and (>= column fill-column)
+                        (/= (offset begin-mark) line-beginning-offset))
                (insert-object begin-mark #\Newline)
                (incf (offset begin-mark))
                (let ((indentation
                       (funcall syntax-line-indentation-function begin-mark)))
                  (indent-line begin-mark indentation tab-width))
                (beginning-of-line begin-mark)
+               (setf line-beginning-offset (offset begin-mark))
                (setf (offset walking-mark) (offset begin-mark))
                (setf column 0))
              (incf (offset walking-mark)))))
Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.88 climacs/gui.lisp:1.89
--- climacs/gui.lisp:1.88	Wed Jan 19 22:01:56 2005
+++ climacs/gui.lisp	Thu Jan 20 11:12:48 2005
@@ -289,21 +289,7 @@
   (with-slots (overwrite-mode) (current-window)
     (setf overwrite-mode (not overwrite-mode))))
-(defun insert-character (char)
-  (let* ((win (current-window))
-	 (point (point win)))
-    (unless (constituentp char)
-      (possibly-expand-abbrev point))
-    (if (and (slot-value win 'overwrite-mode) (not (end-of-line-p point)))
-	(progn
-	  (delete-range point)
-	  (insert-object point char))
-	(insert-object point char))))
-
-(define-command com-self-insert ()
-  (insert-character *current-gesture*))
-
-(define-command com-self-filling-insert ()
+(defun possibly-fill-line ()
   (let* ((pane (current-window))
          (buffer (buffer pane)))
     (when (auto-fill-mode buffer)
@@ -318,7 +304,22 @@
                      (lambda (mark)
                        (syntax-line-indentation mark tab-width syntax))
                      fill-column
-                     tab-width)))))
+                     tab-width))))))
+
+(defun insert-character (char)
+  (let* ((win (current-window))
+	 (point (point win)))
+    (unless (constituentp char)
+      (possibly-expand-abbrev point))
+    (when (whitespacep char)
+      (possibly-fill-line))
+    (if (and (slot-value win 'overwrite-mode) (not (end-of-line-p point)))
+	(progn
+	  (delete-range point)
+	  (insert-object point char))
+	(insert-object point char))))
+
+(define-command com-self-insert ()
   (insert-character *current-gesture*))
(define-named-command com-beginning-of-line ()
@@ -967,11 +968,10 @@
     (find :meta gesture))
     (dead-escape-set-key (remove :meta gesture)  command)))
-(loop for code from (char-code #!) to (char-code #~)
+(loop for code from (char-code #\Space) to (char-code #~)
       do (global-set-key (code-char code) 'com-self-insert))
-(global-set-key #\Space 'com-self-filling-insert)
-(global-set-key #\Newline 'com-self-filling-insert)
+(global-set-key #\Newline 'com-self-insert)
 (global-set-key #\Tab 'com-indent-line)
 (global-set-key '(#\j :control) 'com-newline-and-indent)
 (global-set-key '(#\f :control) `(com-forward-object ,*numeric-argument-marker*))

    