[climacs-cvs] CVS update: climacs/base.lisp climacs/gui.lisp climacs/packages.lisp climacs/pane.lisp

Matthieu Villeneuve mvilleneuve at common-lisp.net
Wed Jan 19 20:04:41 UTC 2005


Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv12217

Modified Files:
	base.lisp gui.lisp packages.lisp pane.lisp 
Log Message:
Added auto-fill mode
Date: Wed Jan 19 12:04:39 2005
Author: mvilleneuve

Index: climacs/base.lisp
diff -u climacs/base.lisp:1.21 climacs/base.lisp:1.22
--- climacs/base.lisp:1.21	Tue Jan 18 10:59:51 2005
+++ climacs/base.lisp	Wed Jan 19 12:04:39 2005
@@ -114,7 +114,7 @@
 	count (eql (buffer-object buffer offset1) #\Newline)
 	do (incf offset1)))
 
-(defun buffer-display-column-number (buffer offset tab-width)
+(defun buffer-display-column (buffer offset tab-width)
   (let ((line-start-offset (- offset (buffer-column-number buffer offset))))
     (loop with column = 0
           for i from line-start-offset below offset
@@ -308,7 +308,7 @@
                  finally (return t))))
     (loop for offset = offset1 then (1+ offset)
           until (>= offset offset2)
-          do (let* ((column (buffer-display-column-number
+          do (let* ((column (buffer-display-column
                              buffer offset tab-width))
                     (count (- tab-width (mod column tab-width))))
                (when (looking-at-spaces buffer offset count)
@@ -336,8 +336,9 @@
   (loop for offset = offset1 then (1+ offset)
         until (>= offset offset2)
         when (char= (buffer-object buffer offset) #\Tab)
-        do (let* ((column (buffer-display-column-number
-                           buffer offset tab-width))
+        do (let* ((column (buffer-display-column buffer
+                                                 offset
+                                                 tab-width))
                   (count (- tab-width (mod column tab-width))))
              (delete-buffer-range buffer offset 1)
              (loop repeat count
@@ -391,6 +392,37 @@
           while (whitespacep (object-before mark))
           do (delete-range mark -1))
     (insert-object mark #\Space)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 
+;;; Auto fill
+
+(defun fill-line (mark syntax-line-indentation-function fill-column tab-width)
+  (let ((begin-mark (clone-mark mark)))
+    (beginning-of-line begin-mark)
+    (loop with column = 0
+          with walking-mark = (clone-mark begin-mark)
+          while (mark< walking-mark mark)
+          as object = (object-after walking-mark)
+          do (case object
+               (#\Space
+                (setf (offset begin-mark) (offset walking-mark))
+                (incf column))
+               (#\Tab
+                (setf (offset begin-mark) (offset walking-mark))
+                (incf column (- tab-width (mod column tab-width))))
+               (t
+                (incf column)))
+             (when (>= column fill-column)
+               (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 (offset walking-mark) (offset begin-mark))
+               (setf column 0))
+             (incf (offset walking-mark)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 


Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.85 climacs/gui.lisp:1.86
--- climacs/gui.lisp:1.85	Wed Jan 19 06:38:47 2005
+++ climacs/gui.lisp	Wed Jan 19 12:04:39 2005
@@ -109,13 +109,16 @@
   (declare (ignore frame))
   (with-slots (climacs-pane) pane
      (let* ((buf (buffer climacs-pane))
-	    (name-info (format nil "   ~a   ~a   Syntax: ~a ~a    ~a"
+	    (name-info (format nil "   ~a   ~a   Syntax: ~a~a~a    ~a"
 			       (if (needs-saving buf) "**" "--")
 			       (name buf)
 			       (name (syntax buf))
 			       (if (slot-value climacs-pane 'overwrite-mode)
-				   "Ovwrt"
+				   " Ovwrt"
 				   "")
+                               (if (auto-fill-mode buf)
+                                   " Fill"
+                                   "")
 			       (if (recordingp *application-frame*)
 				   "Def"
 				   ""))))
@@ -285,16 +288,37 @@
     (setf (slot-value win 'overwrite-mode)
 	  (not (slot-value win 'overwrite-mode)))))
 
-(define-command com-self-insert ()
+(defun insert-character (char)
   (let* ((win (current-window))
 	 (point (point win)))
-    (unless (constituentp *current-gesture*)
+    (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 *current-gesture*))
-	(insert-object point *current-gesture*))))
+	  (insert-object point char))
+	(insert-object point char))))
+
+(define-command com-self-insert ()
+  (insert-character *current-gesture*))
+
+(define-command com-self-filling-insert ()
+  (let* ((pane (current-window))
+         (buffer (buffer pane)))
+    (when (auto-fill-mode buffer)
+      (let* ((fill-column (auto-fill-column buffer))
+             (point (point pane))
+             (offset (offset point))
+             (tab-width (tab-space-count (stream-default-view pane)))
+             (syntax (syntax buffer)))
+        (when (>= (buffer-display-column buffer offset tab-width)
+                  (1- (auto-fill-column buffer)))
+          (fill-line point
+                     (lambda (mark)
+                       (syntax-line-indentation mark tab-width syntax))
+                     fill-column
+                     tab-width)))))
+  (insert-character *current-gesture*))
 
 (define-named-command com-beginning-of-line ()
   (beginning-of-line (point (current-window))))
@@ -475,6 +499,10 @@
 (define-named-command com-delete-indentation ()
   (delete-indentation (point (current-window))))
 
+(define-named-command com-auto-fill-mode ()
+  (let ((buffer (buffer (current-window))))
+    (setf (auto-fill-mode buffer) (not (auto-fill-mode buffer)))))
+
 (define-command com-extended-command ()
   (let ((item (accept 'command :prompt "Extended Command")))
     (execute-frame-command *application-frame* item)))
@@ -938,11 +966,12 @@
 	 (find :meta gesture))
     (dead-escape-set-key (remove :meta gesture)  command)))
 
-(loop for code from (char-code #\space) to (char-code #\~)
+(loop for code from (char-code #\!) to (char-code #\~)
       do (global-set-key (code-char code) 'com-self-insert))
 
-(global-set-key #\newline 'com-self-insert)
-(global-set-key #\tab 'com-indent-line)
+(global-set-key #\Space 'com-self-filling-insert)
+(global-set-key #\Newline 'com-self-filling-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*))
 (global-set-key '(#\b :control) `(com-backward-object ,*numeric-argument-marker*))


Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.35 climacs/packages.lisp:1.36
--- climacs/packages.lisp:1.35	Mon Jan 17 15:10:24 2005
+++ climacs/packages.lisp	Wed Jan 19 12:04:39 2005
@@ -51,6 +51,7 @@
 	   #:open-line #:kill-line
            #:empty-line-p
            #:line-indentation
+           #:buffer-display-column
 	   #:number-of-lines-in-region
 	   #:constituentp #:whitespacep
 	   #:forward-word #:backward-word
@@ -60,6 +61,7 @@
            #:tabify-region #:untabify-region
            #:indent-line
            #:delete-indentation
+           #:fill-line
 	   #:input-from-stream #:output-to-stream
 	   #:name-mixin #:name
 	   #:buffer-lookin-at #:looking-at
@@ -95,6 +97,7 @@
 	   #:page-down #:page-up
            #:tab-space-count
            #:indent-tabs-mode
+           #:auto-fill-mode #:auto-fill-column
 	   #:url))
 
 (defpackage :climacs-gui


Index: climacs/pane.lisp
diff -u climacs/pane.lisp:1.6 climacs/pane.lisp:1.7
--- climacs/pane.lisp:1.6	Tue Jan 18 21:21:16 2005
+++ climacs/pane.lisp	Wed Jan 19 12:04:39 2005
@@ -58,7 +58,9 @@
   ((needs-saving :initform nil :accessor needs-saving)
    (syntax :initarg :syntax :initform (make-instance 'basic-syntax) :accessor syntax)
    (indent-tabs-mode :initarg indent-tabs-mode :initform t
-                     :accessor indent-tabs-mode))
+                     :accessor indent-tabs-mode)
+   (auto-fill-mode :initform t :accessor auto-fill-mode)
+   (auto-fill-column :initform 70 :accessor auto-fill-column))
   (:default-initargs :name "*scratch*"))
 
 




More information about the Climacs-cvs mailing list