(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)

(FILECREATED "18-Feb-2026 15:47:08" {WMEDLEY}<library>LAFITE>LAFITE-INDENT.;2 26210  

      :EDIT-BY rmk

      :PREVIOUS-DATE "22-Jan-87 01:34:36" {WMEDLEY}<library>LAFITE>LAFITE-INDENT.;1)


(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"
                                                             ]
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (4193 23598 (TEDIT-INDENT-ADD-INDENTATION 4203 . 6771) (TEDIT-INDENT-BREAK-LINE 6773 . 
8706) (TEDIT-INDENT-BREAK-LONG-LINES 8708 . 10475) (TEDIT-INDENT-FIND-BREAKPOINT 10477 . 11300) (
TEDIT-INDENT-REPLACE-SELECTION 11302 . 11859) (TEDIT-INDENT-SELECTION 11861 . 13762) (
TEDIT-INDENT-SELECTION-KEEPING-LINEBREAKS 13764 . 14043) (TEDIT-INDENT-SEPERATE-PARAGRAPHS 14045 . 
14774) (TEDIT-INDENT-SET-INDENT 14776 . 15550) (TEDIT-INDENT-STRIP-INDENTATION 15552 . 16772) (
TEDIT-MAKE-LINES-EXPLICIT 16774 . 17979) (TEDIT-OPEN-LINE 17981 . 18737) (TEDIT-REMOVE-INDENT 18739 . 
19509) (\TEDIT-INDENT-COUNT-SPACES 19511 . 20112) (\TEDIT-INDENT-FIND-PARAGRAPH-END 20114 . 21085) (
\TEDIT-INDENT-SEPERATE-LINES 21087 . 21885) (\TEDIT-INDENT-SEPERATE-PARAGRAPHS 21887 . 23596)))))
STOP
