Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv9456

Modified Files: packages.lisp lisp-syntax-commands.lisp base.lisp Log Message: Added `fill-region' function and used it to implement filling of strings in the Lisp syntax. I have not implemented a Fill Region command because it seemed to fit poorly within the way filling works in Climacs.

--- /project/climacs/cvsroot/climacs/packages.lisp 2006/05/28 15:58:24 1.97 +++ /project/climacs/cvsroot/climacs/packages.lisp 2006/06/05 21:01:51 1.98 @@ -77,7 +77,7 @@ #:indent-line #:indent-region #:delete-indentation - #:fill-line + #:fill-line #:fill-region #:input-from-stream #:output-to-stream #:name-mixin #:name #:buffer-looking-at #:looking-at --- /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp 2006/03/26 14:14:48 1.4 +++ /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp 2006/06/05 21:01:51 1.5 @@ -1,4 +1,4 @@ -;;; -*- Mode: Lisp; Package: CLIMACS-GUI -*- +;;; -*- Mode: Lisp; Package: CLIMACS-LISP-SYNTAX; -*-

;;; (c) copyright 2004-2005 by ;;; Robert Strandh (strandh@labri.fr) @@ -43,13 +43,36 @@ (define-command (com-package :name t :command-table lisp-table) () (let* ((pane (current-window)) (syntax (syntax (buffer pane))) - (package (climacs-lisp-syntax::package-of syntax))) + (package (package-at-mark syntax (point pane)))) (esa:display-message (format nil "~A" (if (packagep package) (package-name package) package)))))

-(define-command (com-fill-paragraph :name t :command-table lisp-table) () - ) +(define-command (com-fill-paragraph :name t :command-table lisp-table) + () + "Fill paragraph at point. Will have no effect unless there is a +string at point." + (let* ((pane (current-window)) + (buffer (buffer pane)) + (implementation (implementation buffer)) + (syntax (syntax buffer)) + (token (form-around syntax (offset (point pane)))) + (fill-column (auto-fill-column pane)) + (tab-width (tab-space-count (stream-default-view pane)))) + (when (typep token 'string-form) + (with-accessors ((offset1 start-offset) + (offset2 end-offset)) token + (fill-region (make-instance 'standard-right-sticky-mark + :buffer implementation + :offset offset1) + (make-instance 'standard-right-sticky-mark + :buffer implementation + :offset offset2) + #'(lambda (mark) + (syntax-line-indentation mark tab-width syntax)) + fill-column + tab-width + t)))))

(esa:set-key 'com-fill-paragraph 'lisp-table --- /project/climacs/cvsroot/climacs/base.lisp 2006/05/14 20:35:44 1.49 +++ /project/climacs/cvsroot/climacs/base.lisp 2006/06/05 21:01:51 1.50 @@ -587,6 +587,23 @@ (setf column 0)) (incf (offset walking-mark)))))

+(defun fill-region (mark1 mark2 syntax-line-indentation-function fill-column tab-width + &optional (compress-whitespaces t)) + "Fill the region delimited by `mark1' and `mark2'. `Mark1' must be +mark<= `mark2.'" + (let* ((buffer (buffer mark1))) + (do-buffer-region (object offset buffer + (offset mark1) (offset mark2)) + (when (eql object #\Newline) + (setf object #\Space))) + (when (>= (buffer-display-column buffer (offset mark2) tab-width) + (1- fill-column)) + (fill-line mark2 + syntax-line-indentation-function + fill-column + tab-width + compress-whitespaces)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Named objects