Added char21, supplementary-char, multiple-value-bind. The depiction of exec now explicitly states that the result is ignored.

This commit is contained in:
waldemar%netscape.com 2003-06-30 22:10:12 +00:00
Родитель 0e51fdd1f7
Коммит 4c4fb50e92
1 изменённых файлов: 53 добавлений и 29 удалений

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

@ -472,24 +472,29 @@
(if (keywordp x) (if (keywordp x)
(depict-tag-name markup-stream x :reference) (depict-tag-name markup-stream x :reference)
(with-standard-io-syntax (with-standard-io-syntax
(multiple-value-bind (sign s e) (float-to-string-components x exponent-char t) (let ((sign nil))
(when e (when (minusp x)
(depict markup-stream "(")) (setq sign t)
(when sign (setq x (- x)))
(depict markup-stream :minus)) (multiple-value-bind (s e) (positive-float-to-string-components x exponent-char nil nil)
(if e (when (or sign e)
(progn (depict markup-stream "("))
(unless (equal s "1") (when sign
(depict markup-stream s) (depict markup-stream :minus))
(depict markup-stream :cartesian-product-10)) (if e
(depict markup-stream "10") (progn
(depict-char-style (markup-stream :superscript) (unless (equal s "1")
(depict-integer markup-stream e)) (depict markup-stream s)
(depict markup-stream ")")) (depict markup-stream :cartesian-product-10))
(depict markup-stream s))) (depict markup-stream "10")
(depict-char-style (markup-stream :subscript) (depict-char-style (markup-stream :superscript)
(depict-char-style (markup-stream :tag-name) (depict-integer markup-stream e)))
(depict markup-stream suffix)))))) (depict markup-stream s))
(when (or sign e)
(depict markup-stream ")")))
(depict-char-style (markup-stream :subscript)
(depict-char-style (markup-stream :tag-name)
(depict markup-stream suffix)))))))
; Emit markup for the value constant. ; Emit markup for the value constant.
@ -626,6 +631,15 @@
(depict markup-stream (format nil "0x~V,'0X" length n)))) (depict markup-stream (format nil "0x~V,'0X" length n))))
; (supplementary-char <integer>)
(defun depict-supplementary-char (markup-stream world level code-point)
(declare (ignore world level))
(depict markup-stream :left-single-quote)
(depict-char-style (markup-stream :character-literal)
(depict-supplementary-character markup-stream code-point))
(depict markup-stream :right-single-quote))
; (/*/ <value-expr> . <styled-text>) ; (/*/ <value-expr> . <styled-text>)
(defun depict-/*/ (markup-stream world level &rest text) (defun depict-/*/ (markup-stream world level &rest text)
(declare (ignore world)) (declare (ignore world))
@ -768,13 +782,6 @@
(depict-special-function markup-stream world "repeat" element-annotated-expr count-annotated-expr)) (depict-special-function markup-stream world "repeat" element-annotated-expr count-annotated-expr))
#|
(defun depict-subscript-type-expr (markup-stream world type-expr)
(depict-char-style (markup-stream 'sub)
(depict-type-expr markup-stream world type-expr)))
|#
; (nth <vector-expr> <n-expr>) ; (nth <vector-expr> <n-expr>)
(defun depict-nth (markup-stream world level vector-annotated-expr n-annotated-expr) (defun depict-nth (markup-stream world level vector-annotated-expr n-annotated-expr)
(depict-expr-parentheses (markup-stream level %suffix%) (depict-expr-parentheses (markup-stream level %suffix%)
@ -1269,8 +1276,19 @@
; (exec <expr>) ; (exec <expr>)
(defun depict-exec (markup-stream world semicolon last-paragraph-style annotated-expr) (defun depict-exec (markup-stream world semicolon last-paragraph-style annotated-expr)
(depict-paragraph (markup-stream last-paragraph-style) (depict-paragraph (markup-stream last-paragraph-style)
(depict-expression markup-stream world annotated-expr %expr%) (depict-logical-block (markup-stream 0)
(depict-semicolon markup-stream semicolon))) (depict markup-stream "Evaluate")
(depict-break markup-stream 1)
(depict-expression markup-stream world annotated-expr %expr%)
(depict-break markup-stream 1)
(depict markup-stream "and")
(depict-break markup-stream 1)
(depict markup-stream "ignore")
(depict-break markup-stream 1)
(depict markup-stream "its")
(depict-break markup-stream 1)
(depict markup-stream "result")
(depict-semicolon markup-stream semicolon))))
; (const <name> <type> <value>) ; (const <name> <type> <value>)
@ -1288,6 +1306,12 @@
(depict-semicolon markup-stream semicolon))) (depict-semicolon markup-stream semicolon)))
; (multiple-value-bind ((<name> <type>) ...) <lisp-function> <arg-exprs>)
(defun depict-multiple-value-bind (markup-stream world semicolon last-paragraph-style names-and-types lisp-function arg-exprs)
(declare (ignore markup-stream world semicolon last-paragraph-style names-and-types lisp-function arg-exprs))
(error "Can't depict a multiple-value-bind; enclose it inside a /* */ comment."))
; (function (<name> (<var1> <type1> [:var | :unused]) ... (<varn> <typen> [:var | :unused])) <result-type> . <statements>) ; (function (<name> (<var1> <type1> [:var | :unused]) ... (<varn> <typen> [:var | :unused])) <result-type> . <statements>)
(defun depict-function (markup-stream world semicolon last-paragraph-style name-and-arg-binding-exprs result-type-expr &rest body-annotated-stmts) (defun depict-function (markup-stream world semicolon last-paragraph-style name-and-arg-binding-exprs result-type-expr &rest body-annotated-stmts)
(depict-statement-block-using (markup-stream last-paragraph-style) (depict-statement-block-using (markup-stream last-paragraph-style)
@ -1578,7 +1602,7 @@
; (%highlight <highlight> <command> ... <command>) ; (%highlight <highlight> <command> ... <command>)
; Depict the commands highlighted with the <highlight> division style. ; Depict the commands highlighted with the <highlight> division style.
(defun depict-%highlight (markup-stream world depict-env highlight &rest commands) (defun depict-%highlight (markup-stream world depict-env highlight &rest commands)
(when commands (when (and commands (not (eq highlight :hide)))
(depict-division-style (markup-stream highlight t) (depict-division-style (markup-stream highlight t)
(depict-commands markup-stream world depict-env commands)))) (depict-commands markup-stream world depict-env commands))))
@ -1972,7 +1996,7 @@
(depict-function-signature markup-stream world bindings ->-result t))) (depict-function-signature markup-stream world bindings ->-result t)))
(depict-string-words markup-stream " propagates the call to ") (depict-string-words markup-stream " propagates the call to ")
(depict-action-name markup-stream action-name) (depict-action-name markup-stream action-name)
(depict-string-words markup-stream " to every nonterminal in the expansion of ") (depict-string-words markup-stream " to nonterminals in the expansion of ")
(depict-general-grammar-symbol markup-stream general-grammar-symbol :reference) (depict-general-grammar-symbol markup-stream general-grammar-symbol :reference)
(depict markup-stream "."))))) (depict markup-stream ".")))))
(:singleton (depict-delayed-action (markup-stream world depict-env action-name) (:singleton (depict-delayed-action (markup-stream world depict-env action-name)