aboutsummaryrefslogtreecommitdiff
path: root/skribe/doc/skr/manual.skr
diff options
context:
space:
mode:
Diffstat (limited to 'skribe/doc/skr/manual.skr')
-rw-r--r--skribe/doc/skr/manual.skr281
1 files changed, 281 insertions, 0 deletions
diff --git a/skribe/doc/skr/manual.skr b/skribe/doc/skr/manual.skr
new file mode 100644
index 0000000..1982237
--- /dev/null
+++ b/skribe/doc/skr/manual.skr
@@ -0,0 +1,281 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/skr/manual.skr */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Mon Sep 1 11:24:19 2003 */
+;* Last change : Mon Sep 13 19:18:48 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe manuals and documentation pages style */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Base configuration */
+;*---------------------------------------------------------------------*/
+(let ((be (find-engine 'base)))
+ (markup-writer 'example be
+ :options '(:legend :number)
+ :action (lambda (n e)
+ (let ((ident (markup-ident n))
+ (number (markup-option n :number))
+ (legend (markup-option n :legend)))
+ (skribe-eval (mark ident) e)
+ (skribe-eval (center
+ (markup-body n)
+ (if number (bold (format "Ex. ~a: " number)))
+ legend)
+ e)))))
+
+;*---------------------------------------------------------------------*/
+;* html-browsing-extra ... */
+;*---------------------------------------------------------------------*/
+(define (html-browsing-extra n e)
+ (let ((i1 (let ((m (find-markup-ident "Index")))
+ (and (pair? m) (car m))))
+ (i2 (let ((m (find-markup-ident "markups-index")))
+ (and (pair? m) (car m)))))
+ (cond
+ ((not i1)
+ (skribe-error 'left-margin "Can't find section" "Index"))
+ ((not i2)
+ (skribe-error 'left-margin "Can't find chapter" "Standard Markups"))
+ (else
+ (table :width 100.
+ :border 0
+ :cellspacing 0 :cellpadding 0
+ (tr (td :align 'left :valign 'top (bold "index:"))
+ (td :align 'right (ref :handle (handle i1) :text "Global")))
+ (tr (td :align 'left :valign 'top (bold "markups:"))
+ (td :align 'right (ref :handle (handle i2) :text "Index")))
+ (tr (td :align 'left :valign 'top (bold "extensions:"))
+ (td :align 'right (ref :url *skribe-dir-doc-url*
+ :text "Directory"))))))))
+
+;*---------------------------------------------------------------------*/
+;* Html configuration */
+;*---------------------------------------------------------------------*/
+(let* ((he (find-engine 'html))
+ (bd (markup-writer-get 'bold he)))
+ (markup-writer 'bold he
+ :class 'api-proto-ident
+ :before "<font color=\"red\">"
+ :action (lambda (n e) (output n e bd))
+ :after "</font>")
+ (engine-custom-set! he 'web-book-main-browsing-extra html-browsing-extra)
+ (engine-custom-set! he 'favicon "lambda.gif"))
+
+;*---------------------------------------------------------------------*/
+;* LaTeX */
+;*---------------------------------------------------------------------*/
+(let* ((le (find-engine 'latex))
+ (opckg (engine-custom le 'usepackage))
+ (lpckg "\\usepackage{fullpage}\n\\usepackage{eurosym}\n")
+ (npckg (if (string? opckg)
+ (string-append lpckg opckg)
+ lpckg)))
+ (engine-custom-set! le 'documentclass "\\documentclass{book}")
+ (engine-custom-set! le 'usepackage npckg))
+
+;*---------------------------------------------------------------------*/
+;* prgm ... */
+;*---------------------------------------------------------------------*/
+(define-markup (prgm #!rest opts #!key (language skribe) (line #f) (file #f) (definition #f))
+ (let* ((c (cond
+ ((eq? language skribe) *prgm-skribe-color*)
+ ((eq? language xml) *prgm-xml-color*)
+ (else *prgm-default-color*)))
+ (sc (cond
+ ((and file definition)
+ (source :language language :file file :definition definition))
+ (file
+ (source :language language :file file))
+ (else
+ (source :language language (the-body opts)))))
+ (pr (cond
+ (line
+ (prog :line line sc))
+ (else
+ (pre sc)))))
+ (center
+ (frame :margin 5 :border 0 :width *prgm-width*
+ (color :margin 5 :width 100. :bg c pr)))))
+
+;*---------------------------------------------------------------------*/
+;* disp ... */
+;*---------------------------------------------------------------------*/
+(define-markup (disp #!rest opts #!key (verb #f) (line #f) (bg *disp-color*))
+ (if (engine-format? "latex")
+ (if verb
+ (pre (the-body opts))
+ (the-body opts))
+ (center
+ (frame :margin 5 :border 0 :width *prgm-width*
+ (color :margin 5 :width 100. :bg bg
+ (if verb
+ (pre (the-body opts))
+ (the-body opts)))))))
+
+;*---------------------------------------------------------------------*/
+;* keyword ... */
+;*---------------------------------------------------------------------*/
+(define-markup (keyword arg)
+ (new markup
+ (markup '&source-key)
+ (body (cond
+ ((keyword? arg)
+ (keyword->string arg))
+ ((symbol? arg)
+ (string-append ":" (symbol->string arg)))
+ (else
+ arg)))))
+
+;*---------------------------------------------------------------------*/
+;* param ... */
+;*---------------------------------------------------------------------*/
+(define-markup (param arg)
+ (cond
+ ((keyword? arg)
+ (keyword arg))
+ ((symbol? arg)
+ (code (symbol->string arg)))
+ (else
+ arg)))
+
+;*---------------------------------------------------------------------*/
+;* example ... */
+;*---------------------------------------------------------------------*/
+(define-markup (example #!rest opts #!key legend class)
+ (new container
+ (markup 'example)
+ (ident (symbol->string (gensym 'example)))
+ (class class)
+ (required-options '(:legend :number))
+ (options `((:number
+ ,(new unresolved
+ (proc (lambda (n e env)
+ (resolve-counter n env 'example #t)))))
+ ,@(the-options opts :ident :class)))
+ (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;* example-produce ... */
+;*---------------------------------------------------------------------*/
+(define-markup (example-produce example . produce)
+ (list (it "Example:")
+ example
+ (if (pair? produce)
+ (list (paragraph "Produces:") (car produce)))))
+
+;*---------------------------------------------------------------------*/
+;* markup-ref ... */
+;*---------------------------------------------------------------------*/
+(define-markup (markup-ref mk)
+ (ref :mark mk :text (code mk)))
+
+;*---------------------------------------------------------------------*/
+;* &the-index ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-index
+ :class 'markup-index
+ :options '(:column)
+ :before (lambda (n e)
+ (output (markup-option n 'header) e))
+ :action (lambda (n e)
+ (define (make-mark-entry n fst)
+ (let ((l (tr :class 'index-mark-entry
+ (td :colspan 2 :align 'left
+ (bold (it (sf n)))))))
+ (if fst
+ (list l)
+ (list (tr (td :colspan 2)) l))))
+ (define (make-primary-entry n p)
+ (let* ((note (markup-option n :note))
+ (b (markup-body n)))
+ (when p
+ (markup-option-add! b :text
+ (list (markup-option b :text)
+ ", p."))
+ (markup-option-add! b :page #t))
+ (tr :class 'index-primary-entry
+ (td :colspan 2 :valign 'top :align 'left b))))
+ (define (make-column ie p)
+ (let loop ((ie ie)
+ (f #t))
+ (cond
+ ((null? ie)
+ '())
+ ((not (pair? (car ie)))
+ (append (make-mark-entry (car ie) f)
+ (loop (cdr ie) #f)))
+ (else
+ (cons (make-primary-entry (caar ie) p)
+ (loop (cdr ie) #f))))))
+ (define (make-sub-tables ie nc p)
+ (define (split-list l num)
+ (let loop ((l l)
+ (i 0)
+ (acc '())
+ (res '()))
+ (cond
+ ((null? l)
+ (reverse! (cons (reverse! acc) res)))
+ ((= i num)
+ (loop l
+ 0
+ '()
+ (cons (reverse! acc) res)))
+ (else
+ (loop (cdr l)
+ (+ i 1)
+ (cons (car l) acc)
+ res)))))
+ (let* ((l (length ie))
+ (w (/ 100. nc))
+ (iepc (let ((d (/ l nc)))
+ (if (integer? d)
+ (inexact->exact d)
+ (+ 1 (inexact->exact (truncate d))))))
+ (split (split-list ie iepc)))
+ (tr (map (lambda (ies)
+ (td :valign 'top :width w
+ (if (pair? ies)
+ (table :width 100. (make-column ies p))
+ "")))
+ split))))
+ (let* ((ie (markup-body n))
+ (nc (markup-option n :column))
+ (pref (eq? (engine-custom e 'index-page-ref) #t))
+ (loc (ast-loc n))
+ (t (cond
+ ((null? ie)
+ "")
+ ((or (not (integer? nc)) (= nc 1))
+ (table :width 100. :&skribe-eval-location loc
+ (make-column ie pref)))
+ (else
+ (table :width 100. :&skribe-eval-location loc
+ (make-sub-tables ie nc pref))))))
+ (output (skribe-eval t e) e))))
+
+;*---------------------------------------------------------------------*/
+;* compiler-command ... */
+;*---------------------------------------------------------------------*/
+(define-markup (compiler-command bin . opts)
+ (disp :verb #t
+ (color :fg "red" (bold bin))
+ (map (lambda (o)
+ (list " [" (it o) "]"))
+ opts)
+ "..."))
+
+;*---------------------------------------------------------------------*/
+;* compiler-options ... */
+;*---------------------------------------------------------------------*/
+(define-markup (compiler-options bin)
+ (skribe-message " [executing: ~a --options]\n" bin)
+ (let ((port (open-input-file (format "| ~a --options" bin))))
+ (let ((opts (read port)))
+ (close-input-port port)
+ (apply description (map (lambda (opt) (item :key (bold (car opt))
+ (cadr opt) "."))
+ opts)))))
generated by cgit v1.2.3 (git 2.45.2) at 2024-12-23 16:02:23 +0000