(DEFINE-FILE-INFO §READTABLE "INTERLISP" §PACKAGE "INTERLISP")

(FILECREATED "22-Jan-87 01:34:36" {ERIS}<LISPUSERS>LISPCORE>LAFITE-INDENT.;1
 25845  

      previous date%: "21-Jan-87 16:06:01" {ERIS}<LISPUSERS>KOTO>LAFITE-INDENT.;5)


(* "
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 'TEDIT)
               (FILESLOAD TEDIT))
           (TEDIT.REMOVE.MENUITEM TEDIT.DEFAULT.MENU 'Indent)
           (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Indent 'TEDIT-INDENT-SELECTION 
                                                          "Indent the current selection"
                                                          (SUBITEMS (Indent 'TEDIT-INDENT-SELECTION 
                                                                       "Indent the current selection"
                                                                           )
                                                                 ("Indent & keep lines" '
                                                            TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 
                                         "Indent the current selection, keeping existing line breaks"
                                                                        )
                                                                 ("Set indent" '
                                                                        TEDIT-INDENT-SET-INDENT 
                                                               "Set the indent string to a new value"
                                                                        )
                                                                 (Unindent 'TEDIT-REMOVE-INDENT 
                                         "Remove one level of indentation from the current selection"
                                                                        )
                                                                 ("Open line" 'TEDIT-OPEN-LINE 
                                                          "Open a blank line at the current position"
                                                                        )
                                                                 ("Insert <RETURN>s" '
                                                                        TEDIT-MAKE-LINES-EXPLICIT 
                             "Insert real <RETURN>s at the end of each line in the current selection"
                                                                        )
                                                                 ("Break long lines" '
                                                                        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)
                'LEFT T)
         (TEDIT.INSERT text-stream new-text)
         (TEDIT.SETSEL text-stream start (NCHARS new-text)
                '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 'LEFT T)
               (TEDIT.INSERT text-stream (CONSTANT (CHARACTER (CHARCODE EOL]
         (TEDIT.SETSEL text-stream selection NIL '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 'TEDIT)
    (FILESLOAD TEDIT))
(TEDIT.REMOVE.MENUITEM TEDIT.DEFAULT.MENU 'Indent)
[TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Indent 'TEDIT-INDENT-SELECTION 
                                               "Indent the current selection"
                                               (SUBITEMS (Indent 'TEDIT-INDENT-SELECTION 
                                                                "Indent the current selection")
                                                      ("Indent & keep lines" '
                                                            TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 
                                         "Indent the current selection, keeping existing line breaks"
                                                             )
                                                      ("Set indent" 'TEDIT-INDENT-SET-INDENT 
                                                             "Set the indent string to a new value")
                                                      (Unindent 'TEDIT-REMOVE-INDENT 
                                         "Remove one level of indentation from the current selection"
                                                             )
                                                      ("Open line" 'TEDIT-OPEN-LINE 
                                                          "Open a blank line at the current position"
                                                             )
                                                      ("Insert <RETURN>s" 'TEDIT-MAKE-LINES-EXPLICIT 
                             "Insert real <RETURN>s at the end of each line in the current selection"
                                                             )
                                                      ("Break long lines" '
                                                             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 (3949 23354 (TEDIT-INDENT-ADD-INDENTATION 3959 . 6527) (TEDIT-INDENT-BREAK-LINE 6529 . 
8462) (TEDIT-INDENT-BREAK-LONG-LINES 8464 . 10231) (TEDIT-INDENT-FIND-BREAKPOINT 10233 . 11056) (
TEDIT-INDENT-REPLACE-SELECTION 11058 . 11615) (TEDIT-INDENT-SELECTION 11617 . 13518) (
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 13520 . 13799) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 13801 . 
14530) (TEDIT-INDENT-SET-INDENT 14532 . 15306) (TEDIT-INDENT-STRIP-INDENTATION 15308 . 16528) (
TEDIT-MAKE-LINES-EXPLICIT 16530 . 17735) (TEDIT-OPEN-LINE 17737 . 18493) (TEDIT-REMOVE-INDENT 18495 . 
19265) (\TEDIT-INDENT-COUNT-SPACES 19267 . 19868) (\TEDIT-INDENT-FIND-PARAGRAPH-END 19870 . 20841) (
\TEDIT-INDENT-SEPERATE-LINES 20843 . 21641) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 21643 . 23352)))))
STOP