(FILECREATED "21-Jan-87 16:06:01" {PHYLUM}<LANNING>LISP>USERS>LAFITE-INDENT.;7 18679
changes to: (VARS LAFITE-INDENTCOMS) (FNS TEDIT-INDENT-BREAK-LONG-LINES TEDIT-INDENT-SELECTION
\TEDIT-INDENT-SEPERATE-LINES)
previous date: "26-Sep-86 19:44:02" {PHYLUM}<LANNING>LISP>USERS>LAFITE-INDENT.;6)
(* Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LAFITE-INDENTCOMS)
(RPAQQ LAFITE-INDENTCOMS ((* * LAFITE-INDENT defines a function that will indent the current
selection.) (FNS TEDIT-INDENT-ADD-INDENTATION TEDIT-INDENT-BREAK-LINE TEDIT-INDENT-BREAK-LONG-LINES
TEDIT-INDENT-FIND-BREAKPOINT TEDIT-INDENT-REPLACE-SELECTION TEDIT-INDENT-SELECTION
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS TEDIT-INDENT-SEPERATE-PARAGRAPHS TEDIT-INDENT-SET-INDENT
TEDIT-INDENT-STRIP-INDENTATION TEDIT-MAKE-LINES-EXPLICIT TEDIT-OPEN-LINE TEDIT-REMOVE-INDENT
\TEDIT-INDENT-COUNT-SPACES \TEDIT-INDENT-FIND-PARAGRAPH-END \TEDIT-INDENT-SEPERATE-LINES
\TEDIT-INDENT-SEPERATE-PARAGRAPHS) (INITVARS (*TEDIT-INDENT-STRING* (ALLOCSTRING 4 " ")) (
*TEDIT-INDENT-LINE-LENGTH* 72)) (CONSTANTS (*eol-string* (CHARACTER (CHARCODE EOL)))) (GLOBALVARS
*TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH*) (P (OR (GETD (QUOTE TEDIT)) (FILESLOAD TEDIT)) (
TEDIT.REMOVE.MENUITEM TEDIT.DEFAULT.MENU (QUOTE Indent)) (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (QUOTE
(Indent (QUOTE TEDIT-INDENT-SELECTION) "Indent the current selection" (SUBITEMS (Indent (QUOTE
TEDIT-INDENT-SELECTION) "Indent the current selection") ("Indent & keep lines" (QUOTE
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS)
"Indent the current selection, keeping existing line breaks") ("Set indent" (QUOTE
TEDIT-INDENT-SET-INDENT) "Set the indent string to a new value") (Unindent (QUOTE TEDIT-REMOVE-INDENT)
"Remove one level of indentation from the current selection") ("Open line" (QUOTE TEDIT-OPEN-LINE)
"Open a blank line at the current position") ("Insert <RETURN>s" (QUOTE TEDIT-MAKE-LINES-EXPLICIT)
"Insert real <RETURN>s at the end of each line in the current selection") ("Break long lines" (QUOTE
TEDIT-INDENT-BREAK-LONG-LINES) "Break long lines by inserting explicit <RETURN>'s"))))))))
(* * LAFITE-INDENT defines a function that will indent the current selection.)
(DEFINEQ
(TEDIT-INDENT-ADD-INDENTATION
[LAMBDA (paragraph indent-string right-margin hanging-indent)
(* smL "15-Sep-86 16:47")
(* * Return a string based on the given string but with the indentation changed by the given amount.
-
Break lines at or before the given right-margin. -
If hanging-indent is given, then the first line is already indented by that amount.)
(if [for i from 1 to (NCHARS paragraph) always (MEMB (NTHCHARCODE paragraph i)
(CONSTANT
(LIST (CHARCODE SPACE)
(CHARCODE EOL]
then paragraph
else (LET* [[old-indent (\TEDIT-INDENT-COUNT-SPACES paragraph
(ADD1 (OR (STRPOS *eol-string*
paragraph)
(NCHARS paragraph]
(new-indent (PLUS (NCHARS indent-string)
old-indent))
(new-indent-string (CONCAT indent-string (ALLOCSTRING old-indent " "]
(CONCATLIST (for string on (TEDIT-INDENT-BREAK-LINE
(CONCAT (if (NUMBERP hanging-indent)
then ""
else indent-string)
(TEDIT-INDENT-STRIP-INDENTATION
paragraph))
(DIFFERENCE right-margin
(PLUS new-indent
(OR (NUMBERP
hanging-indent)
0)))
(DIFFERENCE right-margin new-indent))
join (if (CDR string)
then (LIST (CAR string)
*eol-string* new-indent-string)
else (LIST (CAR string])
(TEDIT-INDENT-BREAK-LINE
[LAMBDA (string first-line-max-length max-length) (* smL "26-Sep-86 19:42")
(* * Return a list of strings equivilent to the input string, but with no single string containing more than
max-length characters and the first line having no more than first-line-max-length characters)
(if (OR (NULL string)
(STRING-EQUAL string "")
(STRING-EQUAL string *eol-string*))
then NIL
else (LET ((existing-eol (STRPOSL [DEFERREDCONSTANT (MAKEBITTABLE (LIST (CHARCODE
EOL]
string)))
(if (OR (AND (NULL existing-eol)
(LEQ (NCHARS string)
first-line-max-length))
(AND (NUMBERP existing-eol)
(EQ existing-eol (NCHARS string))
(LEQ existing-eol first-line-max-length)))
then (* the string fits on a single line)
(LIST string)
else (LET [(break-point (if (AND (NUMBERP existing-eol)
(LESSP existing-eol
first-line-max-length))
then existing-eol
else (TEDIT-INDENT-FIND-BREAKPOINT string
first-line-max-length]
(CONS (OR (SUBSTRING string 1 (SUB1 break-point))
"")
(TEDIT-INDENT-BREAK-LINE (OR (SUBSTRING string
(ADD1
break-point))
"")
max-length max-length])
(TEDIT-INDENT-BREAK-LONG-LINES
(LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:03") (* * Break the current
selection into explicit lines, each having no more than *TEDIT-INDENT-LINE-LENGTH* characters. - If
the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is false, existing line breaks in the current selection are
removed. - This is intended to be used in Lafite, where one wants to indent a piece of a forwarded
document, but can be used in any TEdit document) (LET ((selection (TEDIT.GETSEL text-stream))) (
TEDIT-INDENT-REPLACE-SELECTION text-stream selection (CONCATLIST (for string on (
TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING text-stream selection)
explicit-paragraph-breaks?) bind (hanging-indent ← (AND (NOT (EQP (fetch CHAR1 of (CAR (fetch L1 of
selection))) (fetch CH# of selection))) (DIFFERENCE (fetch CH# of selection) (fetch CHAR1 of (CAR (
fetch L1 of selection)))))) join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR string) ""
*TEDIT-INDENT-LINE-LENGTH* hanging-indent) *eol-string*) (SETQ hanging-indent NIL))))))))
(TEDIT-INDENT-FIND-BREAKPOINT
[LAMBDA (string max-length) (* smL " 8-Sep-86 14:23")
(* * Return the position to break string so that it will contain no more than max-length characters -
if there is no whitespace before max-length characters, break it at the first whitespace after max-length)
(LET [(white-space-chars (DEFERREDCONSTANT (MAKEBITTABLE (LIST (CHARCODE SPACE)
(CHARCODE TAB)
(CHARCODE EOL]
(OR (STRPOSL white-space-chars string max-length NIL T)
(STRPOSL white-space-chars string max-length NIL NIL)
(ADD1 (NCHARS string])
(TEDIT-INDENT-REPLACE-SELECTION
[LAMBDA (text-stream selection new-text) (* smL " 8-Sep-86 17:44")
(* * Replace the given selection in the text stream with the new-text. End up with the new-text selected.)
(LET ((start (fetch CH# of selection)))
(TEDIT.SETSEL text-stream start (fetch DCH of selection)
(QUOTE LEFT)
T)
(TEDIT.INSERT text-stream new-text)
(TEDIT.SETSEL text-stream start (NCHARS new-text)
(QUOTE RIGHT])
(TEDIT-INDENT-SELECTION
(LAMBDA (text-stream explicit-paragraph-breaks?) (* smL "21-Jan-87 16:00") (* * Indent the current
selection by prefacing each line with the value of *TEDIT-INDENT-STRING*, and inserting line breaks
after each *TEDIT-INDENT-LINE-LENGTH* characters. - If the flag *TEDIT-INDENT-KEEP-LINE-BREAKS* is
false, existing line breaks in the current selection are removed. - This is intended to be used in
Lafite, where one wants to indent a piece of a forwarded document, but can be used in any TEdit
document) (LET ((selection (TEDIT.GETSEL text-stream))) (TEDIT-INDENT-REPLACE-SELECTION text-stream
selection (CONCATLIST (for string on (TEDIT-INDENT-SEPERATE-PARAGRAPHS (TEDIT.SEL.AS.STRING
text-stream selection) explicit-paragraph-breaks?) bind (hanging-indent ← (AND (NOT (EQP (fetch CHAR1
of (CAR (fetch L1 of selection))) (fetch CH# of selection))) (DIFFERENCE (fetch CH# of selection) (
fetch CHAR1 of (CAR (fetch L1 of selection)))))) join (PROG1 (LIST (TEDIT-INDENT-ADD-INDENTATION (CAR
string) *TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH* hanging-indent) *eol-string*) (SETQ
hanging-indent NIL))))))))
(TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS
[LAMBDA (text-stream) (* smL "12-Sep-86 16:58")
(* * Indent the current selection, keeping current line breaks)
(TEDIT-INDENT-SELECTION text-stream T])
(TEDIT-INDENT-SEPERATE-PARAGRAPHS
[LAMBDA (string explicit-paragraph-breaks?) (* smL "12-Sep-86 09:54")
(* * Return a list of strings, each comprising a seperate paragraph, that taken together make up the given string.
-
If explicit-paragraph-breaks? is true, paragraphs are delimited by <RETURN>'s, otherwise paragraphs are delimited
by a change in indentation after the second line.)
(if (NOT (STRINGP string))
then NIL
elseif explicit-paragraph-breaks?
then (\TEDIT-INDENT-SEPERATE-LINES string NIL)
else (\TEDIT-INDENT-SEPERATE-PARAGRAPHS string NIL])
(TEDIT-INDENT-SET-INDENT
[LAMBDA (text-stream) (* smL "12-Sep-86 17:09")
(* * Prompt the user for a new indentation string)
(LET* ((window (fetch \WINDOW of (TEXTOBJ text-stream)))
(pwindow (if window
then (GETPROMPTWINDOW (if (LISTP window)
then (CAR window)
else window))
else PROMPTWINDOW)))
(CLEARW pwindow)
(SETQ *TEDIT-INDENT-STRING* (PROMPTFORWORD "New indent string: " *TEDIT-INDENT-STRING*
NIL pwindow NIL NIL (LIST (CHARCODE
EOL])
(TEDIT-INDENT-STRIP-INDENTATION
[LAMBDA (paragraph first-line-too?) (* smL "15-Sep-86 17:03")
(* * Remove indentation from the given string)
(bind (string ← paragraph)
(eol-pos ← 1) while (SETQ eol-pos (STRPOS *eol-string* string))
do [SETQ string (if (EQP eol-pos (NCHARS string))
then (SUBSTRING string 1 (SUB1 eol-pos))
else (CONCAT (SUBSTRING string 1 (SUB1 eol-pos))
" "
(OR [SUBSTRING string (PLUS 1 eol-pos
(
\TEDIT-INDENT-COUNT-SPACES
string
(ADD1 eol-pos]
""]
finally (RETURN (if first-line-too?
then (OR (SUBSTRING string (ADD1 (\TEDIT-INDENT-COUNT-SPACES
string 1)))
"")
else string])
(TEDIT-MAKE-LINES-EXPLICIT
[LAMBDA (text-stream) (* smL " 8-Sep-86 18:20")
(* * Take the current selection and replace all TEdit end-of-lines with explicit line breaks.
-
This is intended to be used in Lafite, where it is sometimes nice to know that anyone receiving the msg will see
the same line breaks that you see. see, but can be used in any TEdit document)
(LET ((selection (TEDIT.GETSEL text-stream)))
[for i in (bind (this-line ←(CAR (fetch L1 of selection)))
[last-line ←(CAR (LAST (fetch LN of selection]
repeatuntil (PROGN (SETQ this-line (fetch NEXTLINE of this-line))
(EQ this-line last-line))
collect (fetch CHARLIM of this-line))
do (TEDIT.SETSEL text-stream i 1 (QUOTE LEFT)
T)
(TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
(TEDIT.SETSEL text-stream selection NIL (QUOTE RIGHT])
(TEDIT-OPEN-LINE
[LAMBDA (text-stream) (* smL "17-Sep-86 11:13")
(* * Open a new line at the current position.)
(LET ((selection (TEDIT.GETSEL text-stream)))
(TEDIT.INSERT text-stream (CONCAT *eol-string*
(ALLOCSTRING [DIFFERENCE
(fetch CH# of selection)
(fetch CHAR1
of (CAR (fetch L1
of selection]
" ")))
(if (ZEROP (fetch DCH of selection))
then (TEDIT.SETSEL text-stream selection])
(TEDIT-REMOVE-INDENT
[LAMBDA (text-stream) (* smL "15-Sep-86 17:03")
(* * Remove the indentation from the current selection)
(LET ((selection (TEDIT.GETSEL text-stream)))
(TEDIT-INDENT-REPLACE-SELECTION text-stream selection
(CONCATLIST (for paragraph
in (TEDIT-INDENT-SEPERATE-PARAGRAPHS
(TEDIT.SEL.AS.STRING text-stream
selection))
join (LIST (
TEDIT-INDENT-STRIP-INDENTATION
paragraph T)
*eol-string*])
(\TEDIT-INDENT-COUNT-SPACES
[LAMBDA (string start-pos) (* smL "12-Sep-86 14:29")
(* * Count the number of spaces following position start-pos in string)
(if (NOT (STRINGP string))
then 0
else (DIFFERENCE [for i from start-pos bind (max-pos ←(NCHARS string))
thereis (OR (GREATERP i max-pos)
(NOT (EQP (NTHCHARCODE string i)
(CHARCODE SPACE]
start-pos])
(\TEDIT-INDENT-FIND-PARAGRAPH-END
[LAMBDA (string paragraph-indent after-pos) (* smL "15-Sep-86 15:53")
(* * Find the end of paragraph that has the given indent and contains the given position in the string)
(LET [(eol-pos (STRPOS *eol-string* string (ADD1 after-pos]
(if (NULL eol-pos)
then (ADD1 (NCHARS string))
elseif (for i from (ADD1 after-pos) to (SUB1 eol-pos)
always (EQP (CHARCODE SPACE)
(NTHCHARCODE string i)))
then after-pos
elseif (EQP eol-pos (NCHARS string))
then eol-pos
elseif (EQP paragraph-indent (\TEDIT-INDENT-COUNT-SPACES string (ADD1 eol-pos)))
then (\TEDIT-INDENT-FIND-PARAGRAPH-END string paragraph-indent eol-pos)
else eol-pos])
(\TEDIT-INDENT-SEPERATE-LINES
(LAMBDA (remaining-string current-lines) (* smL "21-Jan-87 15:58") (* * Return a list of lines that
make up the remaining-string, with the reverse of current-lines appended to the front) (if (NOT (
STRINGP remaining-string)) then (OR (DREVERSE current-lines) (LIST "")) else (LET ((eol-pos (OR (
STRPOS *eol-string* remaining-string) (ADD1 (NCHARS remaining-string))))) (
\TEDIT-INDENT-SEPERATE-LINES (SUBSTRING remaining-string (ADD1 eol-pos)) (CONS (OR (SUBSTRING
remaining-string 1 (SUB1 eol-pos)) "") current-lines))))))
(\TEDIT-INDENT-SEPERATE-PARAGRAPHS
[LAMBDA (string current-paragraphs) (* smL "15-Sep-86 15:54")
(* * Return a list of strings, each comprising a seperate paragraph, that taken together make up the given string.
Paragraphs are delimited by a change in indentation after the second line, or a blank line.)
(if (NOT (STRINGP string))
then (DREVERSE current-paragraphs)
else (LET ((eol-pos (STRPOS *eol-string* string)))
(if (NULL eol-pos)
then (DREVERSE (CONS string current-paragraphs))
elseif (for i from 1 to (SUB1 eol-pos) always (EQP (CHARCODE
SPACE)
(NTHCHARCODE
string i)))
then (\TEDIT-INDENT-SEPERATE-PARAGRAPHS (SUBSTRING string (ADD1 eol-pos)
)
(CONS "" current-paragraphs))
elseif (EQP eol-pos (NCHARS string))
then (DREVERSE (CONS string current-paragraphs))
else (LET ((para-end-pos (\TEDIT-INDENT-FIND-PARAGRAPH-END
string
(\TEDIT-INDENT-COUNT-SPACES string (ADD1 eol-pos)
)
eol-pos)))
(\TEDIT-INDENT-SEPERATE-PARAGRAPHS
(SUBSTRING string (ADD1 para-end-pos))
(CONS (OR (SUBSTRING string 1 (SUB1 para-end-pos))
"")
current-paragraphs])
)
(RPAQ? *TEDIT-INDENT-STRING* (ALLOCSTRING 4 " "))
(RPAQ? *TEDIT-INDENT-LINE-LENGTH* 72)
(DECLARE: EVAL@COMPILE
(RPAQ *eol-string* (CHARACTER (CHARCODE EOL)))
(CONSTANTS (*eol-string* (CHARACTER (CHARCODE EOL))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *TEDIT-INDENT-STRING* *TEDIT-INDENT-LINE-LENGTH*)
)
(OR (GETD (QUOTE TEDIT)) (FILESLOAD TEDIT))
(TEDIT.REMOVE.MENUITEM TEDIT.DEFAULT.MENU (QUOTE Indent))
(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU (QUOTE (Indent (QUOTE TEDIT-INDENT-SELECTION)
"Indent the current selection" (SUBITEMS (Indent (QUOTE TEDIT-INDENT-SELECTION)
"Indent the current selection") ("Indent & keep lines" (QUOTE
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS)
"Indent the current selection, keeping existing line breaks") ("Set indent" (QUOTE
TEDIT-INDENT-SET-INDENT) "Set the indent string to a new value") (Unindent (QUOTE TEDIT-REMOVE-INDENT)
"Remove one level of indentation from the current selection") ("Open line" (QUOTE TEDIT-OPEN-LINE)
"Open a blank line at the current position") ("Insert <RETURN>s" (QUOTE TEDIT-MAKE-LINES-EXPLICIT)
"Insert real <RETURN>s at the end of each line in the current selection") ("Break long lines" (QUOTE
TEDIT-INDENT-BREAK-LONG-LINES) "Break long lines by inserting explicit <RETURN>'s")))))
(PUTPROPS LAFITE-INDENT COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2266 17318 (TEDIT-INDENT-ADD-INDENTATION 2276 . 3985) (TEDIT-INDENT-BREAK-LINE 3987 .
5542) (TEDIT-INDENT-BREAK-LONG-LINES 5544 . 6617) (TEDIT-INDENT-FIND-BREAKPOINT 6619 . 7312) (
TEDIT-INDENT-REPLACE-SELECTION 7314 . 7861) (TEDIT-INDENT-SELECTION 7863 . 9005) (
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 9007 . 9273) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 9275 . 9948)
(TEDIT-INDENT-SET-INDENT 9950 . 10609) (TEDIT-INDENT-STRIP-INDENTATION 10611 . 11540) (
TEDIT-MAKE-LINES-EXPLICIT 11542 . 12616) (TEDIT-OPEN-LINE 12618 . 13232) (TEDIT-REMOVE-INDENT 13234 .
13850) (\TEDIT-INDENT-COUNT-SPACES 13852 . 14379) (\TEDIT-INDENT-FIND-PARAGRAPH-END 14381 . 15267) (
\TEDIT-INDENT-SEPERATE-LINES 15269 . 15825) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 15827 . 17316)))))
STOP