;;; -*- Mode: Common-Lisp; Package: SYS; Base: 10.; Patch-File: T -*- ;;; Reason: Fixed global:format and Format to handle synonym-stream. [10268] ;;; RESTRICTED RIGHTS LEGEND ;;; ;;; Use, duplication, or disclosure by the Government is subject to ;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in ;;; Technical Data and Computer Software clause at 52.227-7013. ;;; ;;; TEXAS INSTRUMENTS INCORPORATED ;;; P.O. BOX 2909, M/S 2151 ;;; AUSTIN, TEXAS 78769 ;;; ;;; Copyright (C) 1989 Texas Instruments Incorporated. ;;; All rights reserved. ;;; Patch file for SYSTEM version 6.19 ;;; Written 10/04/89 13:26:31 by BERGER, ;;; while running on ARIES from band LODX ;;; With SYSTEM 6.17, VIRTUAL-MEMORY 6.2, EH 6.5, MAKE-SYSTEM 6.1, MICRONET 6.0, LOCAL-FILE 6.1, ;;; BASIC-PATHNAME 6.1, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.2, NETWORK-NAMESPACE 6.0, ;;; DISK-IO 6.1, DISK-LABEL 6.0, BASIC-FILE 6.3, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0, ;;; COMPILER 6.12, TV 6.15, DATALINK 6.0, CHAOSNET 6.1, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.1, ;;; SYSLOG 6.1, STREAMER-TAPE 6.4, UCL 6.0, INPUT-EDITOR 6.0, METER 6.1, ZWEI 6.5, ;;; DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.1, DATALINK-DISPLAYS 6.0, ;;; FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.3, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.1, ;;; IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.2, TELNET 6.0, VT100 6.0, ;;; NAMESPACE-EDITOR 6.0, PROFILE 6.1, VISIDOC 6.4, TI-CLOS 6.24, CLEH 6.5, IP 3.50, ;;; Experimental CLX 6.3, CLUE 6.17, X11M 6.14, Experimental BUG 11.15, VISIDOC-SERVER 6.1, ;;; microcode 429, Band Name: Rel 6.0 + SLE 8/30 #!C ; From file FORMAT.LISP#> KERNEL; SYS: #10R FORMAT#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "FORMAT")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: KERNEL; FORMAT.#" (defun global:format (stream ctl-string &rest args) "Format arguments according to a control string and print to a stream. (If the stream is T, *STANDARD-OUTPUT* is used; if NIL, a string is returned containing the formatted text.) The control string is copied to the stream, but ~ indicates special formatting commands. Note commands X, E, F, G are incompatible between this FORMAT and Common Lisp FORMAT. ~D ~mincol,padchar,commacharD Print number as a decimal integer. ~:D Print the comma character every three digits. ~@D Always print the sign. ~:@D Both. ~O Analogous to ~D, but prints in octal. ~B Analogous to ~D, but prints in binary. ~F ~F Print a floating point number. ~nF Round it to n digits. ~E ~E Print a floating-point number in exponential notation. ~nE Round to n digits. ~$ ~w,x,y,z$ prints a floating-point number with exactly w (default 2) digits to right of decimal, at least x (default 1) to left of decimal, right-justified in field y wide padded with z. @ print + sign. : sign to left of padding. ~R ~R Print number as an English cardinal number. ~:R English ordinal number. ~@R Roman numeral. ~:@R Old Roman numeral. ~nR Print number in radix n. Thus ~8R = ~O, and ~10R = ~D. Extra parameters are as for ~D (~n,mincol,padchar,commacharR). ~A Ascii output (PRINC). Good for printing strings. ~mincol,colinc,minpad,padcharA. ~@A Right-justify the string. ~:A Make NIL print as (). ~:@A Both. ~S Analogous to ~A, but uses PRIN1, not PRINC. ~C Print a character. Mouse characters print in standard format. ~C Actual character, preceded by \"h-\", \"s-\", \"m-\" or \"c-\" if necessary. ~:C Format effectors print as names. Names of control bits (\"Control-\") precede. ~@C Prints the character in READ format, using #/ or #. ~:@C Like ~:C, but names match keycaps and SYMBOL & SYMBOL-SHIFT notations are included. ~* Ignore an argument. ~n* Ignore n arguments. ~:n* Back up n arguments (default 1). ~G Goto. ~nG goes to the nth argument (0-origin). Operates relative to ~{...~} lists. ~% Insert a newline. ~n% Insert n newlines. ~X Insert a space. ~nX Insert n spaces. ~~ Insert a tilde. ~n~ Insert n tildes. ~| Insert a form feed. ~n| Insert n form feeds. ~:| Do :CLEAR-SCREEN if the stream supports it, otherwise insert a form feed. ~:n| Similar. ~ Ignore a CR and following whitespace in the control string. ~: Ignore the CR, retain the whitespace. ~@ Retain the CR, ignore the whitespace. ~& Do a :FRESH-LINE. ~n& Do a FRESH-LINE, then insert n-1 newlines. ~M The argument is printed like ~A and when printed on a stream that includes TV:BASIC-MOUSE-SENSITIVE-ITEMS, the item printed will be made mouse-sensitive. The item type defaults to the first item type in the window's ITEM-TYPE-ALIST. ~nM can be used to set the item type to the nTH item in ITEM-TYPE-ALIST, or you can specify the item-type with a symbol passed through ~VM. ~:M is a recursive call where the argument is a list containing the item value format-string and arguments. This can be used to make a sentence mouse sensitive as well as individual words within the sentence. ~^ Terminate processing if no more arguments. Within ~{...~}, just terminate the loop. ~n; Terminate if n is zero. ~n,m; Terminate if n=m. ~n,m,p; Terminate if nmp. ~:^ When within ~:{...~}, ~^ terminates this iteration. Use ~:^ to exit the loop. ~T ~mincol,colincT Tab to column mincol+p*colinc, for the smallest integer p possible. ~mincol,colinc:T Same, but tabs in TV pixels rather than characters. ~n@T Insert n spaces. ~n,colinc@T Insert n spaces, then move 0 or more up to multiple of colinc. ~Q Apply next argument to no arguments. ~a,b,c,...,zQ Apply next argument to parameters a,b,c,...z. In (Q ...) form, apply argument to unevaled parameters. ~P Pluralize. Insert \"s\", unless argument is 1. ~:P Use previous argument, not next one (i.e. do ~:* first). ~@P Insert \"y\" if argument is 1, otherwise insert \"ies\". ~:@P Both. ~( ~(...~) Force lower case for the output generated within. ~:(...~) Similar but capitalize each word. ~@(...~) Similar but capitalize the first word. ~:@(...~) Similar but force all upper case. ~? Indirect. Uses up two args; first is a format string, second is args for it. ~< ~mincol,colinc,minpad,padchar Do formatting for all formatting strings strj; then output all strings with padding between them at the ~; points. Each padding point must have at least minpad padding characters. Subject to that, the total width must be at least mincol, and must be mincol+p*colinc for some p. If str0 is followed by ~:; instead of ~;, then str0 is not normally output, and the ~:; is not a padding point. Instead, after the total width has been determined, if the text will not fit into the current line of output, then str0 is output before outputting the rest. (Doesn't work when producing a string.) An argument n (~:n;) means that the text plus n more columns must fit to avoid outputting str0. A second argument m (~n,m:;) provides the line width to use instead of the stream's width. ~:< Also have a padding point at the left. Hence ~n: right-justifies x in n columns. ~@< Also have a padding point at the right. ~:@< Both. Hence ~n:@ centers x. ~[ ~[str0~;str1~;...~;strn~] Select. Argument selects one clause to do. If argument is not between 0 and n inclusive, then no alternative is performed. If a parameter is given, then use the parameter instead of an argument. (The only useful one is \"#\".) If the last string is preceded by ~:;, it is an \"else\" clause, and is processed if no other string is selected. One can also tag the clauses explicitly by giving arguments to ~;. In this case the first string must be null, and arguments to ~; tag the following string. The argument is matched against the list of parameters for each ~;. One can get ranges of tags by using ~:;. Pairs of parameters serve as inclusive range limits. A ~:; with no parameters is still an \"else\" clause. Example: ~[~'+,'-,'*,'//;operator~:'A,'Z,'a,'z;letter~:'0,'9;digit~:;other~] will produce \"operator\", \"letter\", \"digit\", or \"other\" as appropriate. ~:[iffalse~;iftrue~] The argument selects the first clause if nil, the second if non-nil. ~@[str~] If the argument is non-nil, then it is not swallowed, and str is processed. Otherwise, the nil is swallowed and str is ignored. Thus ~@[~S~] will PRIN1 a non-null thing. ~{ ~{str~} Use str as a format string for each element in the argument. More generally, the argument is a list of things to be used as successive arguments, and str is used repeatedly as a format string until the arguments are exhausted (or ~^ is used). Within the iteration the commands ~* and ~G move among the iteration arguments, not among all the arguments given to FORMAT. ~n{str~} repeats the string at most n times. Terminating with ~:} forces str to be processed at least once. ~:{str} The argument is a list of lists, and each repetition sees one sublist. ~@{str} All remaining arguments are used as the list. ~:@{str} Each remaining argument is a list. If the str within a ~{ is empty, then an argument (which must be a string) is used. This argument precedes any that are iterated over as loop arguments. ~ ~str~ Successive lines within str are indented to align themselves with the column at which str began. ie all text within str will lie to the right of the beginning of str In place of a numeric parameter, one may use V, which uses an argument to supply the number; or one may use #, which represents the number of arguments remaining to be processed; or one may use 'x, which uses the ascii value of x (good for pad characters). The control string may actually be a list of intermixed strings and sublists. In that case, the strings are printed literally. The first atom in a sublist should be the name of a command, and remaining elements are parameters." (cond ((null stream) ;;; Only bind FORMAT-STRING if STREAM is NIL. This avoids lossage if ;;; FORMAT with a first arg of NIL calls FORMAT recursively (e.g. if ;;; printing a named structure). (bind (locf format-string) (get-format-string))) ((stringp stream) (bind (locf format-string) stream))) (let ((*standard-output* (cond ((or (null stream) (stringp stream)) 'format-string-stream) ((eq stream t) *standard-output*) ((si:io-stream-p stream) (si:follow-syn-stream stream)) (t stream) )) (format-ctl-one-arg-prop nil) (format-arglist args) (loop-arglist nil)) (catch '|FORMAT-:^-POINT| (catch 'format-^-point (cond ((stringp ctl-string) (format-ctl-string args ctl-string)) ((errorp ctl-string) (princ ctl-string)) ((symbolp ctl-string) (format-ctl-string args (symbol-name ctl-string))) (t (do ((ctl-string ctl-string (cdr ctl-string))) ((null ctl-string)) (if (stringp (car ctl-string)) (funcall *standard-output* :string-out (car ctl-string)) (setq args (format-ctl-list args (car ctl-string)))))))))) ;; Copy returned string out of temporary area and reclaim (cond ((null stream) (prog1 (subseq (the string format-string) 0.) (return-format-string format-string))) (t nil))) (defun format (stream ctl-string &rest args) "Format arguments according to a control string and print to a stream; Common Lisp version. (If the stream is T, *STANDARD-OUTPUT* is used; if NIL, a string is returned containing the formatted text.) The control string is copied to the stream, but ~ indicates special formatting commands. Note commands X, E, F, G are incompatible between Common Lisp FORMAT and regular FORMAT. ~D ~mincol,padchar,commacharD Print number as a decimal integer. ~:D Print the comma character every three digits. ~@D Always print the sign. ~:@D Both. ~O Analogous to ~D, but prints in octal. ~X Analogous to ~D, but prints in hex. ~B Analogous to ~D, but prints in binary. ~F ~w,d,s,overflowchar,padcharF Print float in nonexponential notation. Multiplies by 10^s before printing if s is specified. Prints in w positions, with d digits after the decimal point. Pads on left with padchar if nec. If number doesn't fit in w positions, and overflowchar is specified, just fills the w positions with that character. ~E ~w,d,e,s,overflowchar,padchar,exptcharE Print float in exponential notation. Prints in w positions, with e digits of exponent. If s (default is 1) is positive, prints s digits before point, d-s+1 after. If s is zero, prints d digits after the point, and a zero before if there's room. If s is negative, prints d digits after the point, of which the first -s are zeros. If exptchar is specified, it is used to delimit the exponent (instead of \"e\" or whatever.) If overflowchar is specified, then if number doesn't fit in specified width, or if exponent doesn't fit in e positions, field is filled with overflowchar instead. ~G Like ~E, but if number fits without exponent, prints without one. ~$ ~w,x,y,z$ prints a floating-point number with exactly w (default 2) digits to right of decimal, at least x (default 1) to left of decimal, right-justified in field y wide padded with z. @ print + sign. : sign to left of padding. ~R ~R Print number as an English cardinal number. ~:R English ordinal number. ~@R Roman numeral. ~:@R Old Roman numeral. ~nR Print number in radix n. Thus ~8R = ~O, and ~10R = ~D. Extra parameters are as for ~D (~n,mincol,padchar,commacharR). ~A Ascii output (PRINC). Good for printing strings. ~mincol,colinc,minpad,padcharA. ~@A Right-justify the string. ~:A Make NIL print as (). ~:@A Both. ~S Analogous to ~A, but uses PRIN1, not PRINC. ~C Print a character. Mouse characters print in standard format. ~C Actual character, preceded by \"h-\", \"s-\", \"m-\" or \"c-\" if necessary. ~:C Format effectors print as names. Names of control bits (\"Control-\") precede. ~@C Prints the character in READ format, using #/ or #. ~:@C Like ~:C, but names match keycaps and SYMBOL & SYMBOL-SHIFT notations are included. ~* Ignore an argument. ~n* Ignore n arguments. ~:n* Back up n arguments (default 1). ~n@* goes to the nth argument (0-origin). Operates relative to ~{...~} lists. ~% Insert a newline. ~n% Insert n newlines. ~~ Insert a tilde. ~n~ Insert n tildes. ~| Insert a form feed. ~n| Insert n form feeds. ~:| Do :CLEAR-SCREEN if the stream supports it, otherwise insert a form feed. ~:n| Similar. ~ Ignore a CR and following whitespace in the control string. ~: Ignore the CR, retain the whitespace. ~@ Retain the CR, ignore the whitespace. ~& Do a :FRESH-LINE. ~n& Do a FRESH-LINE, then insert n-1 newlines. ~M The argument is printed like ~A and when printed on a stream that includes TV:BASIC-MOUSE-SENSITIVE-ITEMS, the item printed will be made mouse-sensitive. The item type defaults to the first item type in the window's ITEM-TYPE-ALIST. ~nM can be used to set the item type to the nTH item in ITEM-TYPE-ALIST, or you can specify the item-type with a symbol passed through ~VM. ~:M is a recursive call where the argument is a list containing the item value format-string and arguments. This can be used to make a sentence mouse sensitive as well as individual words within the sentence. ~^ Terminate processing if no more arguments. Within ~{...~}, just terminate the loop. ~n; Terminate if n is zero. ~n,m; Terminate if n=m. ~n,m,p; Terminate if nmp. ~:^ When within ~:{...~}, ~^ terminates this iteration. Use ~:^ to exit the loop. ~T ~mincol,colincT Tab to column mincol+p*colinc, for the smallest possible integer p > 0. ~mincol,colinc:T Same, but tabs in TV pixels rather than characters. ~n@T Insert n spaces. ~n,colinc@T Insert n spaces, then move 0 or more up to multiple of colinc. ~Q Apply next argument to no arguments. ~a,b,c,...,zQ Apply next argument to parameters a,b,c,...z. In (Q ...) form, apply argument to unevaled parameters. ~P Pluralize. Insert \"s\", unless argument is 1. ~:P Use previous argument, not next one (i.e. do ~:* first). ~@P Insert \"y\" if argument is 1, otherwise insert \"ies\". ~:@P Both. ~( ~(...~) Force lower case for the output generated within. ~:(...~) Similar but capitalize each word. ~@(...~) Similar but capitalize the first word. ~:@(...~) Similar but force all upper case. ~? Indirect. Uses up two args; first is a format string, second is args for it. ~< ~mincol,colinc,minpad,padchar Do formatting for all formatting strings strj; then output all strings with padding between them at the ~; points. Each padding point must have at least minpad padding characters. Subject to that, the total width must be at least mincol, and must be mincol+p*colinc for some p. If str0 is followed by ~:; instead of ~;, then str0 is not normally output, and the ~:; is not a padding point. Instead, after the total width has been determined, if the text will not fit into the current line of output, then str0 is output before outputting the rest. (Doesn't work when producing a string.) An argument n (~:n;) means that the text plus n more columns must fit to avoid outputting str0. A second argument m (~n,m:;) provides the line width to use instead of the stream's width. ~:< Also have a padding point at the left. Hence ~n: right-justifies x in n columns. ~@< Also have a padding point at the right. ~:@< Both. Hence ~n:@ centers x. ~[ ~[str0~;str1~;...~;strn~] Select. Argument selects one clause to do. If argument is not between 0 and n inclusive, then no alternative is performed. If a parameter is given, then use the parameter instead of an argument. (The only useful one is \"#\".) If the last string is preceded by ~:;, it is an \"else\" clause, and is processed if no other string is selected. One can also tag the clauses explicitly by giving arguments to ~;. In this case the first string must be null, and arguments to ~; tag the following string. The argument is matched against the list of parameters for each ~;. One can get ranges of tags by using ~:;. Pairs of parameters serve as inclusive range limits. A ~:; with no parameters is still an \"else\" clause. Example: ~[~'+,'-,'*,'/;operator~:'A,'Z,'a,'z;letter~:'0,'9;digit~:;other~] will produce \"operator\", \"letter\", \"digit\", or \"other\" as appropriate. ~:[iffalse~;iftrue~] The argument selects the first clause if nil, the second if non-nil. ~@[str~] If the argument is non-nil, then it is not swallowed, and str is processed. Otherwise, the nil is swallowed and str is ignored. Thus ~@[~S~] will PRIN1 a non-null thing. ~{ ~{str~} Use str as a format string for each element in the argument. More generally, the argument is a list of things to be used as successive arguments, and str is used repeatedly as a format string until the arguments are exhausted (or ~^ is used). Within the iteration the commands ~* and ~G move among the iteration arguments, not among all the arguments given to FORMAT. ~n{str~} repeats the string at most n times. Terminating with ~:} forces str to be processed at least once. ~:{str} The argument is a list of lists, and each repetition sees one sublist. ~@{str} All remaining arguments are used as the list. ~:@{str} Each remaining argument is a list. If the str within a ~{ is empty, then an argument (which must be a string) is used. This argument precedes any that are iterated over as loop arguments. ~ ~str~ Successive lines within str are indented to align themselves with the column at which str began. ie all text within str will lie to the right of the beginning of str In place of a numeric parameter, one may use V, which uses an argument to supply the number; or one may use #, which represents the number of arguments remaining to be processed; or one may use 'x, which uses the ascii value of x (good for pad characters). The control string may actually be a list of intermixed strings and sublists. In that case, the strings are printed literally. The first atom in a sublist should be the name of a command, and remaining elements are parameters." (cond ((null stream) ;;; Only bind FORMAT-STRING if STREAM is NIL. This avoids lossage if ;;; FORMAT with a first arg of NIL calls FORMAT recursively (e.g. if ;;; printing a named structure). (bind (locf format-string) (get-format-string))) ((stringp stream) (bind (locf format-string) stream))) (let ((*standard-output* (cond ((or (null stream) (stringp stream)) 'format-string-stream) ((eq stream t) *standard-output*) ((si:io-stream-p stream) (si:follow-syn-stream stream)) ; DAB 10-04-89 (t stream))) (format-ctl-one-arg-prop 'format-ctl-common-lisp-one-arg) (format-arglist args) (loop-arglist nil)) (catch '|FORMAT-:^-POINT| (catch 'format-^-point (cond ((stringp ctl-string) (format-ctl-string args ctl-string)) ((errorp ctl-string) (princ ctl-string)) ((symbolp ctl-string) (format-ctl-string args (symbol-name ctl-string))) (t (do ((ctl-string ctl-string (cdr ctl-string))) ((null ctl-string)) (if (stringp (car ctl-string)) (funcall *standard-output* :string-out (car ctl-string)) (setq args (format-ctl-list args (car ctl-string)))))))))) ;; Copy returned string out of temporary area and reclaim (cond ((null stream) (prog1 (subseq (the string format-string) 0.) (return-format-string format-string))) (t nil))) ))