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

Modified Files: packages.lisp base.lisp Log Message: Added `just-n-spaces' function.

--- /project/climacs/cvsroot/climacs/packages.lisp 2006/06/12 19:10:58 1.100 +++ /project/climacs/cvsroot/climacs/packages.lisp 2006/07/03 15:46:53 1.101 @@ -75,6 +75,7 @@ #:buffer-display-column #:number-of-lines-in-region #:constituentp + #:just-n-spaces #:forward-word #:backward-word #:buffer-region-case #:input-from-stream #:output-to-stream --- /project/climacs/cvsroot/climacs/base.lisp 2006/06/29 14:23:26 1.52 +++ /project/climacs/cvsroot/climacs/base.lisp 2006/07/03 15:46:53 1.53 @@ -144,6 +144,29 @@ function does not respect the current syntax." (member obj '(#\Space #\Tab #\Newline #\Page #\Return)))

+(defun just-n-spaces (mark1 n) + "Remove all spaces around `mark', leaving behind `n' +spaces. `Mark' will be moved to after any spaces inserted." + (let ((mark2 (clone-mark mark1))) + (loop + while (not (beginning-of-buffer-p mark2)) + while (eql (object-before mark2) #\Space) + do (backward-object mark2)) + (loop + while (not (end-of-buffer-p mark1)) + while (eql (object-after mark1) #\Space) + do (forward-object mark1)) + (let ((existing-spaces (- (offset mark1) + (offset mark2)))) + (cond ((= n existing-spaces)) + ((> n existing-spaces) + (insert-sequence mark1 (make-array (- n existing-spaces) + :initial-element #\Space))) + ((< n existing-spaces) + (delete-region (- (offset mark1) + (- existing-spaces n)) + mark1)))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Character case