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)))