LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032454. :SYSTEM-TYPE :LOGICAL :VERSION 3. :TYPE "LISP" :NAME "INDENT" :DIRECTORY ("REL3-SOURCE" "ZMACS") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758739044. :AUTHOR "REL3" :LENGTH-IN-BYTES 36661. :LENGTH-IN-BLOCKS 36. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                ;;; Functions that deal with indentation -*- Mode:Common-Lisp; Package:ZWEI; Base:8 -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151;;;;;; Copyright (C) 1985, 1987 Texas Instruments Incorporated. All rights reserved.;;; Copyright (C) 1980, Massachusetts Institute of Technology(DEFUN LINE-INDENTATION (LINE &OPTIONAL (SHEET (WINDOW-SHEET *WINDOW*)))  "Horizontal position in pixels of first non-whitespace character on LINE.If the line is all whitespace, the end of the line is what counts.This is 0 if the first character is non-whitespace.SHEET is used to determine the fonts to use."  (STRING-WIDTH LINE0(BP-INDEX (FORWARD-OVER *BLANKS* (CREATE-BP LINE 0)))SHEET)) (DEFUN BP-INDENTATION (BP &OPTIONAL (SHEET (WINDOW-SHEET *WINDOW*)))  "Horizontal position in pixels of BP, taking account continuation of line.A character in column 0 is at horizontal position 0.SHEET is used to determine the fonts to use."  (STRING-WIDTH (BP-LINE BP) 0 (BP-INDEX BP) SHEET T)) (DEFUN BP-VIRTUAL-INDENTATION (BP &OPTIONAL (SHEET (WINDOW-SHEET *WINDOW*)))  "Horizontal position in pixels of BP, if window were infinitely wide.SHEET is used for determining fonts."  (STRING-WIDTH (BP-LINE BP) 0 (BP-INDEX BP) SHEET)) ;;; This is the only function which knows to use spaces and tabs;;; to perform indentation!!!  Nobody else should know that.(DEFUN INDENT-TO (BP GOAL &OPTIONAL (SHEET (WINDOW-SHEET *WINDOW*)) &AUX SPACES)  "Insert spaces and maybe tabs at BP until it reaches hpos GOAL.Returns a bp to the end of the inserted whitespace.If *INDENT-WITH-TABS* is NIL, just spaces are used.GOAL is measured in pixels.  SHEET determines the fonts to use to calculate positions.If we cannot get exactly to the GOAL pixel, we go a little past it."  (LET (N M)    (LET ((BPI (BP-VIRTUAL-INDENTATION BP SHEET))  (SW (FONT-SPACE-WIDTH))  (TW (SEND SHEET :EDITOR-TAB-WIDTH)))      (SETQ M (FLOOR GOAL TW);Number of tabs to get to goal    N (* TW M));Position of rightmost tab      (IF (OR (> BPI N);Past there, no tabs can be used,      (NOT *INDENT-WITH-TABS*));and also if user says "no tabs"  (SETQ N (CEILING (- GOAL BPI) SW)M 0);so use all spaces.  (SETQ M (- M (FLOOR BPI TW))N (CEILING (- GOAL N) SW))));else tabs and spaces    ;; M has number of tabs, N has number of spaces.    ;; Set up SPACES with the string to be inserted.    ;; Check first to see if there is any indentation needed.    (IF (PLUSP (+ M N)) (SETQ SPACES (MAKE-ARRAY (+ M N) :TYPE (IF (ZEROP *FONT*)   'ART-STRING   'ART-FAT-STRING)));; No indentation needed here. Simply return the BP.(RETURN-FROM INDENT-TO BP))    (LET ((TAB (IN-CURRENT-FONT #\TAB))  (SPACE (IN-CURRENT-FONT #\SPACE)))      (DO ((I (1- M) (1- I)))  ((MINUSP I)   NIL)(SETF (AREF SPACES I) TAB))      (DO ((I 1 (1+ I))   (J M (1+ J)))  ((> I N))(SETF (AREF SPACES J) SPACE))))  (PROG1    (INSERT-MOVING BP SPACES)    (RETURN-ARRAY (PROG1 SPACES (SETF SPACES NIL))))) (DEFUN FONT-SPACE-WIDTH ()  "Return the width of a space character in FONT."  (IF (TYPEP *WINDOW* 'WINDOW)      (LET* ((FONT (CURRENT-FONT *WINDOW*))     (CHAR-WIDTH-TABLE (W:FONT-CHAR-WIDTH-TABLE FONT)))(IF CHAR-WIDTH-TABLE    (AREF CHAR-WIDTH-TABLE (CHAR-CODE #\SPACE))    (W:FONT-CHAR-WIDTH FONT)))      (SEND *WINDOW* :CHARACTER-WIDTH))) (DEFUN INDENT-LINE (BP INDENTATION &OPTIONAL    (SHEET (WINDOW-SHEET *WINDOW*))    (BP1 (CREATE-BP (BP-LINE BP) 0)))  "Adjust the indentation at the front of BP's line to be INDENTATION pixels wide.If the indentation is already as desired, the line is not changed.SHEET determines the fonts for computing the indentation.Returns a BP to the end of what it inserted.Preserves the indentations of bps pointing within the indentation, if possible.If BP1 is specified, the indentation after BP1 is processed.In this case, BP is ignored; its only purpose is to set BP1."  (LET (BP-AFTER BP-LIST NONBLANK-INDEX)    (SETQ BP-AFTER (FORWARD-OVER *BLANKS* BP1))    (SETQ NONBLANK-INDEX (BP-INDEX BP-AFTER))    (IF (= INDENTATION (STRING-WIDTH (BP-LINE BP1) 0 NONBLANK-INDEX SHEET))BP-AFTER(PROGN  (DOLIST (BP2 (LINE-BP-LIST (BP-LINE BP1)))    (COND ((OR (< (BP-INDEX BP2) NONBLANK-INDEX)       (AND (= (BP-INDEX BP2) NONBLANK-INDEX)    (EQ (BP-STATUS BP2) :NORMAL)))   (PUSH (CONS BP2 (BP-INDENTATION BP2 SHEET)) BP-LIST))))  (DELETE-INTERVAL BP1 BP-AFTER T)  ;; Don't screw up the undo information for this change  ;; by trying to preserve indentation of it's bps.  (LET ((US (NODE-UNDO-STATUS *INTERVAL*)))    (UNLESS (EQ US :DONT)      (SETQ BP-LIST    (DELETE (ASSOC (UNDO-STATUS-START-BP US) BP-LIST :TEST #'EQ)    (THE LIST BP-LIST)    :TEST #'EQ))      (SETQ BP-LIST    (DELETE (ASSOC (UNDO-STATUS-END-BP US) BP-LIST :TEST #'EQ)    (THE LIST BP-LIST)    :TEST #'EQ))))  (PROG1    (INDENT-TO BP1 INDENTATION SHEET)    (LET ((NONBLANK-INDEX    (BP-INDEX (FORWARD-OVER *BLANKS* (CREATE-BP (BP-LINE BP) 0)))))      (DOLIST (BP-AND-INDENTATION BP-LIST)(LET ((INDEX(INDENTATION-INDEX (BP-LINE (CAR BP-AND-INDENTATION))   (CDR BP-AND-INDENTATION) SHEET)))  (AND INDEX       (SETF (BP-INDEX (CAR BP-AND-INDENTATION))     (MIN NONBLANK-INDEX INDEX))))))))))) (DEFUN INDENT-BP-ADJUSTMENT (BP)  "If BP is within the indentation of its line, move it past.The indentation of the line is the whitespace characters at the beginning of it, if any.BP is modified, and returned."  (LET ((BP1 (FORWARD-OVER *BLANKS* (CREATE-BP (BP-LINE BP) 0))))    (COND ((AND (< (BP-INDEX (POINT))   (BP-INDEX BP1)))   (MOVE-BP BP BP1)))    BP)) (DEFUN INDENTATION-INDEX (LINE XPOS &OPTIONAL SHEET LENGTH ROUND-DOWN-P)  "Returns the index in LINE which would be at pixel XPOS.If XPOS is greater than the length of the string, return NIL.It the answer is between N and N+1, returns N if ROUND-DOWN-P, else N+1."  (OR SHEET (SETQ SHEET (WINDOW-SHEET *WINDOW*)))  (AND (NULL LENGTH)       (EQ LINE (BP-LINE (INTERVAL-LAST-BP *INTERVAL*)))       (SETQ LENGTH (BP-INDEX (INTERVAL-LAST-BP *INTERVAL*))))  (MULTIPLE-VALUE-BIND (X INDEX)      (STRING-WIDTH LINE 0 NIL SHEET T XPOS)    (AND INDEX ROUND-DOWN-P (/= X XPOS) (SETQ INDEX (1- INDEX)))    INDEX)) (DEFCOM COM-TAB-HACKING-DELETE-FORWARD "Delete characters forward, changing tabs into spaces.Argument is repeat count." ()   (DELETE-CHARS-CONVERTING-TABS (POINT) *NUMERIC-ARG*)) (DEFCOM COM-TAB-HACKING-RUBOUT "Rub out a character, changing tabs to spaces.So tabs rub out as if they had been spaces all along.A numeric argument is a repeat count." ()  (DELETE-CHARS-CONVERTING-TABS (POINT) (- *NUMERIC-ARG*))) (DEFUN DELETE-CHARS-CONVERTING-TABS (POINT COUNT &AUX     (BP (COPY-BP POINT))     (MIN-INDEX (BP-INDEX BP)))  "Delete COUNT characters after POINT, converting tabs to spaces before deletion."  ;; Scan across what we will delete, converting tabs to spaces.  ;; BP gets set to the other end of the range to be deleted.  (COND ((> COUNT 0) (DOTIMES (I COUNT)   (AND (BP-= BP (INTERVAL-LAST-BP *INTERVAL*))(RETURN (BEEP)))   ;; When moving forward, whenever we find a blank we must   ;; convert all tabs within the blanks that follow.   (AND (MEMBER (BP-CH-CHAR BP) *BLANKS* :TEST #'EQ)(LET ((BP1 (COPY-BP BP)))  (DO ()      ((OR (BP-= BP1 (INTERVAL-LAST-BP *INTERVAL*))   (NOT (MEMBER (BP-CH-CHAR BP1) *BLANKS* :TEST #'EQ))))    (COND ((CHAR= (BP-CH-CHAR BP1) #\TAB)   (TAB-CONVERT BP1 (FORWARD-CHAR BP1 1)))  (T   (IBP BP1))))))   (IBP BP)))(T (DOTIMES (I (- COUNT))   (AND (BP-= BP (INTERVAL-FIRST-BP *INTERVAL*))(RETURN (BEEP)))   (WHEN (CHAR= (MAKE-CHAR (BP-CHAR-BEFORE BP)) #\TAB)     (SETQ MIN-INDEX (1- (BP-INDEX BP)))     (TAB-CONVERT (FORWARD-CHAR BP -1) BP))   (DBP BP))))  (COND ((EQ (BP-LINE POINT) (BP-LINE BP)) (MUST-REDISPLAY *WINDOW* DIS-LINE (BP-LINE POINT) (MIN (BP-INDEX POINT)      MIN-INDEX      (BP-INDEX BP))))(T (MUST-REDISPLAY *WINDOW* DIS-TEXT)))  (FUNCALL (IF *NUMERIC-ARG-P*       #'KILL-INTERVAL       #'DELETE-INTERVAL)   POINT BP)  DIS-NONE) (DEFUN TAB-CONVERT (BP-BEFORE BP-AFTER)  "Convert a tab to the right number of spaces, preserving the font.BP-BEFORE and BP-AFTER should be temporary BPs to before and after the tab character."  (LET ((INDENT-BEFORE (BP-VIRTUAL-INDENTATION BP-BEFORE))(INDENT-AFTER (BP-VIRTUAL-INDENTATION BP-AFTER))(*FONT* (CHAR-FONT (BP-CHAR BP-BEFORE)))SPACENSPACES)    (IF (BP-STATUS BP-BEFORE)(FERROR NIL "~S is not a temporary BP." BP-BEFORE))    (IF (BP-STATUS BP-AFTER)(FERROR NIL "~S is not a temporary BP." BP-AFTER))    (SETQ SPACE (IN-CURRENT-FONT #\SPACE))    (SETQ NSPACES (FLOOR (- INDENT-AFTER INDENT-BEFORE) (FONT-SPACE-WIDTH)))    (MUNG-BP-LINE-AND-INTERVAL BP-BEFORE)    (SETF (AREF (BP-LINE BP-BEFORE) (BP-INDEX BP-BEFORE)) SPACE)    (INSERT-CHARS BP-BEFORE SPACE (1- NSPACES))    (MOVE-BP BP-AFTER (BP-LINE BP-AFTER) (+ (BP-INDEX BP-AFTER) NSPACES -1))    BP-AFTER)) (DEFCOM COM-UNTABIFY "Replace tabs with spaces in region, or from point to end.All tab characters are replaced by spaces, preserving indentation.A numeric argument specifies the number of spaces a tab is equivalent to." ()  (LET ((*TAB-WIDTH* (IF *NUMERIC-ARG-P* *NUMERIC-ARG* *TAB-WIDTH*)))    (IF (WINDOW-MARK-P *WINDOW*)(REGION (BP1 BP2) (UNTABIFY-INTERVAL BP1 BP2 T))(UNTABIFY-INTERVAL (POINT) (INTERVAL-LAST-BP *INTERVAL*) T)))  DIS-TEXT) (DEFUN UNTABIFY-INTERVAL (BP1 BP2 &OPTIONAL IN-ORDER-P)  "Convert all tabs to spaces within the specified interval.Give either one arg, an interval, or two BPs."  (GET-INTERVAL BP1 BP2 IN-ORDER-P)  (DO ((BP BP1)       (*INDENT-WITH-TABS* NIL)       AFTER-BP)      ((NOT (SETQ AFTER-BP (SEARCH BP #\TAB NIL NIL NIL BP2))))    (SETQ BP (FORWARD-CHAR AFTER-BP -1))    (TAB-CONVERT BP AFTER-BP))) (DEFCOM COM-TABIFY "Replace spaces with tabs in region, or from point to end.All runs of three or more spaces are replaced as much as possible with tabs,preserving the indentation.A numeric argument specifies the number of spaces a tab is equivalent to." ()  (LET ((*TAB-WIDTH* (IF *NUMERIC-ARG-P* *NUMERIC-ARG* *TAB-WIDTH*)))    (IF (WINDOW-MARK-P *WINDOW*)(REGION (BP1 BP2) (TABIFY-INTERVAL BP1 BP2 T))(TABIFY-INTERVAL (POINT) (INTERVAL-LAST-BP *INTERVAL*) T)))  DIS-TEXT) (DEFUN TABIFY-INTERVAL (BP1 BP2 &OPTIONAL IN-ORDER-P)  "Convert multiple spaces to tabs within the specified interval.Runs of three or more spaces which span a tab stop are converted.Give either one arg, an interval, or two BPs."  (GET-INTERVAL BP1 BP2 IN-ORDER-P)  (DO ((BP BP1)       (*INDENT-WITH-TABS* T)       AFTER-BP)      ((NOT (SETQ AFTER-BP (SEARCH BP "   " NIL NIL NIL BP2))))    ;; Get BP and AFTER-BP around this run of spaces.    (SETQ BP (FORWARD-CHAR AFTER-BP -3))    (SETQ AFTER-BP (FORWARD-OVER '(#\SPACE) AFTER-BP))    ;; Delete them and replace with standard indentation (which uses tabs if possible).    (LET ((INDENTATION (BP-VIRTUAL-INDENTATION AFTER-BP))  (*FONT* (CHAR-FONT (BP-CHAR BP))))      (DELETE-INTERVAL BP AFTER-BP T)      (INDENT-TO BP INDENTATION)))) (DEFCOM COM-INDENT-FOR-LISP "Indent this line to make ground LISP code.Numeric argument is number of lines to indent." ()  (LET ((PT (POINT))ENDFLAG)    (SETQ END (OR (BEG-LINE PT *NUMERIC-ARG*)  (INSERT (SETQ FLAG (INTERVAL-LAST-BP *INTERVAL*)) #\NEWLINE)))    (SETQ END (INDENT-INTERVAL-FOR-LISP (BEG-LINE PT) END NIL NIL *NUMERIC-ARG-P*))    (IF (= *NUMERIC-ARG* 1)(INDENT-BP-ADJUSTMENT PT)(MOVE-BP PT END))    (AND FLAG (DELETE-INTERVAL (FORWARD-CHAR FLAG -1) FLAG T)))  DIS-TEXT) (DEFCOM COM-INDENT-FOR-LISP-COMMENTS-SPECIAL"Like LISP Tab, except in comments just inserts Tab." ()  (LET ((POINT (POINT))IN-COMMENT)    (MULTIPLE-VALUE-SETQ (NIL NIL IN-COMMENT) (LISP-BP-SYNTACTIC-CONTEXT POINT))    (IF IN-COMMENT(COM-INSERT-TAB)(COM-INDENT-FOR-LISP)))) (DEFCOM COM-INDENT-NEW-LINE "Insert a Return and the proper indentation on the new line." ()  (MOVE-BP (POINT) (DELETE-BACKWARD-OVER *BLANKS* (POINT)))  (LET ((*LAST-COMMAND-TYPE* 'INDENT-NEW-LINE)*CURRENT-COMMAND-TYPE*);Don't be fooled    (MAX (IF *INDENT-NEW-LINE-NEW-LINE-FUNCTION*     (FUNCALL *INDENT-NEW-LINE-NEW-LINE-FUNCTION*)     (KEY-EXECUTE #\NEWLINE *NUMERIC-ARG-P* *NUMERIC-ARG*)) (IF *INDENT-NEW-LINE-INDENT-FUNCTION*     (FUNCALL *INDENT-NEW-LINE-INDENT-FUNCTION*)     (KEY-EXECUTE #\TAB))))) (DEFCOM COM-INDENT-SEXP "Indent the following s-expression.Each line that starts within the s-expression is indented for Lisp.This implies that the line that point is on is NOT adjusted.If there is not a complete s-expression, it will indent to thenext line that has a non-white-space character at the start." ()  (LET ((BP1 (OR (BEG-LINE (POINT) 1) (BARF)))(BP2 (OR (FORWARD-SEXP (POINT)) (LET ((NEXT-BP (FORWARD-TO-NEXT-LINE-WITH-NON-WHITE-SPACE-START (POINT))))   (IF NEXT-BP       (CREATE-BP (LINE-PREVIOUS (BP-LINE NEXT-BP)) 0)       (BARF))))))    (AND (BP-< BP1 BP2) (WITH-UNDO-SAVE ("Indent Sexp" BP1 BP2 T)   (INDENT-INTERVAL-FOR-LISP BP1 BP2 T))))  DIS-TEXT) (DEFCOM COM-INDENT-NEW-LINE-AT-PREVIOUS-SEXP"Insert a Return and the proper indentation at the s-expression before point." ()  (LET* ((POINT (POINT)) (BP (OR (FORWARD-SEXP POINT (- *NUMERIC-ARG*)) (BARF))))    (WITH-BP (OLD-POINT POINT ':NORMAL)      (MOVE-BP POINT BP)      (UNWIND-PROTECT (COM-INDENT-NEW-LINE)(MOVE-BP POINT OLD-POINT))))) ;;; Text grinding functions;;; FILL-INTERVAL:;;; Rewritten by dkm to handle ALL paragraphs in the interval; source changed on 11-25-86 by rpm.;;; Modified by dkm (source changed on 4-1-87 by rpm) for the following reasons:;;;  Fixed error determining the end of the region to be filled, causing;;;     it run rampant through the buffer resulting in either a NIL line and/or bad spaces count.;;;  Fixed incorrect spacing after things like periods at the end of a line.;;;  Created a local binding of *fill-prefix* so that this routine will not have ;;;     side effects if something bad happens.;;;  Fixed to handle a fill prefix that has tabs in it. Had to untabify the fill prefix, and;;;     re-tabify the region when finished if tabs are found in the fill prefix.;;;  Removed attempt to handle special spacing inside strings, which was wrong. To do it right;;;     would be more expensive than it's worth.  So, a line having: " this    is    a    test    ";;;     will get adjusted to be " this is a test "(DEFUN FILL-INTERVAL (BEGIN-BP LAST-BP &OPTIONAL IN-ORDER-P ADJUST      &AUX (SAVED-FILL-PREFIX *FILL-PREFIX*)         ;Remember the original fill prefix (4-1-87).      (*FILL-PREFIX* *FILL-PREFIX*)                  ;Locally bind *fill-prefix* (4-1-87).                      END-BP START-BP LINE1 LINE2      TEM FILL-PREFIX FILLCOL COMMON-INDENT)  "Fill or justify the text in the specified interval, by paragraphs.Either BEGIN-BP is really an interval, or elseBEGIN-BP and LAST-BP are BPs delimiting the interval.ADJUST non-NIL says justify; otherwise just fill."  (GET-INTERVAL BEGIN-BP LAST-BP IN-ORDER-P)     ;Set begin-bp and last-bp to real bp's.  (WITH-UNDO-SAVE ("Fill" BEGIN-BP LAST-BP T)     ;Allow undo to undo what we do.    (SETQ END-BP BEGIN-BP)     ;Intialize end-bp first time thru.    (SETQ LAST-BP (END-OF-LINE (BP-LINE LAST-BP)))     ;Make sure last-bp points to end of line (4-1-87).    ;; The fill routine doesn't want any tabs in the interval being filled, or in    ;;  the fill prefix.  If there is a fill prefix with tabs, replace the tabs    ;;  with an equivalent number of spaces during this fill process (4-1-87).     (UNTABIFY-INTERVAL BEGIN-BP LAST-BP T)     ;Get rid of any tabs in the region.    (WHEN (AND (PLUSP (LENGTH *FILL-PREFIX*))     ;If a fill prefix is specified        (LISP:FIND #\TAB *FILL-PREFIX*))     ; and it has tabs in it      (LET ((I (CREATE-INTERVAL *FILL-PREFIX*)))     ; make a temporary interval(UNTABIFY-INTERVAL I NIL)     ; replacing tabs with spaces(SETQ *FILL-PREFIX* (BP-LINE (SEND I :FIRST-BP)))))     ; and set the fill prefix to that string.    ;;This loop is new (4-1-87).    (DO ()     ;Loop thru region one paragraph at a time.((BP-= END-BP LAST-BP))      (SETQ END-BP (END-LINE (FORWARD-PARAGRAPH END-BP 1 T)) ;Find the extents of the next paragraph.            START-BP (FORWARD-PARAGRAPH END-BP -1 T))      (IF (BP-< START-BP BEGIN-BP)     ;In case a specific region has been marked,  (SETQ START-BP BEGIN-BP))     ; don't go outside of that region.      (IF (NOT (BP-< END-BP LAST-BP))  (SETQ END-BP LAST-BP))       (IF (LINE-BLANK-OR-DIAGRAM-P (BP-LINE START-BP))     ;Be sure interval starts with paragraph text by  (SETQ START-BP (BEG-LINE START-BP 1)))     ; moving down a line if we're on a blank line.      (SETQ LINE1 (BP-LINE START-BP)     ;The starting line.    LINE2 (LET ((LINE (BP-LINE END-BP)))     ;A line to stop at (1 line past ending line).    (IF (LINE-BLANK-OR-DIAGRAM-P LINE)LINE(LINE-NEXT LINE)))    COMMON-INDENT (IF (BP-AT-PARAGRAPH-STARTER     ;Columns of "common indent" if it exists.(SETQ TEM     ;Cope with indentation before paragraph start.      (COMMONLY-INDENTED (BEG-LINE START-BP 1 T))))      (BP-INDEX (COMMONLY-INDENTED (BEG-LINE START-BP)))      (BP-INDEX TEM))    FILL-PREFIX *FILL-PREFIX*     ;Re-initialize for each paragraph.    FILLCOL *FILL-COLUMN*)     ;Re-initialize for each paragraph.      (IF (ZEROP (LENGTH FILL-PREFIX))     ;Set fill-prefix for common indented lines if  (SETQ FILL-PREFIX (MAKE-STRING COMMON-INDENT     ; a fill prefix is not already out there.:INITIAL-ELEMENT #\SPACE)))      (COND ((PLUSP (SETQ TEM (LENGTH FILL-PREFIX)))     ;Remove fill prefixes if they exist on     (SETQ FILLCOL (- FILLCOL (STRING-WIDTH FILL-PREFIX)))   ; all lines in this paragraph.     (DO ((LINE LINE1 (LINE-NEXT LINE))) ((EQ LINE LINE2))       (IF (STRING-EQUAL LINE FILL-PREFIX :END1 TEM :END2 TEM)   (DELETE-INTERVAL (CREATE-BP LINE 0) (CREATE-BP LINE TEM) T)))))       (DO ((BP START-BP)     ;Squeeze out extra spaces and double space   (CH))     ; after things like .!? etc.  (NIL)(MULTIPLE-VALUE-SETQ (BP CH)     ;Sets bp 1 char past the first blank it found.  (SEARCH-SET BP *BLANKS*))(OR (AND BP (BP-< BP END-BP))    (RETURN NIL))(SETQ CH (BP-CHAR-BEFORE (FORWARD-CHAR BP -1)))     ;CH will be the character preceding the space.     ;Don't try to handle '(#\" #\] #\)) anymore.(COND ((CHAR-EQUAL CH #\NEWLINE)     ;Allow indentation.       (SETQ BP (FORWARD-OVER *BLANKS* BP)))     ;*BLANKS* = '(space tab overstrike)      ((MEMBER (MAKE-CHAR CH)       *FILL-EXTRA-SPACE-LIST* :TEST #'EQ)     ;*FILL-EXTRA-SPACE-LIST* = '(. ! ?)       (SETQ BP (DELETE-OVER *BLANKS*     ;Make it double spaced.     (INSERT-MOVING BP #\SPACE))))      (T(SETQ BP (DELETE-OVER *BLANKS* BP))))     ;Delete any extra spaces between words.(AND (END-LINE-P BP)     ;If we just sailed to the end of the line     (DELETE-BACKWARD-OVER *BLANKS* BP)))     ; remove any trailing blanks.      ;; And now, fill each line in the paragraph.      (DO ((LINE LINE1 (LINE-NEXT LINE))   (SHEET (WINDOW-SHEET *WINDOW*))   (FONT (SEND *WINDOW* :CURRENT-FONT)))  ((EQ LINE LINE2));; Fill this line by concatenating lines under it, until the length of;; this line is greater that the fill size ... then bust it to correct length.(DO ((POS 0)     ;Current position in LINE in pixels.     (CHAR-POS 0)     ;Current position in LINE in characters.     (CP (OR (POSITION #\SPACE LINE :TEST-NOT 'CHAR-EQUAL)   ;Position after upcoming word.     0))     (NBLANKS 0)     ;Number of inter-word gaps.     (BP1 (COPY-BP START-BP))     ;A couple of BPs to play with.     (BP2 (COPY-BP START-BP)))    ((EQ LINE LINE2))  (SETQ POS (W:SHEET-STRING-LENGTH      SHEET LINE CHAR-POS CP NIL FONT POS))          ;Length in pixels of line.  (COND ((> POS FILLCOL)     ;Line overflowed? (AND (< NBLANKS 1) (RETURN NIL))     ;If no blanks yet, don't split the line. (MOVE-BP BP1 LINE (IF (= NBLANKS 1) CP CHAR-POS))   ;If one word long, move past it. (INSERT-MOVING BP1 #\NEWLINE)     ;Make a new line. (DELETE-OVER *BLANKS* BP1)     ;Clear out blanks at front of new line. (MOVE-BP BP2 LINE (LINE-LENGTH LINE))     ;Move to end of old line just split. (DELETE-BACKWARD-OVER *BLANKS* BP2)     ;Remove blanks from end of it. (SETQ NBLANKS (- NBLANKS 2)) (AND ADJUST     ;If they asked us to adjust the right       (PLUSP NBLANKS)     ; column and we have some blank       (ADJUST-LINE LINE NBLANKS FILLCOL))     ; spaces, then adjust this line. (RETURN NIL)))  (SETQ CHAR-POS CP)  (COND ((= CHAR-POS (LINE-LENGTH LINE))     ;Have we used up all the words in this line?  (IF (EQ LINE2 (LINE-NEXT LINE))     ;Line2 is out of range for this paragraph,      (RETURN NIL))     ; so we are done filling this line.  (MOVE-BP BP1 LINE CHAR-POS)     ;Set bp1 to point to end of line.  (IF (MEMBER (BP-CHAR-BEFORE BP1)     ;If line ends in . ! ? etc., (changed order 4-1-87)      *FILL-EXTRA-SPACE-LIST* :TEST #'EQ)    ; add an extra space.      (INSERT-MOVING BP1 #\SPACE))       (INSERT-MOVING BP1 #\SPACE)     ;Add a space between words.  (INCF NBLANKS)     ;Count the blank we just added.  (MOVE-BP BP2 (LINE-NEXT (BP-LINE BP1)) 0)     ;Set bp2 to point at beg of next line.  (DELETE-INTERVAL BP1 BP2 T))     ;Concatenate the two lines.;; Find the next space in the line. ((SETQ CP (POSITION #\SPACE (THE STRING (STRING LINE))    :START (1+ CHAR-POS)    :TEST #'CHAR-EQUAL)) (OR (AND (= CP (1+ CHAR-POS))     ;Spaces side by side (after periods, etc).  (CHAR-EQUAL (MAKE-CHAR (AREF LINE CHAR-POS))      #\SPACE))     (INCF NBLANKS)))     ;Or we found a new inter-word space.;; No more spaces on this line.;; Move BP to the end of the line.(T (SETQ CP (LINE-LENGTH LINE))))))     ;Force it to get the next line next loop.      ;;Now we are finished except for inserting the fill prefix.      (AND (PLUSP (LENGTH FILL-PREFIX))   (DO ((LINE LINE1 (LINE-NEXT LINE)))       ((EQ LINE LINE2))     (INSERT (CREATE-BP LINE 0) FILL-PREFIX))))    ;;If there were tabs in the fill prefix, we need to tabify the    ;; interval so that subsequent fills work properly (4-1-87).    (WHEN (LISP:FIND #\TAB SAVED-FILL-PREFIX)      (TABIFY-INTERVAL BEGIN-BP (CREATE-BP LINE2 0) T))))(DEFUN ADJUST-LINE (LINE NBLANKS FILL-COLUMN &AUX NEEDED AVG EXTRA EXPER)  "Justify LINE to extend to FILL-COLUMN (in units of pixels).NBLANKS is the number of word-separators within LINEat which blanks can be inserted.  Yes, this is redundant."  (SETQ NEEDED (FLOOR (- FILL-COLUMN (STRING-WIDTH LINE)) (FONT-SPACE-WIDTH))AVG (FLOOR NEEDED NBLANKS)EXTRA (REM NEEDED NBLANKS)EXPER (COND ((ZEROP EXTRA) 0)    (T (FLOOR (+ NBLANKS (1- EXTRA)) EXTRA))))  (DO ((N NBLANKS (1- N))       (BP (FORWARD-OVER *BLANKS* (CREATE-BP LINE 0)));don't mess with para indentation gsl.3-17-85       (EXP EXPER (1- EXP))       (I AVG AVG))      ((= N 0))    (OR (SETQ BP (SEARCH BP #\SPACE NIL NIL NIL (END-OF-LINE LINE)))(FERROR NIL "Not enough spaces to adjust with in ~S" LINE))    (SETQ BP (FORWARD-OVER *BLANKS* BP))    (AND (> EXTRA 0) (= EXP 1) (SETQ I (1+ I)       EXTRA (1- EXTRA)       EXP EXPER))    (DO ((I I (1- I)))((= I 0) NIL)      (INSERT-MOVING BP #\SPACE)))) ;;;Common indenter for Tab, C-M-Q, and friends(DEFUN INDENT-INTERVAL-FOR-LISP (BP1 &OPTIONAL BP2 IN-ORDER-P START-BP (COMMENTS-P T))  "Indent all the lines in the specified interval for Lisp.Specify either an interval or two BPs.A line is in the interval iff its beginning is included.START-BP is a place to start parsing from; it defaults \"right\".COMMENTS-P if NIL means do not reindent the comments as comments."  (GET-INTERVAL BP1 BP2 IN-ORDER-P)  (OR START-BP (SETQ START-BP (FORWARD-DEFUN BP1 -1 T)))  (LISP-PARSE-FROM-DEFUN (BP-LINE BP2) START-BP)  (INTERVAL-LINES (BP1 BP2) (START-LINE STOP-LINE)    (DO ((LINE START-LINE (LINE-NEXT LINE)) (*LISP-PARSE-PREPARSED-FLAG* T) (BP) (INDENTATION) (IN-STRING))((EQ LINE STOP-LINE) BP2)      (SETQ BP (CREATE-BP LINE 0))      (COND ((AND COMMENTS-P  (PLUSP (LINE-LENGTH LINE))  (MULTIPLE-VALUE-BIND (NIL NIL COMMENT)      (LISP-BP-SYNTACTIC-CONTEXT (CREATE-BP LINE 1) START-BP)    COMMENT))     (SETQ INDENTATION NIL))    (T     (MULTIPLE-VALUE-SETQ (INDENTATION IN-STRING) (INDENT-FOR-LISP BP START-BP))))      (COND ((NOT IN-STRING);Dont touch lines inside a string     (AND INDENTATION (INDENT-LINE BP INDENTATION))     (AND COMMENTS-P (INDENT-FOR-COMMENT BP))))      (OR (EQ (LINE-NEXT LINE) STOP-LINE)  (LISP-PARSE-LINE-MEMOIZED LINE IN-STRING))))) (DEFMACRO UNKEYWORDIFY (SYM)  `(OR (AND (EQ (SYMBOL-PACKAGE ,SYM) PKG-KEYWORD-PACKAGE)    (FIND-SYMBOL ,SYM PKG-GLOBAL-PACKAGE))       ,SYM))(DEFUN INDENT-FOR-LISP (BP &OPTIONAL START-DEFUN-BP&AUX BP1 BP2 INDENTATION OFFSET SYM TEMSPACE-WIDTH NSEXPS LASTPAREN LASTSEXP IN-STRING)  "Returns the indentation in pixels BP's line should have, for Lisp indent.Second value is non-NIL if the line starts inside a string,in which case the caller may decide not to reindent it at all.START-DEFUN-BP is a BP to start parsing from, presumably before BP's line.*LISP-INDENT-OFFSET* is the amount to offset if there isn't a complete sexp on another line.*LISP-DEFUN-INDENTATION* is the amount to indent for top-level forms.*USE-LISP-INDENT-OFFSET-FOR-INDENTATION* is NIL only while executing Indent Differently commmands.The LISP-INDENT-OFFSET property of a symbol is an offset-list specifying  (number-of-sexps-to-skip amount-to-change-indentation ...)  or if it is a symbol or function, it is funcall'ed and can return  the indentation, an offset, or a bp whose indentation to use.  See DEFINE-INDENTATION in the MACROS file for more information."  (BLOCK NIL    (SETQ BP (CREATE-BP (BP-LINE BP) 0)  BP1 (OR START-DEFUN-BP  (SETQ START-DEFUN-BP (FORWARD-DEFUN BP -1 T))))    (SETQ IN-STRING (LISP-PARSE-FROM-DEFUN (BP-LINE BP) BP1))    (AND IN-STRING (RETURN (VALUES 0 IN-STRING)))    (SETQ LASTPAREN (FORWARD-SEXP BP -1 NIL 1 BP1 NIL))    ;; Get BP to last unterminated paren (up one level).  Sixth argument of NIL makes    ;; sure we get an open paren and not a single-quote (forward or backward).    (SETQ LASTSEXP (FORWARD-SEXP BP -1 NIL 0 BP1))    ;; Get BP to start of last complete sexp, or NIL if none at this level.    (AND LASTPAREN LASTSEXP (BP-= LASTSEXP LASTPAREN) (SETQ LASTSEXP NIL))    (SETQ OFFSET 0  SPACE-WIDTH (FONT-SPACE-WIDTH))    (AND LASTPAREN;Try to find the indentation for the current function (LET ((BP2 (FORWARD-CHAR LASTPAREN)))   (LET ((I (BP-INDEX BP2)))     (SETQ SYM (DO ((J I (1+ J))    (LINE (BP-LINE BP2))    (LENGTH (LINE-LENGTH (BP-LINE BP2))))   ((OR (>= J LENGTH)(AND (/= (LIST-SYNTAX (AREF LINE J)) LIST-ALPHABETIC)     (/= (LIST-SYNTAX (AREF LINE J)) LIST-COLON)))    (AND (/= I J) (CATCH-ERROR (READ-FROM-STRING (STRING-REMOVE-FONTS (NSUBSTRING LINE I J))NIL '*EOF*)      NIL)))))     ;; Beware of funny read syntax, numbers, etc.     (OR (SYMBOLP SYM) (SETQ SYM NIL)))) (SETQ TEM (IF *USE-LISP-INDENT-OFFSET-FOR-INDENTATION*        (OR (GET (UNKEYWORDIFY SYM) 'LISP-INDENT-OFFSET)   (AND (STRING-EQUAL SYM "DEF" :START1 0 :START2 0 :END1 3 :END2 3)*LISP-DEFUN-INDENTATION*)))) ;; This property on the plist => value is either ;; an indentation list or a function to call. (COND ((CONSP TEM);Indentation list, see how do handle this depth;; How many sexps at this level precede point?  Set NSEXPS.;; But, first, let's see how many are interesting (that's (1- MAX-I) ).;; Don't keep counting NSEXPS when it's already larger than is interesting.(DO ((BP3 (FORWARD-CHAR LASTPAREN 1) (FORWARD-SEXP BP3 1 NIL 0 BP))     (MAX-I (1+ (CAR (NLEFT 2 TEM))))     (I 0 (1+ I)))    ((NULL BP3) (SETQ NSEXPS (- I 2)))  (AND (> I MAX-I) (RETURN NIL)));; Now see what the indentation lists says about that many sexps.(AND NSEXPS     (DO ((L TEM (CDDR L))  (I 0)) ((OR (NULL L) (> I NSEXPS)))       (AND (= (SETQ I (CAR L)) NSEXPS)    (SETQ OFFSET (CADR L)  LASTSEXP NIL)))))       (T(MULTIPLE-VALUE-SETQ (BP2 INDENTATION OFFSET)    (FUNCALL TEM BP1 BP LASTPAREN LASTSEXP SPACE-WIDTH SYM)))))    (SETQ BP1 (DO () (NIL)(COND ((NULL LASTPAREN);If already balanced, nothing to do       (RETURN BP))      (BP2;Specified what to indent to       (RETURN BP2))      (INDENTATION);Specified how far to indent      ;;If there is no complete sexp at this paren depth, line up just after      ;;the leftparen.      ((OR (NULL LASTSEXP) (BP-< LASTSEXP LASTPAREN))       (RETURN (FORWARD-CHAR LASTPAREN)))      (T       (SETQ BP1 (CREATE-BP (BP-LINE LASTSEXP) 0))       ;;If complete sexp is on different line than the unmatched leftparen,       ;;line up with start of sexp's line.       (COND ((OR (NULL LASTPAREN) (BP-< LASTPAREN BP1))      (SETQ BP1 (FORWARD-OVER *BLANKS* BP1))      ;;OK only if the first on the line or at that level.      ;; If LASTSEXP is first nonblank thing on its line, use it.      ;; Also if there are no unmatched close parens preceding it,      ;; use the first nonblank thing on that line      ;; since that must be at LASTSEXP's level.      (AND (OR (BP-= BP1 LASTSEXP)       (NOT (FORWARD-SEXP BP1 1 NIL 1 LASTSEXP)))   (RETURN BP1))      ;; LASTSEXP follows on the same line as an unmatched close.      ;; Back up one sexp from it.      ;; Eventually this moves back across that unmatched close      ;; and the sexp that it terminates, to another line.      (SETQ LASTSEXP (FORWARD-SEXP LASTSEXP -1 ())))     ;;Otherwise, maybe user specified how to handle this case     (*LISP-INDENT-OFFSET* (SETQ OFFSET (+ *LISP-INDENT-OFFSET* OFFSET))   (RETURN (FORWARD-CHAR LASTPAREN)))     ;;If only one element in list so far, line up under left-paren     ;;also if the CAR doesnt look like the name of a function     ((SETQ TEM (INDENT-NOT-FUNCTION-P LASTPAREN       (SETQ BP2 (FORWARD-CHAR LASTPAREN))       START-DEFUN-BP))      (IF (NUMBERP TEM)  (SETQ OFFSET TEM))      (RETURN BP2))     ((BP-< LASTSEXP (SETQ BP1 (FORWARD-SEXP BP2)))      (SETQ OFFSET (IF (COND-CLAUSE-SUPERIOR-P LASTPAREN START-DEFUN-BP)       0       *LISP-INDENT-LONE-FUNCTION-OFFSET*))      (RETURN BP2))     ;;Otherwise line up with start of the second element of that list     (T      (RETURN (SKIP-OVER-BLANK-LINES-AND-COMMENTS(SKIP-OVER-BLANK-LINES-AND-COMMENTS BP1)))))))))    (OR INDENTATION (SETQ INDENTATION (MAX 0 (+ (* OFFSET SPACE-WIDTH) (BP-INDENTATION BP1)))))    (RETURN (VALUES INDENTATION IN-STRING)))) (DEFUN COND-CLAUSE-SUPERIOR-P (BP START-DEFUN-BP &AUX SUPBP LINE IDX)  "T if the list at BP should have its lines indented as a COND clause.This looks for the function called by the list around BP in *COND-CLAUSE-SUPERIORS*."  (AND (NOT (BEG-LINE-P BP))       (SETQ SUPBP (FORWARD-SEXP BP -1 NIL 1 START-DEFUN-BP NIL))       (EQ (SETQ IDX (BP-INDEX (IBP SUPBP)) LINE (BP-LINE SUPBP))   (BP-LINE (SETQ SUPBP (FORWARD-SEXP SUPBP 1 NIL 0      ;; Don't let it take too long!      ;; Quite likely there are closeparens missing      ;; and this would scan to the end of the buffer      (BEG-OF-LINE (LINE-NEXT LINE))))))       (MEMBER (FIND-SYMBOL (STRING-UPCASE (NSUBSTRING LINE IDX (BP-INDEX SUPBP)))    PKG-GLOBAL-PACKAGE)       *COND-CLAUSE-SUPERIORS* :TEST #'EQ))) (DEFUN INDENT-NOT-FUNCTION-P (BP BP2 LIMIT-BP &AUX SUPBP LINE IDX TEM)  "Returns non-NIL if the list at BP should not be indented as an expression.The value may be T, or it may be an offset to usein indenting the second line of that list.The decision is based on *INDENT-NOT-FUNCTION-SUPERIORS*.BP2 should point to the first element of the list that surrounds BP.LIMIT-BP should be a place to stop backward searches,such as the start of the defun."  ;; Do that for any list whose car is not an atom,  ;; unless it is a cond-clause (as determined by the list one level up).  (OR (AND (/= (LIST-SYNTAX (SETQ TEM (BP-CH-CHAR BP2))) LIST-ALPHABETIC)   (NOT (MEMBER TEM '(#\: #\/ #\|) :TEST #'EQ));These are really atoms   (NOT (COND-CLAUSE-SUPERIOR-P BP LIMIT-BP)))      ;; Do that also if the list one level up makes it clear      ;; that this is a list of variables to be bound, or some such thing.      (AND (NOT (BEG-LINE-P BP))   (SETQ SUPBP (FORWARD-SEXP BP -1 NIL 1 LIMIT-BP NIL))   ;; Does that first element fit on one line?   (EQ (SETQ IDX (BP-INDEX (IBP SUPBP))     LINE (BP-LINE SUPBP))       (BP-LINE (SETQ SUPBP (FORWARD-SEXP SUPBP 1 NIL 0 (BEG-LINE SUPBP 1)))))   ;; Is it a function mentioned in *INDENT-NOT-FUNCTION-SUPERIORS*?   (SETQ TEM (DO ((SYM (FIND-SYMBOL (STRING-UPCASE (NSUBSTRING LINE IDX (BP-INDEX SUPBP)))    PKG-GLOBAL-PACKAGE))  (L *INDENT-NOT-FUNCTION-SUPERIORS* (CDR L))) ((NULL L) NIL)       (AND (EQ SYM (IF (ATOM (CAR L))(CAR L)(CAAR L)))    (RETURN (CAR L)))))   ;; TEM is the element of *INDENT-NOT-FUNCTION-SUPERIORS* for our superior.   ;; Now, is the position of our list in the superior list   ;; that which the superior says is not a function?   ;; If it isn't, return T or an offset.   (COND ((ATOM TEM)  (BP-= BP (FORWARD-OVER *WHITESPACE-CHARS* SUPBP))) ((EQ (CADR TEM) T)  (IF (NUMBERP (CADDR TEM))      (CADDR TEM)      T)) (T  (DO ((ELTS (CDR TEM) (CDDR ELTS)))      ((NULL ELTS))    (IF (BP-= BP (FORWARD-OVER *WHITESPACE-CHARS*       (FORWARD-SEXP SUPBP     (1- (CAR ELTS))     T 0 (FORWARD-CHAR BP 1))))(RETURN (IF (NUMBERP (CADR ELTS))    (CADR ELTS)    T)))))))))        ;; Also used for TAGBODY; then it knows there is no variable list.(DEFUN INDENT-PROG (IGNORE BP LASTPAREN IGNORE IGNORE SYM)  (LET* ((THIS-LINE (BP-LINE BP)) (ATOM-P (EQ (LINE-TYPE THIS-LINE) :ATOM)) (LAST-TAG-BP NIL) (LAST-NON-TAG-BP NIL) (BP2 (FORWARD-SEXP (FORWARD-CHAR LASTPAREN)    (IF (EQ SYM 'TAGBODY) 1 2)    T 0 BP)))    (AND BP2 ;; Find the last tag and the last statement. (DO ((LINE))     (NIL)   (SETQ BP2 (FORWARD-OVER *WHITESPACE-CHARS* BP2))   (OR (BP-< BP2 BP) (RETURN NIL))   (AND (BEG-LINE-P (BACKWARD-OVER *BLANKS* BP2))(NEQ (SETQ LINE (BP-LINE BP2)) THIS-LINE)(CASE (LINE-TYPE LINE)      (:ATOM (SETQ LAST-TAG-BP BP2))      (:NORMAL (SETQ LAST-NON-TAG-BP BP2))))   (OR (SETQ BP2 (FORWARD-SEXP BP2 1 NIL 0 BP))       (RETURN NIL))))    ;; Try indenting a tag on basis of last tag, and a statement on basis of last statement.    (COND ((AND ATOM-P LAST-TAG-BP)   (VALUES LAST-TAG-BP NIL 0))  ((AND (NOT ATOM-P) LAST-NON-TAG-BP)   (VALUES LAST-NON-TAG-BP NIL 0))  ;; This is a statement and nothing so far except tags; use the last tag.  (LAST-TAG-BP   (VALUES LAST-TAG-BP NIL (- *PROG-FORM-INDENT-OFFSET*      *PROG-TAG-INDENT-OFFSET*)))  ;; Tag with no preceding tags, only statements.  (LAST-NON-TAG-BP   (VALUES LAST-NON-TAG-BP NIL (- *PROG-TAG-INDENT-OFFSET*  *PROG-FORM-INDENT-OFFSET*)))  ;; This is the first tag or statement.  ((EQ SYM 'TAGBODY)   (VALUES LASTPAREN NIL (+ 4 (IF ATOM-P  *PROG-TAG-INDENT-OFFSET*  *PROG-FORM-INDENT-OFFSET*))))  (T (VALUES NIL NIL (IF ATOM-P *PROG-TAG-INDENT-OFFSET* *PROG-FORM-INDENT-OFFSET*))))))  mouse sensitivty with this STREAMP clause.;; grj -- add stream-width to the default-list-one-file call and use output-string;;       in the :ELSE instead of calling default-list-one-file again.((S