Added support for :force-compact

This commit is contained in:
waldemar%netscape.com 2003-06-05 01:32:30 +00:00
Родитель 3000bb021f
Коммит d9e0f32571
1 изменённых файлов: 18 добавлений и 6 удалений

Просмотреть файл

@ -212,7 +212,8 @@
; ; written since the last hard break. ; ; written since the last hard break.
(surplus 0 :type integer) ;Value to subtract from position if soft breaks were hard breaks in this logical block (surplus 0 :type integer) ;Value to subtract from position if soft breaks were hard breaks in this logical block
(n-soft-breaks nil :type (or null integer)) ;Number of soft-breaks in the current paragraph or nil if not inside a depict-logical-block (n-soft-breaks nil :type (or null integer)) ;Number of soft-breaks in the current paragraph or nil if not inside a depict-logical-block
(indent 0 :type (or null integer))) ;Indent for next line (indent 0 :type (or null integer)) ;Indent for next line
(force-compact-next-break nil)) ;If true, the next break is :force-compact.
; Return the value the position would have if soft breaks became hard breaks in this logical block. ; Return the value the position would have if soft breaks became hard breaks in this logical block.
@ -265,9 +266,9 @@
; Return a freshly consed markup list for a hard line break followed by indent spaces. ; Return a freshly consed markup list for a hard line break followed by indent spaces.
(defun hard-break-markup (indent) (defun hard-break-markup (indent force-compact)
(cond (cond
(*compact-breaks* (list :space)) (*compact-breaks* (if force-compact (list :new-line) (list :space)))
((zerop indent) (list :new-line)) ((zerop indent) (list :new-line))
(t (list :new-line (make-string indent :initial-element #\space :element-type #-mcl 'character #+mcl 'base-character))))) (t (list :new-line (make-string indent :initial-element #\space :element-type #-mcl 'character #+mcl 'base-character)))))
@ -281,7 +282,7 @@
(substitute-soft-breaks (substitute-soft-breaks
tree tree
#'(lambda (soft-break) #'(lambda (soft-break)
(nconc (hard-break-markup indent) (nconc (hard-break-markup indent nil)
(copy-list (soft-break-groups soft-break)))))) (copy-list (soft-break-groups soft-break))))))
@ -573,6 +574,7 @@
(incf (logical-position-n-hard-breaks logical-position) (+ inner-n-hard-breaks inner-n-soft-breaks)) (incf (logical-position-n-hard-breaks logical-position) (+ inner-n-hard-breaks inner-n-soft-breaks))
(setf (logical-position-position logical-position) (logical-position-minimal-position inner-logical-position)) (setf (logical-position-position logical-position) (logical-position-minimal-position inner-logical-position))
(setf (logical-position-surplus logical-position) 0)))) (setf (logical-position-surplus logical-position) 0))))
(setf (logical-position-force-compact-next-break logical-position) (logical-position-force-compact-next-break inner-logical-position))
(setf (markup-stream-logical-position markup-stream) logical-position))) (setf (markup-stream-logical-position markup-stream) logical-position)))
(funcall emitter markup-stream))) (funcall emitter markup-stream)))
@ -591,6 +593,7 @@
; Emit a conditional line break. If the line break is not needed, emit width spaces instead. ; Emit a conditional line break. If the line break is not needed, emit width spaces instead.
; If width is t or omitted, the line break is unconditional. ; If width is t or omitted, the line break is unconditional.
; If width is :force-compact, the line break is unconditional even if *compact-breaks* is true.
; If width is nil, do nothing. ; If width is nil, do nothing.
; If the line break is needed, the new line is indented to the current indent level and groups, if provided, ; If the line break is needed, the new line is indented to the current indent level and groups, if provided,
; are added to the beginning of the new line. The width of these groups is currently not taken into account. ; are added to the beginning of the new line. The width of these groups is currently not taken into account.
@ -600,9 +603,12 @@
(when width (when width
(let* ((logical-position (markup-stream-logical-position markup-stream)) (let* ((logical-position (markup-stream-logical-position markup-stream))
(indent (logical-position-indent logical-position))) (indent (logical-position-indent logical-position)))
(if (eq width t) (when (logical-position-force-compact-next-break logical-position)
(setq width :force-compact)
(setf (logical-position-force-compact-next-break logical-position) nil))
(if (member width '(t :force-compact))
(progn (progn
(depict-item-or-list markup-stream (hard-break-markup indent)) (depict-item-or-list markup-stream (hard-break-markup indent (eq width :force-compact)))
(dolist (item groups) (dolist (item groups)
(markup-stream-append1 markup-stream item))) (markup-stream-append1 markup-stream item)))
(progn (progn
@ -617,6 +623,12 @@
(markup-stream-append1 markup-stream (make-soft-break width groups))))))) (markup-stream-append1 markup-stream (make-soft-break width groups)))))))
; Override the next break emitted to have the :force-compact width.
(defun force-compact-next-break (markup-stream)
(let ((logical-position (markup-stream-logical-position markup-stream)))
(setf (logical-position-force-compact-next-break logical-position) t)))
; Depict the string unquoted, except that replace each space with a one-character break. ; Depict the string unquoted, except that replace each space with a one-character break.
(defun depict-string-words (markup-stream string) (defun depict-string-words (markup-stream string)
(do ((low 0) (do ((low 0)