[mcclim-cvs] CVS mcclim/Drei

[dmurray]

Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv11501/Drei

Modified Files:
	views.lisp drei-redisplay.lisp core-commands.lisp 
Log Message:
Slightly more general tab-stops. May break the tabify abstraction -
which I don't understand - but doesn't seem to break the code.


--- /project/mcclim/cvsroot/mcclim/Drei/views.lisp	2008/01/31 08:34:15	1.33
+++ /project/mcclim/cvsroot/mcclim/Drei/views.lisp	2008/02/03 07:16:48	1.34
@@ -60,7 +60,12 @@
                      :initform nil)
    (%use-tabs :accessor use-tabs
               :initform *use-tabs-for-indentation*
-              :initarg :use-tabs)))
+              :initarg :use-tabs)
+   (%tab-stops :accessor tab-stops
+	       :initform '()
+	       :initarg :tab-stops
+	       :documentation "A list of tab-stops in device units.
+If empty, tabs every TAB-WIDTH are assumed.")))
 
 (defun maybe-update-recordings (stream tabify)
   (with-accessors ((space-width recorded-space-width)
@@ -87,7 +92,28 @@
         (* (tab-space-count tabify) (space-width stream tabify))
         (recorded-tab-width tabify))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defgeneric next-tab-stop (stream tabify x)
+  (:documentation "Return the distance to the next tab-stop after `x'
+on `stream' in device units (most likely pixels).")
+  (:method ((stream extended-output-stream) (tabify tabify-mixin) x)
+    (flet ((round-up (x width)
+	     (- width (mod x width))))
+      (if (tab-stops tabify)
+	(let ((next (find-if (lambda (pos) (> pos x)) (tab-stops tabify))))
+	  (or (and next (- next x)) (round-up x (space-width stream tabify))))
+	(round-up x (tab-width stream tabify))))))
+
+(defgeneric (setf tab-stop-columns) (column-list tabify)
+  (:documentation "Set the TAB-STOPS of view at the character column offsets
+in `column-list'.")
+  (:method (column-list (tabify tabify-mixin))
+    (setf (tab-stops tabify) 
+	  (and column-list
+	       (sort (mapcar (lambda (col) (* col (space-width (recorded-stream tabify) tabify)))
+			     column-list) 
+		     #'<)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; Undo
 
--- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp	2008/02/02 19:03:26	1.58
+++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp	2008/02/03 07:16:49	1.59
@@ -487,13 +487,11 @@
   (loop with parts = (analyse-stroke-string stroke-string)
      with width = 0
      with widths = (make-array 1 :adjustable t :fill-pointer t :initial-element 0)
-     with tab-width
      for (start end object) in parts
      do (cond ((eql object #\Tab)
-               (incf width 
-                     (- (or tab-width
-                            (setf tab-width (tab-width stream (stream-default-view stream))))
-                        (mod (+ width x-position) tab-width)))
+               (incf width
+		     (next-tab-stop stream (stream-default-view stream)
+				    (+ width x-position)))
                (vector-push-extend width widths))
               (object
                (multiple-value-bind (w)
--- /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp	2008/01/30 11:48:40	1.16
+++ /project/mcclim/cvsroot/mcclim/Drei/core-commands.lisp	2008/02/03 07:16:49	1.17
@@ -222,6 +222,12 @@
   (untabify-region (mark) (point)
                    (tab-space-count (current-view))))
 
+(define-command (com-set-tab-stops :name t :command-table editing-table)
+    ((tab-stops '(sequence (integer 0)) :prompt "List of tab stops"))
+  "Accept a list of tab positions (in columns) for the view."
+  (setf (drei::tab-stop-columns (current-view)) 
+	tab-stops))
+
 (define-command (com-indent-line :name t :command-table indent-table) ()
   (indent-current-line (current-view) (point)))