Added save-block-style

js2/semantics/HTML.lisp

@@ -183,7 +183,7 @@
 ;;   (<symbol>)                                                ;Attribute name with omitted value
 
 
-(defparameter *html-right-margin* 100)
+(defparameter *html-right-margin* 120)
 (defparameter *allow-line-breaks-in-tags* nil) ;Allow line breaks in tags between attributes?
 
 (defvar *current-html-pos*)          ;Number of characters written to the current line of the stream; nil if *current-html-newlines* is nonzero
@@ -462,9 +462,9 @@
     (:grammar-rhs (:nest :nowrap (div (class "grammar-rhs"))))
     (:grammar-rhs-last :grammar-rhs)
     (:grammar-argument (:nest :nowrap (div (class "grammar-argument"))))
-    (:semantics (:nest :nowrap (p (class "semantics"))))
-    (:semantics-next (:nest :nowrap (p (class "semantics-next"))))
-    (:semantic-comment (:nest :nowrap (p (class "semantic-comment"))))
+    (:semantics (:nest :nowrap (div (class "semantics"))))
+    (:semantics-next (:nest :nowrap (div (class "semantics-next"))))
+    (:semantic-comment (div (class "semantic-comment")))
     
     ;Inline Styles
     (:script (script (type "text/javascript")))
@@ -628,16 +628,19 @@
 
 (defmethod depict-char-style-f ((html-stream html-stream) char-style emitter)
   (assert-true (>= (markup-stream-level html-stream) *markup-stream-content-level*))
-  (assert-true (and char-style (symbolp char-style)))
-  (let ((inner-html-stream (make-html-stream (markup-stream-env html-stream)
-                                             *markup-stream-content-level*
-                                             (markup-stream-logical-position html-stream)
-                                             (cons char-style (html-stream-enclosing-styles html-stream))
-                                             (html-stream-anchors html-stream))))
-    (markup-stream-append1 inner-html-stream char-style)
-    (prog1
-      (funcall emitter inner-html-stream)
-      (markup-stream-append1 html-stream (markup-stream-unexpanded-output inner-html-stream)))))
+  (if char-style
+    (progn
+      (assert-true (symbolp char-style))
+      (let ((inner-html-stream (make-html-stream (markup-stream-env html-stream)
+                                                 *markup-stream-content-level*
+                                                 (markup-stream-logical-position html-stream)
+                                                 (cons char-style (html-stream-enclosing-styles html-stream))
+                                                 (html-stream-anchors html-stream))))
+        (markup-stream-append1 inner-html-stream char-style)
+        (prog1
+          (funcall emitter inner-html-stream)
+          (markup-stream-append1 html-stream (markup-stream-unexpanded-output inner-html-stream)))))
+    (funcall emitter html-stream)))
 
 
 (defmethod ensure-no-enclosing-style ((html-stream html-stream) style)
@@ -645,6 +648,19 @@
     (cerror "Ignore" "Style ~S should not be in effect" style)))
 
 
+(defmethod save-block-style ((html-stream html-stream))
+  (reverse (html-stream-enclosing-styles html-stream)))
+
+
+(defmethod with-saved-block-style-f ((html-stream html-stream) saved-block-style flatten emitter)
+  (assert-true (<= (markup-stream-level html-stream) *markup-stream-paragraph-level*))
+  (if (endp saved-block-style)
+    (funcall emitter html-stream)
+    (depict-block-style-f html-stream (first saved-block-style) flatten
+                          #'(lambda (html-stream)
+                              (with-saved-block-style-f html-stream (rest saved-block-style) flatten emitter)))))
+
+
 (defmethod depict-anchor ((html-stream html-stream) link-prefix link-name duplicate)
   (assert-true (= (markup-stream-level html-stream) *markup-stream-content-level*))
   (let* ((links (markup-env-links (html-stream-env html-stream)))

js2/semantics/Markup.lisp

@@ -363,7 +363,7 @@
 
 ; markup-stream must be a variable that names a markup-stream that is currently
 ; accepting paragraph contents.  Execute body with markup-stream bound to a markup-stream
-; to which the body can emit contents.  The given char-style is applied to all such
+; to which the body can emit contents.  If non-null, the given char-style is applied to all such
 ; contents emitted by body.
 ; Return the result value of body.
 (defmacro depict-char-style ((markup-stream char-style) &body body)
@@ -378,6 +378,24 @@
 (defgeneric ensure-no-enclosing-style (markup-stream style))
 
 
+; Return a value that captures the current sequence of enclosing block styles.
+(defgeneric save-block-style (markup-stream))
+
+; markup-stream must be a variable that names a markup-stream that is currently
+; accepting paragraphs.  Execute body with markup-stream bound to a markup-stream
+; to which the body can emit contents.  The given saved-block-style is applied to all
+; paragraphs emitted by body (in the HTML emitter only; RTF has no block styles).
+; saved-block-style should have been obtained from a past call to save-block-style.
+; If flatten is true, do not emit the style if it is already in effect from a surrounding block
+; or if its contents are empty.
+; Return the result value of body.
+(defmacro with-saved-block-style ((markup-stream saved-block-style &optional flatten) &body body)
+  `(with-saved-block-style-f ,markup-stream ,saved-block-style ,flatten
+     #'(lambda (,markup-stream) ,@body)))
+
+(defgeneric with-saved-block-style-f (markup-stream saved-block-style flatten emitter))
+
+
 ; Depict an anchor.  The concatenation of link-prefix and link-name must be a string
 ; suitable for an anchor name.
 ; If duplicate is true, allow duplicate calls for the same link-name, in which case only