[climacs-cvs] CVS update: climacs/base.lisp climacs/buffer.lisp climacs/gui.lisp climacs/packages.lisp climacs/syntax.lisp
Matthieu Villeneuve
mvilleneuve at common-lisp.net
Sat Jan 15 17:39:30 UTC 2005
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 at labri.fr)
+;;; (c) copyright 2005 by
+;;; Matthieu Villeneuve (matthieu.villeneuve at 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)
More information about the Climacs-cvs
mailing list