[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