Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv1311 Modified Files: base.lisp buffer.lisp gui.lisp packages.lisp syntax.lisp Log Message: Added tabify/untabify-region Date: Sat Jan 15 18:39:24 2005 Author: mvilleneuve Index: climacs/base.lisp diff -u climacs/base.lisp:1.16 climacs/base.lisp:1.17 --- climacs/base.lisp:1.16 Thu Jan 13 17:52:14 2005 +++ climacs/base.lisp Sat Jan 15 18:39:23 2005 @@ -96,6 +96,15 @@ count (eql (buffer-object buffer offset1) #\Newline) do (incf offset1))) +(defun buffer-display-column-number (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 + do (incf column (if (eql (buffer-object buffer i) #\Tab) + (- tab-width (mod column tab-width)) + 1)) + finally (return column)))) + (defgeneric number-of-lines-in-region (mark1 mark2) (:documentation "Return the number of lines (or rather the number of Newline characters) in the region between MARK and MARK2. It is @@ -270,6 +279,72 @@ (let ((offset (offset mark))) (forward-word mark) (capitalize-region offset mark)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Tabify + +(defun tabify-buffer-region (buffer offset1 offset2 tab-width) + (flet ((looking-at-spaces (buffer offset count) + (loop for i from offset + repeat count + unless (char= (buffer-object buffer i) #\Space) + return nil + finally (return t)))) + (loop for offset = offset1 then (1+ offset) + until (>= offset offset2) + do (let* ((column (buffer-display-column-number + buffer offset tab-width)) + (count (- tab-width (mod column tab-width)))) + (when (looking-at-spaces buffer offset count) + (finish-output) + (delete-buffer-range buffer offset count) + (insert-buffer-object buffer offset #\Tab) + (decf offset2 (1- count))))))) + +(defgeneric tabify-region (mark1 mark2 tab-width) + (:documentation "Replace sequences of tab-width spaces with tabs +in the region delimited by mark1 and mark2.")) + +(defmethod tabify-region ((mark1 mark) (mark2 mark) tab-width) + (assert (eq (buffer mark1) (buffer mark2))) + (tabify-buffer-region (buffer mark1) (offset mark1) (offset mark2) + tab-width)) + +(defmethod tabify-region ((offset integer) (mark mark) tab-width) + (tabify-buffer-region (buffer mark) offset (offset mark) tab-width)) + +(defmethod tabify-region ((mark mark) (offset integer) tab-width) + (tabify-buffer-region (buffer mark) (offset mark) offset tab-width)) + +(defun untabify-buffer-region (buffer offset1 offset2 tab-width) + (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)) + (count (- tab-width (mod column tab-width)))) + (delete-buffer-range buffer offset 1) + (loop repeat count + do (insert-buffer-object buffer offset #\Space)) + (incf offset (1- count)) + (finish-output *error-output*) + (incf offset2 (1- count))))) + +(defgeneric untabify-region (mark1 mark2 tab-width) + (:documentation "Replace tabs with tab-width spaces in the region +delimited by mark1 and mark2.")) + +(defmethod untabify-region ((mark1 mark) (mark2 mark) tab-width) + (assert (eq (buffer mark1) (buffer mark2))) + (untabify-buffer-region (buffer mark1) (offset mark1) (offset mark2) + tab-width)) + +(defmethod untabify-region ((offset integer) (mark mark) tab-width) + (untabify-buffer-region (buffer mark) offset (offset mark) tab-width)) + +(defmethod untabify-region ((mark mark) (offset integer) tab-width) + (untabify-buffer-region (buffer mark) (offset mark) offset tab-width)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Index: climacs/buffer.lisp diff -u climacs/buffer.lisp:1.19 climacs/buffer.lisp:1.20 --- climacs/buffer.lisp:1.19 Thu Jan 13 17:52:14 2005 +++ climacs/buffer.lisp Sat Jan 15 18:39:24 2005 @@ -299,14 +299,30 @@ do (incf offset)) (setf (offset mark) offset))) +(defgeneric buffer-line-number (buffer offset) + (:documentation "Return the line number of the offset. Lines are numbered from zero.")) + +(defmethod buffer-line-number ((buffer standard-buffer) (offset integer)) + (loop for i from 0 below offset + count (eql (buffer-object buffer i) #\Newline))) + +(defgeneric buffer-column-number (buffer offset) + (:documentation "Return the column number of the offset. The column number of an offset is + the number of objects between it and the preceding newline, or + between it and the beginning of the buffer if the offset is on the + first line of the buffer.")) + +(defmethod buffer-column-number ((buffer standard-buffer) (offset integer)) + (loop for i downfrom offset + while (> i 0) + until (eql (buffer-object buffer (1- i)) #\Newline) + count t)) + (defgeneric line-number (mark) (:documentation "Return the line number of the mark. Lines are numbered from zero.")) (defmethod line-number ((mark mark-mixin)) - (loop with buffer = (buffer mark) - with end = (offset mark) - for offset from 0 below end - count (eql (buffer-object buffer offset) #\Newline))) + (buffer-line-number (buffer mark) (offset mark))) (defgeneric column-number (mark) (:documentation "Return the column number of the mark. The column number of a mark is @@ -315,10 +331,7 @@ first line of the buffer.")) (defmethod column-number ((mark mark-mixin)) - (loop for offset downfrom (offset mark) - while (> offset 0) - until (eql (buffer-object (buffer mark) (1- offset)) #\Newline) - count t)) + (buffer-column-number (buffer mark) (offset mark))) (defgeneric insert-buffer-object (buffer offset object) (:documentation "Insert the object at the offset in the buffer. Any left-sticky marks Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.68 climacs/gui.lisp:1.69 --- climacs/gui.lisp:1.68 Fri Jan 14 21:44:47 2005 +++ climacs/gui.lisp Sat Jan 15 18:39:24 2005 @@ -416,6 +416,16 @@ (define-named-command com-capitalize-word () (capitalize-word (point (win *application-frame*)))) +(define-named-command com-tabify-region () + (let ((pane (win *application-frame*))) + (multiple-value-bind (start end) (region-limits pane) + (tabify-region start end (tab-space-count (syntax pane)))))) + +(define-named-command com-untabify-region () + (let ((pane (win *application-frame*))) + (multiple-value-bind (start end) (region-limits pane) + (untabify-region start end (tab-space-count (syntax pane)))))) + (define-named-command com-toggle-layout () (setf (frame-current-layout *application-frame*) (if (eq (frame-current-layout *application-frame*) 'default) Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.30 climacs/packages.lisp:1.31 --- climacs/packages.lisp:1.30 Fri Jan 14 14:07:39 2005 +++ climacs/packages.lisp Sat Jan 15 18:39:24 2005 @@ -33,6 +33,7 @@ #:beginning-of-buffer-p #:end-of-buffer-p #:beginning-of-line #:end-of-line #:beginning-of-line-p #:end-of-line-p + #:buffer-line-number #:buffer-column-number #:line-number #:column-number #:insert-buffer-object #:insert-buffer-sequence #:insert-object #:insert-sequence @@ -54,6 +55,7 @@ #:delete-word #:backward-delete-word #:upcase-region #:downcase-region #:capitalize-region #:upcase-word #:downcase-word #:capitalize-word + #:tabify-region #:untabify-region #:input-from-stream #:output-to-stream #:name-mixin #:name #:buffer-lookin-at #:looking-at @@ -69,6 +71,7 @@ (defpackage :climacs-syntax (:use :clim-lisp :clim :climacs-buffer :climacs-base :flexichain) (:export #:syntax #:define-syntax + #:tabify-mixin #:tab-space-count #:basic-syntax #:texinfo-syntax #:redisplay-pane #:redisplay-with-syntax #:full-redisplay #:page-down #:page-up Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.23 climacs/syntax.lisp:1.24 --- climacs/syntax.lisp:1.23 Thu Jan 13 06:38:41 2005 +++ climacs/syntax.lisp Sat Jan 15 18:39:24 2005 @@ -1,7 +1,9 @@ ;;; -*- Mode: Lisp; Package: CLIMACS-BUFFER -*- -;;; (c) copyright 2004 by +;;; (c) copyright 2004-2005 by ;;; Robert Strandh (strandh@labri.fr) +;;; (c) copyright 2005 by +;;; Matthieu Villeneuve (matthieu.villeneuve@free.fr) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public @@ -36,6 +38,22 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; Tabify + +(defclass tabify-mixin () + ((space-width :initarg nil :reader space-width) + (tab-width :initarg nil :reader tab-width))) + +(defgeneric tab-space-count (tabify)) + +(defmethod tab-space-count (tabify) + 1) + +(defmethod tab-space-count ((tabify tabify-mixin)) + (round (tab-width tabify) (space-width tabify))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; Syntax completion (defparameter *syntaxes* '()) @@ -69,14 +87,12 @@ (insert* cache 0 nil) cache)) -(define-syntax basic-syntax ("Basic" (syntax)) +(define-syntax basic-syntax ("Basic" (syntax tabify-mixin)) ((top :reader top) (bot :reader bot) (scan :reader scan) (cursor-x :initform 2) (cursor-y :initform 2) - (space-width :initform nil) - (tab-width :initform nil) (cache :initform (make-cache)))) (defmethod initialize-instance :after ((syntax basic-syntax) &rest args &key pane)