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*"))