Changeset 9151 in project


Ignore:
Timestamp:
03/04/08 06:24:29 (12 years ago)
Author:
elf
Message:

new version - colour added

Location:
release/3/eformat
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/3/eformat/doc.scm

    r8253 r9151  
    22;;;; file:      doc.scm
    33;;;; author:    elf <elf@ephemeral.net>
    4 ;;;; date:      24 Jan 2008
     4;;;; date:      03 Mar 2008
    55;;;; licence:   BSD (see LICENCE)
    66;;;; dialect:   r5rs
    77;;;; requires:  chicken build tools, eggdoc
    8 ;;;; version:   3.0
     8;;;; version:   3.1
    99;;;; purpose:   eggdoc-formatted documentation for eformat
    1010;;;;
    11 ;;;; history:   3.0  First public release
     11;;;; history:   3.1  20080303 Proper wrapping for colour escape codes in
     12;;;;                          strings.  Added C (colour) option to eformat.
     13;;;;            3.0  20080124 First public release
    1214;;;;            2.x  Added many options
    1315;;;;            1.0  Initial release
     
    1618
    1719
     20(use srfi-1)    ; list library
    1821(use utils)     ; utility procedures
    1922(use eggdoc)    ; egg documentation facility
     
    3639;; (table-make FORMAT-WRAPPERS HEADERS ROWS...)
    3740;; helper macro for constructing tables
     41(define (elf-eggdoc-ss doc)
     42    `((table-spec *macro* .
     43        ,(lambda (tag fmtw hdrs . rows)
     44            `(table (@ (style "table-layout: auto"))
     45                 (tr (@ (style "vertical-align: baseline"))
     46                     ,@(map
     47                         (lambda (h)
     48                             `(th (@ (style "padding-top: 2.5em")) ,h))
     49                         hdrs))
     50                     ,@(pair-fold-right
     51                     (lambda (x r)
     52                         (let ((t   (if (null? (cdr x))
     53                                        "padding-top: 2em; padding-bottom: 2.5em"
     54                                        "padding-top: 2em"))
     55                               (a   (car x)))
     56                             (cons
     57                                 `(tr (@ (style "vertical-align: baseline"))
     58                                      ,@(map
     59                                          (lambda (f d)
     60                                              `(td (@ (style ,t)) (,f ,d)))
     61                                          fmtw a))
     62                                 r)))
     63                     '()
     64                     rows))))
     65      (inline-table-spec *macro* .
     66        ,(lambda (tag fmtw hdrs . rows)
     67            `(table (@ (style "inline-table; table-layout: auto"))
     68                 (tr (@ (style "vertical-align: baseline"))
     69                     ,@(map
     70                         (lambda (h)
     71                             `(th (@ (style "padding-top: 1.5em")) ,h))
     72                         hdrs))
     73                     ,@(pair-fold-right
     74                     (lambda (x r)
     75                         (let ((t   (if (null? (cdr x))
     76                                        "padding-top: 1em; padding-bottom: 1.5em"
     77                                        "padding-top: 1em"))
     78                               (a   (car x)))
     79                             (cons
     80                                 `(tr (@ (style "vertical-align: baseline"))
     81                                      ,@(map
     82                                          (lambda (f d)
     83                                              `(td (@ (style ,t)) (,f ,d)))
     84                                          fmtw a))
     85                                 r)))
     86                     '()
     87                     rows))))
     88        ,@(eggdoc:make-stylesheet doc)))
     89
     90#|
    3891(define-macro (table-make fmtw hdrs . rows)
     92    `(list 'quasiquote
     93           (append
     94               (list 'table)
     95               (list (list '@ (list 'style "table-layout: auto")))
     96               (list
     97                   (append
     98                       (list 'tr)
     99                       (list (list '@ (list 'style "vertical-align: baseline")))
     100                       (map
     101                           (lambda (h)
     102                               (list
     103                                   'th
     104                                   (list '@ (list 'style "padding-top: 2.5em"))
     105                                   h))
     106                           (list ,@hdrs))))
     107               (pair-fold-right
     108                   (lambda (x r)
     109                       (let ((t   (if (null? (cdr x))
     110                                      "padding-top: 2em; padding-bottom: 2.5em"
     111                                      "padding-top: 2em"))
     112                             (a   (cdr x)))
     113                           (cons
     114                               (list
     115                                   'tr
     116                                   (list
     117                                       '@
     118                                       (list
     119                                           'style
     120                                           "vertical-align: baseline"))
     121                                   (map
     122                                       (lambda (f d)
     123                                           (list
     124                                               'td
     125                                               (list '@ (list 'style t))
     126                                               (list f d)))
     127                                       '(list ,@fmtw) a))
     128                               r)))
     129                   '()
     130                   '(list ,@rows)))))
     131|#
     132#|
     133
     134    ``(
     135        table (@ (style "table-layout: auto"))
     136            (tr (@ (style "vertical-align: baseline"))
     137                ,@(map
     138                    (lambda (h)
     139                        `(th (@ (style "padding-top: 2.5em")) ,h))
     140                        hdrs))
     141            ,@(pair-fold-right
     142                (lambda (x r)
     143                    (let ((t   (if (null? (cdr x))
     144                                   "padding-top: 2em; padding-bottom: 2.5em"
     145                                   "padding-top: 2em"))
     146                          (a   (car x)))
     147                        (cons
     148                            `(tr (@ (style "vertical-align: baseline"))
     149                                 ,(map
     150                                     (lambda (f d)
     151                                         (list
     152                                             'td
     153                                             (list '@ (list 'style t))
     154                                             (list f d)))
     155                                           
     156                                         ;(if (list? d)
     157                                             ;`(td (@ (style ,t)) (,f (,@d)))
     158                                             ;`(td (@ (style ,t)) (,f ,d))))
     159                                     fmtw a))
     160                            r)))
     161                '()
     162                rows)))
     163
     164(define-macro (inline-table-make fmtw hdrs . rows)
    39165    `'(
    40         table
    41             (tr ,@(map (lambda (h) `(th ,h)) hdrs))
    42             ,@(map
    43                 (lambda (r)
    44                     `(tr
    45                         ,@(map
    46                             (lambda (f d)
    47                                 `(td (,f ,d)))
    48                             fmtw r)))
     166        table (@ (style "inline-table; table-layout: auto"))
     167            (tr (@ (style "vertical-align: baseline"))
     168                ,@(map
     169                    (lambda (h)
     170                        `(th (@ (style "padding-top: 1.5em")) ,h))
     171                        hdrs))
     172            ,@(pair-fold-right
     173                (lambda (x r)
     174                    (let ((t   (if (null? (cdr x))
     175                                   "padding-top: 1em; padding-bottom: 1.5em"
     176                                   "padding-top: 1em"))
     177                          (a   (car x)))
     178                        (cons
     179                            `(tr (@ (style "vertical-align: baseline"))
     180                                 ,@(map
     181                                     (lambda (f d)
     182                                         `(td (@ (style ,t)) (,f ,d)))
     183                                     fmtw a))
     184                            r)))
     185                '()
    49186                rows)))
     187|#
    50188
    51189(define doc
     
    56194
    57195        (history
     196            (version "3.1" "(eformat)   Wrap fixed for strings with colour escapes.  Added new colour-code (C) directive.")
    58197            (version "3.0" "(eformat)   First public release")
    59198            (version "2.1" "(eformat)   New float (D), pad-char (C) directives")
     
    80219               "traditional text formatting procedures while keeping much "
    81220               "of the same feel and functionality.  While not every directive "
    82                "from Common Lisp's " (code "(format)") " is implemented, those "
     221               "from Common Lisp's " (tt "(format)") " is implemented, those "
    83222               "directives that are should cover most of the use cases.  "
    84223               "In addition, there are several new directives to simplify "
    85224               "frequently occurring patterns.  Any suggestions for "
    86225               "additional functionality are welcomed.")
    87             (p "The " (code "eformat") " package has two major components: "
    88                (code "eformat") " and " (code "wrap-text") ".  "
    89                (code "eformat") " outputs formatted text according to a "
    90                "format-string and a list of arguments.  " (code "wrap-text")
     226            (p "The " (tt "eformat") " package has two major components: "
     227               (tt "eformat") " and " (tt "wrap-text") ".  "
     228               (tt "eformat") " outputs formatted text according to a "
     229               "format-string and a list of arguments.  " (tt "wrap-text")
    91230               " is a flexible means of wrapping and indenting arbitrary "
    92231               "blocks of text.  Several useful auxiliary procedures have "
     
    94233           
    95234            (subsection "Core Procedures"
    96                 (p "These procedures form the core of the " (code "eformat")
     235                (p "These procedures form the core of the " (tt "eformat")
    97236                   " functionality.  See [Output Directives] for a list "
    98                    "and explanation of all valid " (code "eformat")
     237                   "and explanation of all valid " (tt "eformat")
    99238                   " format-string directives.")
    100239                (group
     
    102241                        "(eformat DESTINATION FMTSTRING [ARG ...])"
    103242                        (p "Creates an output string from the "
    104                            (code "FMTSTRING") ", substituting " (code "ARG")
     243                           (tt "FMTSTRING") ", substituting " (tt "ARG")
    105244                           "s for the corresponding format directives.  The "
    106                            "number of " (code "ARG") " values must be "
     245                           "number of " (tt "ARG") " values must be "
    107246                           "equivalent to the number required by "
    108                            (code "FMTSTRING") " or an error is signalled.  "
     247                           (tt "FMTSTRING") " or an error is signalled.  "
    109248                           "See [Output Directives] for an explanation of all "
    110249                           "valid output directives and the number of "
    111                            "arguments each requires.  " (code "FMTSTRING")
     250                           "arguments each requires.  " (tt "FMTSTRING")
    112251                           " must be a non-null string or an error is "
    113252                           "signalled.")
    114                         (p (code "DESTINATION") " determines how the final "
     253                        (p (tt "DESTINATION") " determines how the final "
    115254                           "generated string (<ostr>) is handled according "
    116255                           "to the following table:")
    117                         ,(table-make
    118                             (code code p p)
     256                        (table-spec
     257                            (tt tt p p)
    119258                            ("DESTINATION" "Handler" "Return Val" "Description")
    120259                            ("#f" "<ostr>"
     
    136275                        "(wrap-text STRING WRAP-COLUMN [INDENT-SPACES 0] [PRESERVE-STRUCTURE #t])"
    137276                        (p "Wraps (i.e., adds implicit newlines to) "
    138                            (code "STRING") " at the whitespace character "
     277                           (tt "STRING") " at the whitespace character "
    139278                           "nearest to (equivalent or less than) "
    140                            (code "WRAP-COLUMN") ".  Implicit newlines cause "
     279                           (tt "WRAP-COLUMN") ".  Implicit newlines cause "
    141280                           "the following line to be indented by "
    142                            (code "INDENT-SPACES") ".  An error is signalled if "
    143                            (code "INDENT-SPACES") " is not strictly less than "
    144                            (code "WRAP-COLUMN") ".")
     281                           (tt "INDENT-SPACES") ".  An error is signalled if "
     282                           (tt "INDENT-SPACES") " is not strictly less than "
     283                           (tt "WRAP-COLUMN") ".")
    145284                        (p "Explicit newlines are any newline (or "
    146285                           "newline-equivalent) characters in the initial "
    147                            (code "STRING") ".  See the table below for "
     286                           (tt "STRING") ".  See the table below for "
    148287                           "descriptions of all newline-equiv whitespace.  "
    149                            "If the optional " (code "PRESERVE-STRUCTURE")
    150                            " argument is given and " (code "#f") ", all "
     288                           "If the optional " (tt "PRESERVE-STRUCTURE")
     289                           " argument is given and " (tt "#f") ", all "
    151290                           "whitespace chars are converted to spaces before "
    152291                           "processing.  Excess whitespace is always removed "
     
    154293                           "whitespace is removed from the beginning of "
    155294                           "the following line as well (before adding "
    156                            (code "INDENT-SPACES") " spaces).  All whitespace "
     295                           (tt "INDENT-SPACES") " spaces).  All whitespace "
    157296                           "characters are correctly handled, including "
    158                            "vertical tabs and form-feeds."))))
     297                           "vertical tabs and form-feeds.")
     298                         (p "Colour codes in strings (" (tt "ESC [ codes m")
     299                            ") are now properly handled for line-length "
     300                            "calculations.")
     301                           )))
    159302
    160303            (subsection "Output Directives"
    161                 (p "All directives start with a " (code "~") " (tilde).  All "
     304                (p "All directives start with a " (tt "~") " (tilde).  All "
    162305                   "text besides directives is added to the output-string via "
    163                    (code "display") ".  It is an error for a tilde to appear "
     306                   (tt "display") ".  It is an error for a tilde to appear "
    164307                   "in the format string except as the start of a directive.")
    165308                (p "All modifiers are optional except where otherwise "
     
    167310                   "(without whitespace or brackets) and have the given "
    168311                   "default semantics:")
    169                 (p (code "~ [ - ] [ @ ] [ 0 ] [ & ] [ M ] [ , X ] [ . C ] D"))
    170                 ,(table-make
    171                     (code p code code code code p)
     312                (p (tt "~ [ - ] [ @ ] [ 0 ] [ & ] [ M ] [ , X ] [ . C ] D"))
     313                (table-spec
     314                    (tt p tt tt tt tt p)
    172315                    ("Symbol" "Name" "Input Value" "Default Value"
    173316                     "Requires" "Forbids" "Description")
     
    177320                     ("Aligns the directive's output with the right field "
    178321                      "margin (default is left).  Requires the "
    179                       (code "min-length-modifier") " to be given."))
     322                      (tt "min-length-modifier") " to be given."))
    180323                    ("@ (at-sign)" "center-justify-modifier" "@" "NONE" "M" "-"
    181324                     ("Aligns the directive's output in the center of the "
    182325                      "field (default is left).  Requires the "
    183                       (code "min-length-modifier") " to be given."))
     326                      (tt "min-length-modifier") " to be given."))
    184327                    ("0 (zero)" "zero-pad-modifier" "0" "NONE" "M" "&"
    185328                     ("Pads with zeros (default is spaces).  Requires the "
    186                       (code "min-length-modifier") " to be given."))
     329                      (tt "min-length-modifier") " to be given."))
    187330                    ("& (ampersand)" "char-pad-modifier" "&" "NONE" "M" "0"
    188331                     ("Pads with a character given on the command line "
    189332                      "(default is spaces).  Requires the "
    190                       (code "min-length-modifier") " to be given."))
     333                      (tt "min-length-modifier") " to be given."))
    191334                    ("M" "min-length-modifier" "exact int > 0 OR *" "NONE"
    192335                     "NONE" "NONE"
    193336                     ("Minimum field length.  Will pad with the pad character "
    194337                      "(above, default is space) if the field is smaller than "
    195                       "the size.  If given as " (code "*") ", length is read "
     338                      "the size.  If given as " (tt "*") ", length is read "
    196339                      "from the argument list."))
    197340                    ("X" "max-length-modifier" "exact int > 0 OR *" "NONE"
    198341                     "NONE" "NONE"
    199342                     ("Maximum field length.  Trims a field to a maximum "
    200                       "length of the given argument.  If given as " (code "*")
     343                      "length of the given argument.  If given as " (tt "*")
    201344                      ", length is read from the argument list.  If "
    202                       (code "min-length-modifier") " is also given and larger "
    203                       "than " (code "max-length-modifier") ", "
    204                       (code "max-length-modifier") " takes precedence."))
     345                      (tt "min-length-modifier") " is also given and larger "
     346                      "than " (tt "max-length-modifier") ", "
     347                      (tt "max-length-modifier") " takes precedence."))
    205348                    ("C" "count-repeat-modifier" "exact int > 0 OR *" "1"
    206349                     "NONE" "NONE"
    207350                     ("Repetition count modifier.  After applying all other "
    208351                      "modifiers, displays final string count times.  If given "
    209                       "as " (code "*") ", count is read from the argument "
     352                      "as " (tt "*") ", count is read from the argument "
    210353                      "list."))
    211354                    ("D" "format-directive" "(see below)" "NONE" "NONE" "NONE"
     
    213356                      "below gives all format directives and their meanings.")))
    214357                (p "Each valid output directive is given below:")
    215                 ,(table-make
    216                     (code p code code code code p)
     358                (table-spec
     359                    (tt p tt tt tt tt p)
    217360                    ("Directive" "Mnemonic" "Requires" "Forbids" "Ignores"
    218361                     "Args Read" "Action")
    219362                    ("A or a" "display" "NONE" "NONE" "NONE" "1"
    220363                     ("Adds the next argument to the output string via "
    221                       (code "display") "."))
     364                      (tt "display") "."))
    222365                    ("S or s" "write" "NONE" "NONE" "NONE" "1"
    223366                     ("Adds the next argument to the output string via "
    224                       (code "write") "."))
     367                      (tt "write") "."))
    225368                    ("P or p" "pad" "M" "XC" "-@" "0"
    226                      ("Adds " (code "M") " pad-characters (space by default, "
    227                       "or as given by " (code "0") " or " (code "&") ") to the "
    228                       "output string via " (code "display") "."))
     369                     ("Adds " (tt "M") " pad-characters (space by default, "
     370                      "or as given by " (tt "0") " or " (tt "&") ") to the "
     371                      "output string via " (tt "display") "."))
    229372                    ("L or l" "list display" "NONE" "NONE" "NONE" "2"
    230373                     ("First arg must be a list/pair/vector (LPV).  Second arg "
    231374                      "is any object to be used as a separator (SEP).  Each "
    232375                      "element of LPV is added to the output string via "
    233                       (code "display") ", with SEP added between elements."))
     376                      (tt "display") ", with SEP added between elements."))
    234377                    ("W or w" "list write" "NONE" "NONE" "NONE" "2"
    235                      ("Equivalent to " (code "L or l") " above, except that "
    236                       "elements are added via " (code "write") " instead of "
    237                       (code "display") ".  SEP is still added via "
    238                       (code "display") "."))
     378                     ("Equivalent to " (tt "L or l") " above, except that "
     379                      "elements are added via " (tt "write") " instead of "
     380                      (tt "display") ".  SEP is still added via "
     381                      (tt "display") "."))
    239382                    ("B or b" "binary" "NONE" "NONE" "NONE" "1"
    240383                     ("Adds the next argument (an exact integer) to the "
     
    247390                      "numbers are translated to their twos-complement form.  "
    248391                      "The number is padded to a multiple of 3 characters.  "
    249                       "If given as " (code "O") ", a zero or seven (depending "
     392                      "If given as " (tt "O") ", a zero or seven (depending "
    250393                      "on sign) is always prepended to the number."))
    251394                    ("X or x" "hex" "NONE" "NONE" "NONE" "1"
     
    254397                      "Negative numbers are translated to their "
    255398                      "twos-complement form.  The number is padded to a "
    256                       "multiple of 2 characters.  If given as " (code "X")
     399                      "multiple of 2 characters.  If given as " (tt "X")
    257400                      ", the output will be in upper case."))
    258401                    ("H or h" "hex-prefix" "NONE" "NONE" "NONE" "1"
    259                      ("Equivalent to " (code "X or x") " above, except that "
    260                       "a " (code "0x") " is prepended before case checking."))
     402                     ("Equivalent to " (tt "X or x") " above, except that "
     403                      "a " (tt "0x") " is prepended before case checking."))
    261404                    ("D or d" "decimal" "NONE" "NONE" "NONE" "1"
    262405                     ("Adds the next argument (an exact integer) to the "
     
    268411                    ("G or g" "float" "MXC" "NONE" "NONE" "1"
    269412                     ("Adds the next argument (a real number) to the output "
    270                       "string.  The " (code "M") " modifier determines the "
     413                      "string.  The " (tt "M") " modifier determines the "
    271414                      "minimum field length of the integral digits.  The "
    272                       (code "X") " modifier determines the maximum field "
    273                       "length of the integral digits.  The " (code "C")
     415                      (tt "X") " modifier determines the maximum field "
     416                      "length of the integral digits.  The " (tt "C")
    274417                      " modifier determines the minimum number of fractional "
    275418                      "digits."))
    276419                    ("F or f" "subformat" "C" "NONE" "NONE" "1+C"
    277420                     ("Recursive format call.  First argument must be a "
    278                       "valid format-string.  The " (code "C") " modifier "
     421                      "valid format-string.  The " (tt "C") " modifier "
    279422                      "determines the number of extra arguments to take from "
    280423                      "the list for the subformat, and may be zero."))
     
    284427                      "any object to act as separator.  Third argument must be "
    285428                      "a valid format-string.  If the element(s) of LVP are "
    286                       "LVPs, then " (code "eformat") " is applied to the "
     429                      "LVPs, then " (tt "eformat") " is applied to the "
    287430                      "format-string arg with the sub-LVP elements as args.  "
    288                       "Otherwise, " (code "eformat") " is applied to the "
     431                      "Otherwise, " (tt "eformat") " is applied to the "
    289432                      "format-string arg with the LVP arg as a single "
    290433                      "argument."))
     
    294437                      "as subformat directives are separate calls, it may "
    295438                      "occur in subformat strings as well.)  The modifiers are "
    296                       "mapped to the arguments for " (code "wrap-text")
     439                      "mapped to the arguments for " (tt "wrap-text")
    297440                      ", above, in the same order."))
     441                    ("C or c" "colour code" "NONE" "-@0&MXC" "NONE" "1"
     442                     ("Inserts a colour code into text.  The argument must be "
     443                      "a colour code list, as given below.  Note: an explicit "
     444                      "reset must be given at the end of the string, or the "
     445                      "colouration will continue."))
    298446                    ("~" "tilde" "NONE" "-@0&MXC" "NONE" "0"
    299447                     ("Adds a literal tilde to the output string."))))
     
    305453                           "is the output column value after the whitespace "
    306454                           "is processed.  All newline-equivalent sequences"
    307                            "generate explicit newlines (" (code "#\\newline")
     455                           "generate explicit newlines (" (tt "#\\newline")
    308456                           ") rather than the original char(s).")
    309                         ,(table-make
    310                             (code p code p)
     457                        (table-spec
     458                            (tt p tt p)
    311459                            ("Char(s)" "newline-equiv" "Column" "Description")
    312460                            ("#\\space" "N"
     
    331479                             "column"
    332480                             "adds a newline, then pads to <column> spaces")))
     481            (subsection "Colour Code Lists"
     482                (p "Colour codes are given as lists of the form:")
     483                (p (tt "( [ RESET ] [ ATTRIB ... ] [ FCOL [ BCOL ] ] )"))
     484                (p "All arguments are optional.  It is an error for no "
     485                   "arguments to be given.  The semantics for each argument "
     486                   "are given below.  All values are symbols.")
     487                (table-spec
     488                    (tt p)
     489                    ("Argument" "Description")
     490                    ("RESET"
     491                     ("Specifies whether to add a colour reset before the new "
     492                      "colour code.  If " (tt "RESET") " is set to "
     493                      (tt "no-reset") " or " (tt "noreset") ", a reset "
     494                      "is not added.  If " (tt "RESET") " is set to "
     495                      (tt "reset") " or " (tt "default") ", then a colour "
     496                      "reset is added.  As resets are done by default, "
     497                      "specifying " (tt "reset") " is generally only "
     498                      "necessary at the end of a string."))
     499                    ("ATTRIB"
     500                     ("Specifies colour/text attributes.  Valid attributes are:"
     501                      (inline-table-spec
     502                          (tt p)
     503                          ("Attribute" "Description")
     504                          ("bold"
     505                           "Bold colours.")
     506                          ("underline"
     507                           "Underline text (may not work on all terminals).")
     508                          ("blink"
     509                           "Blinking text (usually equivalent to bold).")
     510                          ("inverse"
     511                           "Invert background and foreground colours.")
     512                          ("invis or hide"
     513                           "Hide this text (will not work on most terminals).")
     514                          ("standout"
     515                           ("Equivalent to " (tt "bold") " and "
     516                            (tt "inverse") " together."))
     517                          ("normal"
     518                           ("Reverses the effect of " (tt "bold") "."))
     519                          ("no-underline"
     520                           ("Reverses the effect of " (tt "underline") "."))
     521                          ("steady"
     522                           ("Reverses the effect of " (tt "blink") "."))
     523                          ("positive"
     524                           ("Reverses the effect of " (tt "inverse") "."))
     525                          ("visible"
     526                           ("Reverses the effect of " (tt "invis") ".")))))
     527                    ("FCOL"
     528                     ("Sets the foreground colour, according to the list "
     529                      "given below."))
     530                    ("BCOL"
     531                     ("Sets the background colour, according to the list "
     532                      "given below.")))
     533                (p "Colour values may be:"
     534                   (ul (li (tt "black"))
     535                       (li (tt "red"))
     536                       (li (tt "green"))
     537                       (li (tt "yellow"))
     538                       (li (tt "blue"))
     539                       (li (tt "magenta"))
     540                       (li (tt "cyan"))
     541                       (li (tt "white"))
     542                       (li (tt "cdefault") " (default foreground/background "
     543                                           "colour for the terminal)"))))
    333544
    334545            (subsection "Utility Procedures"
    335546                (p "These are some (hopefully useful) utility procedures built "
    336                    "from the " (code "eformat") " functionality.")
     547                   "from the " (tt "eformat") " functionality.")
    337548                (group
    338549                    (procedure
    339550                        "(char->num DIGIT [(ORIG 0) [(OP +)]])"
    340                         (p "Applies " (code "OP") " to the numeric "
     551                        (p "Applies " (tt "OP") " to the numeric "
    341552                           "representation of DIGIT (a char in the range #\\0 "
    342                            "to #\\9) and (10 * " (code "ORIG") ").  The "
    343                            "default behaviour (if " (code "OP") " is not "
     553                           "to #\\9) and (10 * " (tt "ORIG") ").  The "
     554                           "default behaviour (if " (tt "OP") " is not "
    344555                           "given) allows a sequence of character digits to "
    345556                           "be translated into their numeric equivalent, "
     
    349560                        (p "Creates nicely-formatted error messages and "
    350561                           "signals an error.  Equivalent to ")
    351                         (code "(apply error (string-append \"(\" CALLING-PROC "
     562                        (tt "(apply error (string-append \"(\" CALLING-PROC "
    352563                              "\")  \" (eformat #f FMTSTR [ARG ...])) "
    353564                              "RETURN-ARGS)")
    354                         (p "except that " (code "CALLING-PROC") " may be an "
     565                        (p "except that " (tt "CALLING-PROC") " may be an "
    355566                           "object other than a string."))))
    356567
     
    363574
    364575
    365 (eggdoc->html doc)
     576(eggdoc->html doc (elf-eggdoc-ss doc))
  • release/3/eformat/eformat.scm

    r8233 r9151  
    66;;;; dialect:   r5rs
    77;;;; requires:  srfi-1, srfi-6, srfi-13, srfi-14, srfi-23, srfi-60
    8 ;;;; version:   3.0
     8;;;; version:   3.1
    99;;;; purpose:   extended formatting procedures
    1010;;;;
    11 ;;;; history:   3.0  First public release
     11;;;; history:   3.1  20080303 Added C (colour) directive, fixed wrap for
     12;;;                           strings with colour escapes
     13;;;;            3.0  20080206 First public release
    1214;;;;            2.2  Removed C directive
    1315;;;;                 Added & (pad char from args) modifier
     
    4749        (always-bound
    4850            efmt:output-symbols
     51            efmt:colour-escape
    4952            )
    5053        (bound-to-procedure
     
    6467            efmt:process-basic
    6568            efmt:process-list
     69            efmt:process-colour
    6670            efmt:process-intconv
    6771            efmt:process-float
     
    223227                            ((-6)
    224228                                (cons (cons -1 (+ 1 (* 8 (cdar r)))) (cdr r)))
     229                            ((-7)
     230                                (cons (cons -1 1) (cdr r)))
    225231                            (else
    226232                                (cons (cons -1 1) r))))
     
    245251                            ((-3)
    246252                                (cons (cons -2 (cdar r)) (cdr r)))
     253                            ((-7)
     254                                (cons (cons -2 1) (cdr r)))
    247255                            (else
    248256                                (cons (cons -2 1) r))))
     
    265273                            ((-2 -3)
    266274                                (cons (cons -3 (+ 1 (cdar r))) (cdr r)))
     275                            ((-7)
     276                                (cons (cons -3 1) (cdr r)))
    267277                            (else
    268278                                (cons (cons -3 1) r))))
     
    276286                                (cons (cons -5 1)
    277287                                      (cons (cons -1 (* 8 (cdar r))) (cdr r))))
     288                            ((-7)
     289                                (cons (cons -5 1) (cdr r)))
    278290                            (else
    279291                                (cons (cons -5 1) r))))
     
    287299                            ((-6)
    288300                                (cons (cons -6 (+ 1 (cdar r))) (cdr r)))
     301                            ((-7)
     302                                (cons (cons -4 1) (cdr r)))
    289303                            (else
    290304                                (cons (cons -4 1) r))))
     305                    ((27)
     306                        (case (caar r)
     307                            ((-3)
     308                                (cons (list -7 27)
     309                                      (cons (cons -2 (cdar r)) (cdr r))))
     310                            ((-6)
     311                                (cons (list -7 27)
     312                                      (cons (cons -1 (* 8 (cdar r))) (cdr r))))
     313                            ((-7)
     314                                (cons (cons -7 (string c)) (cdr r)))
     315                            ((-8)
     316                                (cons (cons -7
     317                                            (string-append (cdar r) (string c)))
     318                                      (cdr r)))
     319                            (else
     320                                (cons (list -7 27) r))))
    291321                    (else
    292322                        (case (caar r)
    293                             ((-1 -2 -4 -5)
     323                            ((-1 -2 -4 -5 -8)
    294324                                (cons (cons 1 (string c)) r))
    295325                            ((-3)
     
    299329                                (cons (cons 1 (string c))
    300330                                      (cons (cons -1 (* 8 (cdar r))) (cdr r))))
     331                            ((-7)
     332                                (cons
     333                                    (cons
     334                                        (if (char=? #\m c)
     335                                            -8
     336                                            -7)
     337                                        (string-append (cdar r) (string c)))
     338                                    (cdr r)))
    301339                            (else
    302340                                (cons (cons (+ 1 (caar r))
     
    312350                ((13)
    313351                    (list (cons -3 1)))
     352                ((27)
     353                    (list (list -7 27)))
    314354                (else
    315355                    (list (cons 1 (substring str 0 1)))))
     
    375415                                           (make-string c #\space)
    376416                                           (loop (cdr s) c p e #f))))
     417                    ((-8)
     418                        (string-append (cdar s) (loop (cdr s) c p e w)))
    377419                    (else
    378420                        (if (> (caar s) e)
     
    422464        #\P #\p   ; pad
    423465        #\R #\r   ; wrap output
     466        #\C #\c   ; colour handling
    424467    ))
     468
     469
     470;; constant: efmt:colour-escape
     471;; string prepended for colours
     472(define-constant efmt:colour-escape
     473    (string (integer->char 27) #\[))
    425474
    426475
     
    659708
    660709
     710;; (efmt:process-colour output-port format-arg position colour-list process-arg)
     711;; handle colour output
     712(define-inline (efmt:process-colour o v ps c pa)
     713    (letrec
     714        ((colr
     715            (lambda (l)
     716                (case (car l)
     717                    ((noreset no-reset)    (cola (cdr l) '()))
     718                    ((reset default)       (cola (cdr l) '(0)))
     719                    (else                  (cola l '(0))))))
     720         (cola
     721            (lambda (l r)
     722                (if (null? l)
     723                    (cole r)
     724                    (case (car l)
     725                        ((bold bright)     (cola (cdr l) (cons 1 r)))
     726                        ((underline)       (cola (cdr l) (cons 4 r)))
     727                        ((blink)           (cola (cdr l) (cons 5 r)))
     728                        ((inverse)         (cola (cdr l) (cons 7 r)))
     729                        ((invis hide)      (cola (cdr l) (cons 8 r)))
     730                        ((standout)        (cola (cdr l) (cons 1 (cons 7 r))))
     731                        ((normal)          (cola (cdr l) (cons 22 r)))
     732                        ((no-underline)    (cola (cdr l) (cons 24 r)))
     733                        ((steady)          (cola (cdr l) (cons 25 r)))
     734                        ((positive)        (cola (cdr l) (cons 27 r)))
     735                        ((visible)         (cola (cdr l) (cons 28 r)))
     736                        (else              (colf l r))))))
     737         (colf
     738             (lambda (l r)
     739                 (if (null? l)
     740                     (cole r)
     741                     (case (car l)
     742                         ((black)       (colb (cdr l) (cons 30 r)))
     743                         ((red)         (colb (cdr l) (cons 31 r)))
     744                         ((green)       (colb (cdr l) (cons 32 r)))
     745                         ((yellow)      (colb (cdr l) (cons 33 r)))
     746                         ((blue)        (colb (cdr l) (cons 34 r)))
     747                         ((magenta)     (colb (cdr l) (cons 35 r)))
     748                         ((cyan)        (colb (cdr l) (cons 36 r)))
     749                         ((white)       (colb (cdr l) (cons 37 r)))
     750                         ((cdefault)    (colb (cdr l) (cons 39 r)))
     751                         (else          (efmt:err-type o pa "colour" c
     752                                                       "colour list"))))))
     753         (colb
     754             (lambda (l r)
     755                 (if (null? l)
     756                     (cole r)
     757                     (if (null? (cdr l))
     758                         (case (car l)
     759                             ((black)       (cole (cons 40 r)))
     760                             ((red)         (cole (cons 41 r)))
     761                             ((green)       (cole (cons 42 r)))
     762                             ((yellow)      (cole (cons 43 r)))
     763                             ((blue)        (cole (cons 44 r)))
     764                             ((magenta)     (cole (cons 45 r)))
     765                             ((cyan)        (cole (cons 46 r)))
     766                             ((white)       (cole (cons 47 r)))
     767                             ((cdefault)    (cole (cons 49 r)))
     768                             (else          (efmt:err-type o pa "colour" c
     769                                                           "colour list")))
     770                         (efmt:err-type o pa "colour" c "colour list")))))
     771         (cole
     772             (lambda (r)
     773                 (let ((t   (sort (delete-duplicates r) <)))
     774                     (and (null? t)
     775                          (efmt:err-spec o ps))
     776                     (display
     777                         (string-append efmt:colour-escape
     778                                        (string-intersperse
     779                                            (map number->string t)
     780                                            ";")
     781                                        "m")
     782                         o)
     783                     o))))
     784            (if (and (list? c) (not (null? c)) (every symbol? c))
     785                (colr c)
     786                (efmt:err-spec o ps))))
     787
     788
    661789;; (efmt:process-intconv output-port format-arg position number)
    662790;; handle integer conversions (~B ~b ~O ~o ~X ~x ~H ~h ~D ~d ~I ~i)
     
    775903                  (or (> la 0)
    776904                      (efmt:err-arg o ps (+ 1 pa) pa))
     905                  (and (char-ci=? #\c (vector-ref (car fl) 0))
     906                       (efmt:err-spec o ps))
    777907                  (if (char? (car al))
    778908                      (vector-set! (car fl) 2 (list (car al)))
     
    830960                          (loop
    831961                              (efmt:process-intconv o (car fl) ps (car al))
     962                              #f wc is s? (cdr fl)
     963                              (+ ps (vector-ref (car fl) 6))
     964                              (+ 1 pa) (cdr al) (- la 1)))
     965                      ((#\C #\c)
     966                          (or (> la 0)
     967                              (efmt:err-arg o ps (+ 1 pa) pa))
     968                          (and (or (not (= 0 (vector-ref (car fl) 1)))
     969                                   (not (char=? #\space
     970                                                (car (vector-ref (car fl) 2))))
     971                                   (vector-ref (car fl) 3)
     972                                   (vector-ref (car fl) 4)
     973                                   (vector-ref (car fl) 5))
     974                               (efmt:err-spec o ps))
     975                          (loop
     976                              (efmt:process-colour o (car fl) ps (car al) pa)
    832977                              #f wc is s? (cdr fl)
    833978                              (+ ps (vector-ref (car fl) 6))
  • release/3/eformat/eformat.setup

    r8233 r9151  
    2424    'eformat
    2525    '("eformat.so" "eformat.exports" "eformat.html")
    26     '((version        3.0)
     26    '((version        3.1)
    2727      (documentation  "eformat.html")
    2828      (exports        "eformat.exports")))
Note: See TracChangeset for help on using the changeset viewer.