LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032410. :SYSTEM-TYPE :LOGICAL :VERSION 2. :TYPE "LISP" :NAME "COMC" :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 2758290631. :AUTHOR "REL3" :LENGTH-IN-BYTES 23846. :LENGTH-IN-BLOCKS 24. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  ;;; Zwei compiler commands, see ZWEI;COMA for comments -*- 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) 1984 ,1987 Texas Instruments Incorporated. All rights reserved.;;; Copyright (C) 1980, Massachusetts Institute of Technology;;;  Change user command references to the words "MINI BUFFER" to the single word "MINIBUFFER".;;;  gmb 2/22/85(DEFCOM COM-EVALUATE-MINIBUFFER "Evaluate a form from the minibuffer." (KM)   (EVALUATE-MINI-BUFFER)) (DEFUN EVALUATE-MINI-BUFFER (&OPTIONAL INITIAL-CONTENTS INITIAL-CHAR-POS &AUX INTERVAL)  "Read an expression with a mini buffer, and evaluate it.INITIAL-CONTENTS is a string to initialize the contents from, andINITIAL-CHAR-POS is where to put the cursor, as a number ofcharacters from the beginning."  (UNWIND-PROTECT   ;; From patch 94.190. ddd/gsl 3/4/84.   (PROGN     (COMMAND-STORE 'COM-INDENT-FOR-LISP #\TAB *MINI-BUFFER-MULTI-LINE-COMTAB*) ;pardon the kludge     (MULTIPLE-VALUE-SETQ (NIL NIL INTERVAL)       (EDIT-IN-MINI-BUFFER *MINI-BUFFER-MULTI-LINE-COMTAB* INITIAL-CONTENTS INITIAL-CHAR-POS    '("Forms to evaluate (end with End)"))))   (COMMAND-STORE 'COM-INSERT-TAB #\TAB *MINI-BUFFER-MULTI-LINE-COMTAB*)); patch 94.190.  (LET ((FORM-STRING (STRING-INTERVAL INTERVAL)))    (DO ((I 0) (FORM) (EOF '(NIL)))(NIL)      (CONDITION-CASE (ERROR) (MULTIPLE-VALUE-SETQ (FORM I)   (READ-FROM-STRING FORM-STRING () EOF :START I)) (SYSTEM:READ-ERROR (BARF (SEND ERROR :REPORT-STRING)) (RETURN ())))      (COND((EQ FORM EOF) (RETURN ())))      (FRESH-LINE *QUERY-IO*)      (DO ((VALS    (LET ((*STANDARD-INPUT* SI:SYN-TERMINAL-IO))      (MULTIPLE-VALUE-LIST (SI:EVAL-ABORT-TRIVIAL-ERRORS FORM))); si:eval1 internally.    (CDR VALS))   (FLAG T NIL))  ((NULL VALS))(FORMAT *QUERY-IO* "~:[, ~]~S" FLAG (CAR VALS))))    )  DIS-TEXT) ;DIS-TEXT in case user manually alters the buffer with Lisp code(DEFCOM COM-EVALUATE-INTO-BUFFER "Evaluate a form from the mini-buffer and insert the results intothe buffer. If there are multiple values, each value is printed into the buffer, with a Return beforeeach one. A numeric argument means output printed by the evaluation also goes in the buffer." (KM)   (LET ((FORM (TYPEIN-LINE-MULTI-LINE-READ "Lisp form: (end with ~C)" #\END)) (STREAM (INTERVAL-STREAM-INTO-BP (POINT))))     (LET ((VALUES    (MULTIPLE-VALUE-LIST     (LET ((*STANDARD-OUTPUT* (IF *NUMERIC-ARG-P* STREAM *STANDARD-OUTPUT*)))       (SI:EVAL-ABORT-TRIVIAL-ERRORS FORM))))); si:eval1 internally.       (DOLIST (V VALUES) (TERPRI STREAM) (FUNCALL (OR PRIN1 'PRIN1) V STREAM)))     (MOVE-BP (POINT) (SEND STREAM :READ-BP)))   DIS-TEXT) (DEFCOM COM-EVALUATE-AND-REPLACE-INTO-BUFFER "Evaluate the next s-expression and replace the resultinto the buffer. The original expression is deleted and the value, printed out, replaces it." ()   (LET* ((POINT (POINT))  (MARK (MARK))  (STREAM (REST-OF-INTERVAL-STREAM POINT))  (FORM (READ STREAM () '*EOF*)))     (AND (EQ FORM '*EOF*) (BARF "Unbalanced parentheses or no form."))     (SETQ FORM (SI:EVAL-ABORT-TRIVIAL-ERRORS FORM)); si:eval1 internally.     (MOVE-BP MARK (SEND STREAM :READ-BP))     (WITH-UNDO-SAVE ("replacement" POINT MARK T) (FUNCALL (OR PRIN1 'PRIN1) FORM STREAM)(WITH-BP (END (SEND STREAM :READ-BP) :NORMAL) (DELETE-INTERVAL POINT MARK T)   (MOVE-BP POINT END))))   DIS-TEXT) (DEFCOM COM-MACRO-EXPAND-EXPRESSION "Print macroexpansion of next s-expression.The result is printed on the screen with PPRINT." ()   (LET ((STREAM (REST-OF-INTERVAL-STREAM (POINT))))     (LET ((FORM (READ STREAM () '*EOF*)))       (AND (EQ FORM '*EOF*) (BARF))       (PPRINT (MACROEXPAND FORM))))   DIS-NONE) (DEFCOM COM-MACRO-EXPAND-EXPRESSION-ALL "Print macroexpansion of next s-expressionto all levels. The result is printed on the screen with PPRINT." ()   (LET ((STREAM (REST-OF-INTERVAL-STREAM (POINT))))     (LET ((FORM (READ STREAM () '*EOF*)))       (AND (EQ FORM '*EOF*) (BARF))       (PPRINT (MACROEXPAND-ALL FORM))))   DIS-NONE) ;; Modified to support non-lisp (e.g. prolog) compiling, by rpm on 12-16-86.(DEFCOM COM-COMPILE-REGION "Compile the current region or defun.If there is a region, it is compiled.Otherwise, the current or next defun is compiled.In that case, DEFVARs reset the variable even if already bound." ()  (LET ((COMPILE-REGION-FUNCTION (OR (AND (BOUNDP '*INTERVAL*)  (GET (SEND *INTERVAL* :MAJOR-MODE) 'COMPILE-REGION-FUNCTION))     'COMPILE-DEFUN-INTERNAL)))    (FUNCALL COMPILE-REGION-FUNCTION T "Compiling" "compiled."))  DIS-NONE) (DEFCOM COM-EVALUATE-REGION "Evaluate the current region or defun.Result is typed out in the echo area.If there is a region, it is evaluated.Otherwise, the current or next defun is evaluated.In that case, DEFVARs reset the variable even if already bound." ()   (COMPILE-DEFUN-INTERNAL (GET-BUFFER-EVALUATOR *INTERVAL*) "Evaluating" "evaluated."   (COND ((>= *NUMERIC-ARG* 20) T) ;;cond added. gsl 3-16-85 ((>= *NUMERIC-ARG* 4) :TYPEOUT) (T :PROMPT)))   DIS-NONE) (DEFCOM COM-EVALUATE-REGION-VERBOSE "Evaluate the current region or defun.Result is typed out in the typeout window.If there is a region, it is evaluated.Otherwise, the current or next defun is evaluated.In that case, DEFVARs reset the variable even if already bound." ()  (COMPILE-DEFUN-INTERNAL (GET-BUFFER-EVALUATOR *INTERVAL*) "Evaluating" "evaluated." T)  DIS-NONE) (DEFCOM COM-EVALUATE-REGION-HACK "Evaluate the current region or defun.DEFVARs reset the variable even if already bound.If there is a region, it is evaluated.Otherwise, the current or next defun is evaluated." ()  (COMPILE-DEFUN-INTERNAL (GET-BUFFER-EVALUATOR *INTERVAL*) "Evaluating" "evaluated." :PROMPT T)  DIS-NONE) (DEFUN COMPILE-DEFUN-INTERNAL (COMPILE-P MODE-NAME ECHO-NAME &OPTIONAL USE-TYPEOUT SI:*FORCE-DEFVAR-INIT*       (COMPILER-PROCESSING-MODE 'COMPILER:MACRO-COMPILE) &AUX BP1 BP2       DEFUN-NAME)  "Compile or evaluate a part of the current buffer.COMPILE-P is T to compile, NIL to eval, or else a function to evaluate and print a form.If there is a region, it is used; otherwise the current or following defun is used.USE-TYPEOUT is passed to COMPILE-PRINT-INTERVAL and controls where information is printed.SI:*FORCE-DEFVAR-INIT* says always re-set variables if DEFVARs are evaluated. Normally this is only done if there is no region.MODE-NAME is a string containing a capitalized present participle, such as \"Compiling\".ECHO-NAME is a string containing a lowecase past participle and period (\"compiled.\")."  (IF (WINDOW-MARK-P *WINDOW*)     (PROGN       (SETQ BP1 (MARK) BP2 (POINT))       (OR (BP-< BP1 BP2) (PSETQ BP1 BP2 BP2 BP1))       (IF(BP-= (FORWARD-OVER *WHITESPACE-CHARS* (MARK))      ;;It is possible to have an invisible region, gsl.3-85            (FORWARD-OVER *WHITESPACE-CHARS* (POINT)))(SETQ *MARK-STAYS* ());; You don't want to compile it, let's get rid of it. gsl(SETQ DEFUN-NAME "Region"))))  (COND (DEFUN-NAME)((SETQ BP1 (DEFUN-INTERVAL (BEG-LINE (POINT)) 1 () ())) (SETQ BP2 (INTERVAL-LAST-BP BP1) BP1 (INTERVAL-FIRST-BP BP1)) (SETQ SI:*FORCE-DEFVAR-INIT* T))(T (BARF "Unbalanced parentheses")))  (COMPILE-PRINT-INTERVAL BP1 BP2 T COMPILE-P DEFUN-NAME MODE-NAME ECHO-NAME USE-TYPEOUT  SI:*FORCE-DEFVAR-INIT* COMPILER-PROCESSING-MODE)) (DEFCOM COM-EVALUATE-BUFFER "Evaluate the entire buffer." ()   (COMPILE-BUFFER (GET-BUFFER-EVALUATOR *INTERVAL*) "Evaluating" "evaluated.")) ;; Modified to support non-lisp (e.g. prolog) compiling, by rpm on 12-16-86.(DEFCOM COM-COMPILE-BUFFER "Compile the entire buffer." ()  (LET ((COMPILE-BUFFER-FUNCTION (OR (AND (BOUNDP '*INTERVAL*)  (GET (SEND *INTERVAL* :MAJOR-MODE) 'COMPILE-BUFFER-FUNCTION))     'COMPILE-BUFFER)))    (FUNCALL COMPILE-BUFFER-FUNCTION T "Compiling" "compiled."))  DIS-NONE)(DEFUN COMPILE-BUFFER (COMPILE-P MODE-NAME ECHO-NAME &OPTIONAL       (COMPILER-PROCESSING-MODE 'COMPILER:MACRO-COMPILE) &AUX BP1 BP2 NAME)  "Compile or evaluate the current buffer.COMPILE-P is T to compile, NIL to eval, or else a function to evaluate and print a form.COMPILE-PROCESSING-MODE is either COMPILER:MACRO-COMPILE or COMPILER:MICRO-COMPILE.MODE-NAME is a string containing a capitalized present participle, such as \"Compiling\".ECHO-NAME is a string containing a lowecase past participle and period (\"compiled.\")."  (IF *NUMERIC-ARG-P* (SETQ BP1 (POINT) BP2 (INTERVAL-LAST-BP *INTERVAL*) NAME "Rest of buffer")      (SETQ BP1 *INTERVAL* NAME "Buffer"))  (COMPILE-PRINT-INTERVAL BP1 BP2 T COMPILE-P NAME MODE-NAME ECHO-NAME  NIL;USE-TYPEOUT  NIL;SI:*FORCE-DEFVAR-INIT*  COMPILER-PROCESSING-MODE)  DIS-NONE) (DEFUN GET-BUFFER-EVALUATOR (BUFFER)  "Return the evaluate-and-print function for BUFFER, or NIL (the default)."  (SEND BUFFER :GET-ATTRIBUTE :EVALUATOR)) (DEFUN COMPILE-PRINT-INTERVAL (BP1 BP2 IN-ORDER-P COMPILE-P REGION-NAME MODE-NAME ECHO-NAME       &OPTIONAL USE-TYPEOUT SI:*FORCE-DEFVAR-INIT* COMPILER-PROCESSING-MODE       ALREADY-RESECTIONIZED-FLAG &AUX FORMAT-FUNCTION SUCCESS)  "Compile or evaluate the interval specified by BP1, BP2, IN-ORDER-P.COMPILE-P is T to compile, NIL to eval, or else a function to evaluate and print a form.REGION-NAME is a string to print as the name of this whole object, or NIL to mention each object's name.USE-TYPEOUT can be T, NIL, :TYPEOUT or :PROMPT.  T prints form values and names of objects in typeout window. Otherwise, form values appear in the echo area, and   :TYPEOUT prints names of objects in typeout window.  :PROMPT prints names of objects in prompt line.  NIL prints names of objects in the echo area.SI:*FORCE-DEFVAR-INIT* says always re-set variables if DEFVARs are evaluated. Normally this is only done if there is no region.COMPILE-PROCESSING-MODE is either COMPILER:MACRO-COMPILE or COMPILER:MICRO-COMPILE.ALREADY-RESECTIONIZED-FLAG should be T to inhibit resectionization.MODE-NAME is a string containing a capitalized present participle, such as \"Compiling\".ECHO-NAME is a string containing a lowecase past participle and period (\"compiled.\")."  (OR COMPILER-PROCESSING-MODE (SETQ COMPILER-PROCESSING-MODE 'COMPILER:MACRO-COMPILE))  (GET-INTERVAL BP1 BP2 IN-ORDER-P)  (UNLESS ALREADY-RESECTIONIZED-FLAG    (CHECK-INTERVAL-SECTIONS BP1 BP2 T))  (UNDO-SAVE-CURRENT-RANGE)  (SETQ FORMAT-FUNCTION     (CASE USE-TYPEOUT       ((T);;:typeout deleted. gsl 3-16-85#'(LAMBDA (STRING   &REST   ARGS)    (APPLY #'FORMAT T STRING ARGS)))       (:PROMPT #'PROMPT-LINE-MORE)       (OTHERWISE #'(LAMBDA (STRING     &REST     ARGS)      (APPLY #'FORMAT *QUERY-IO* STRING ARGS)))))  (IF REGION-NAME (FUNCALL FORMAT-FUNCTION "~&~A ~A" MODE-NAME REGION-NAME)     (FUNCALL FORMAT-FUNCTION "~&~A ~S" MODE-NAME (SECTION-NODE-NAME (BP-NODE BP1))))  (UNWIND-PROTECT (PROGN   (COMPILE-INTERVAL COMPILE-P (CASE USE-TYPEOUT ((T :TYPEOUT) T) ;; :typeout added gsl 3-16-85 (T *QUERY-IO*))     SI:*FORCE-DEFVAR-INIT* BP1 BP2 T COMPILER-PROCESSING-MODE)   (SETQ SUCCESS T))    (OR SUCCESS (FUNCALL FORMAT-FUNCTION " -- aborted.")))  (FUNCALL FORMAT-FUNCTION " -- ~A" ECHO-NAME)  (UPDATE-INTERVAL-COMPILE-TICK BP1 BP2 T)) (DEFUN COMPILE-INTERVAL (COMPILE-P PRINT-RESULTS-STREAM SI:*FORCE-DEFVAR-INIT* BP1 &OPTIONAL BP2 IN-ORDER-P (COMPILE-PROCESSING-MODE 'COMPILER:MACRO-COMPILE) &AUX GENERIC-PATHNAME STREAM WHOLE-FILE;T if processing the entire file. SI:FDEFINE-FILE-DEFINITIONS)  "Compile or evaluate the interval specified by BP1, BP2, IN-ORDER-P.Does not print any sort of message saying what is being compiled,does not know about sectionization.COMPILE-P is T to compile, NIL to eval, or else a function to evaluate and print a form.PRINT-RESULTS-STREAM is a stream for printing the results of evaluation, or NIL not to print.SI:*FORCE-DEFVAR-INIT* says always re-set variables if DEFVARs are evaluated. Normally this is only done if there is no region.COMPILE-PROCESSING-MODE is either COMPILER:MACRO-COMPILE or COMPILER:MICRO-COMPILE.ALREADY-RESECTIONIZED-FLAG should be T to inhibit resectionization."  (DECLARE (SPECIAL COMPILE-P PRINT-RESULTS-STREAM SI:*FORCE-DEFVAR-INIT* COMPILE-PROCESSING-MODE))  (SETQ GENERIC-PATHNAME (SEND *INTERVAL* :GENERIC-PATHNAME))  ;; Does not reparse the mode line; we should let the user decide whether to do that.  ;; Should not override the user's Set Package if he has done one.  (GET-INTERVAL BP1 BP2 IN-ORDER-P)  ;; Decide whether the entire file is being processed or just a part.  ;; If the whole file, we want to notice if any function present in the file previously  ;; is now missing.  If just a part, anything we don't notice now we must assume  ;; is elsewhere in the file.  (SETQ WHOLE-FILE (AND (BP-= BP1 (INTERVAL-FIRST-BP *INTERVAL*))(BP-= BP2 (INTERVAL-LAST-BP *INTERVAL*))))  (SETQ STREAM (INTERVAL-STREAM BP1 BP2 T))  ;; Arrange for first read-error's location to be saved in q-reg ".".  (REMPROP (MAKE-REGISTER-NAME #\. ()) 'POINT)  (MULTIPLE-VALUE-BIND (VARS VALS) (SEND *INTERVAL* :ATTRIBUTE-BINDINGS)    (PROGV VARS   VALS      (WHEN FS:THIS-IS-A-PATCH-FILE;; If compiling out of the editor buffer of a patch file,;; make sure the file itself is marked;; so that Meta-. will behave right.(SETF (GET GENERIC-PATHNAME :PATCH-FILE) T))      ;; Bind off this flag -- our stream is not generating font changes      ;; so READ should not try to remove any.      (LET ((SI:READ-DISCARD-FONT-CHANGES NIL))(FLET ((DO-IT NIL      (COMPILER:COMPILE-STREAM STREAM       GENERIC-PATHNAME       NIL;FASD-FLAG       #'COMPILE-INTERVAL-PROCESS-FN       T;QC-FILE-LOAD-FLAG       NIL;QC-FILE-IN-CORE-FLAG       *PACKAGE*       NIL;FILE-LOCAL-DECLARATIONS       NIL;Unused       WHOLE-FILE       (IF COMPILE-P :COMPILE :EVAL)))); added 8/23/86 DNG  (IF COMPILE-P (COMPILER:LOCKING-RESOURCES-NO-QFASL (DO-IT)) (DO-IT))))))  (COND ((NULL GENERIC-PATHNAME) ;; Changed OR to COND. Patch 98.168, ddd 3/14/84. (SI:RECORD-FILE-DEFINITIONS GENERIC-PATHNAME SI:FDEFINE-FILE-DEFINITIONS WHOLE-FILE)))) (DEFUN COMPILE-INTERVAL-PROCESS-FN (FORM)  ;; 8/25/86 DNG - Merged functions COMPILE-INTERVAL-PROCESS-BASIC-FORM,  ;;COMPILE-BUFFER-FORM and EVAL-PRINT.  Use new function  ;;COMPILE-TOP-LEVEL-FORM.   Print results of compile as well as  ;;eval.  Don't use COMPILE-DRIVER when evaluating.  Eliminated  ;;function COMPILE-INTERVAL-PREPROCESS-FN.  (DECLARE (SPECIAL COMPILE-P PRINT-RESULTS-STREAM COMPILE-PROCESSING-MODE))  (LET ((VALUES-TO-PRINT  (MULTIPLE-VALUE-LIST    (IF COMPILE-P(LET ((COMPILE-VALUE NIL))  (COMPILER:COMPILE-DRIVER    FORM    #'(LAMBDA (FORM TYPE)(SETQ COMPILE-VALUE       (IF (EQ COMPILE-P T) ; use the normal Lisp compiler  (IF (EQ TYPE 'SPECIAL)      (SI:*EVAL FORM)    (COMPILER:COMPILE-TOP-LEVEL-FORM      FORM 'COMPILER:COMPILE-TO-CORE #'SI:*EVAL      (IF (EQ TYPE 'MACRO)  'COMPILER:MACRO-COMPILECOMPILE-PROCESSING-MODE)))(FUNCALL COMPILE-P FORM))) )    NIL NIL T)  COMPILE-VALUE)      (SI:*EVAL FORM)))))    (WHEN PRINT-RESULTS-STREAM      (LET-IF (EQ PRINT-RESULTS-STREAM *QUERY-IO*) ((*PRINT-LENGTH* 5) (*PRINT-LEVEL* 2))(DOLIST (VAL VALUES-TO-PRINT)  (FORMAT PRINT-RESULTS-STREAM "~&~S" VAL))))))(DEFUN INTERVAL-REAL-TICK (BP1 &OPTIONAL BP2 IN-ORDER-P)  "Return the latest tick at which any line in an interval was modified.Pass either an interval or a pair of BPs."  (GET-INTERVAL BP1 BP2 IN-ORDER-P)  (DO ((LINE (BP-LINE BP1) (LINE-NEXT LINE))       (FIRST-LINE (BP-LINE BP1))       (MAX-TICK 0)       (LIMIT (BP-LINE BP2)))      (NIL)    (SETQ MAX-TICK  (MAX MAX-TICK       (LINE-TICK LINE)       (OR (AND (NEQ LINE FIRST-LINE)(GETF (LINE-PLIST LINE) 'PRECEDING-LINES-DELETED-TICK))   0)))    (IF (EQ LINE LIMIT)(RETURN MAX-TICK)))) ;;; These functions know about zmacs buffers and sections.(DEFUN UPDATE-INTERVAL-COMPILE-TICK (BP1 &OPTIONAL BP2 IN-ORDER-P)  "Update the tick-of-last-compilation for all sections in an interval.Pass either an interval or a pair of BPs."  (TICK)  (GET-INTERVAL BP1 BP2 IN-ORDER-P)  (DO ((NODE (BP-NODE BP1) (NODE-NEXT NODE))       (FIRST T ())       TEM)      ((OR (NULL NODE) (NOT (OR FIRST (BP-< (INTERVAL-FIRST-BP NODE) BP2)))))    (WHEN (OR   (NOT FIRST)   ;; If compiled or evaluated only part of the text in a node,   ;; don't set its compile tick.   ;; Now that there is only one form per section,   ;; we can be confident that if the compiled code   ;; started at the beginning of the form,   ;; it must have reached the end,   ;; unless either the compilation bombed out from unmatched parens   ;; or the section contains unmatched parens.   (EQ (BP-LINE BP1) (BP-LINE (INTERVAL-FIRST-BP NODE)))   (AND (SETQ TEM (SEND NODE :SEND-IF-HANDLES :DEFUN-LINE))(BP-< BP1 (CREATE-BP TEM 1))))      (SEND NODE :UPDATE-COMPILE-TICK)))) ;;;  The following changed from COMPILE-BUFFER-CHANGED-SECTIONS  2/26/85  gmb(DEFCOM COM-COMPILE-BUFFER-CHANGED-DEFINITIONS   "Compile any sections in this buffer which have been edited.Only sections that contain definitions will be compiled.A numeric arg means ask about each section individually." ()   (SYSTEM:FILE-OPERATION-WITH-WARNINGS    ((AND (BUFFER-FILE-ID *INTERVAL*)  (SEND (SEND *INTERVAL* :GENERIC-PATHNAME) :GENERIC-PATHNAME))     :COMPILE NIL)    (COMPILER:COMPILER-WARNINGS-CONTEXT-BIND     (COMPILE-BUFFER-CHANGED-FUNCTIONS *INTERVAL* *NUMERIC-ARG-P*)))   (FORMAT T "~&Done.~%")   DIS-NONE) (DEFINE-COMMAND-SYNONYM COM-COMPILE-BUFFER-CHANGED-SECTIONSCOM-COMPILE-BUFFER-CHANGED-DEFINITIONS) (DEFINE-COMMAND-SYNONYM COM-COMPILE-CHANGED-DEFINITIONS-OF-BUFFERCOM-COMPILE-BUFFER-CHANGED-DEFINITIONS) ;;;  The following changed from COMPILE-CHANGED-SECTIONS  2/26/85  gmb(DEFCOM COM-COMPILE-CHANGED-DEFINITIONS"Compile any sections which have been edited.Only sections that contain definitions will be compiled.A numeric arg means ask about each section individually." ()  (DOLIST (BUFFER *ZMACS-BUFFER-LIST*)    (AND (MEMBER (IF (EQ BUFFER *INTERVAL*)     *MAJOR-MODE*     (BUFFER-SAVED-MAJOR-MODE BUFFER)) '(COMMON-LISP-MODE ZETALISP-MODE) :TEST #'EQ) ;; Don't consider buffers never modified. (> (NODE-TICK BUFFER) (BUFFER-FILE-READ-TICK BUFFER)) (SYSTEM:FILE-OPERATION-WITH-WARNINGS   ((AND (BUFFER-FILE-ID BUFFER) (SEND (SEND BUFFER :GENERIC-PATHNAME) :GENERIC-PATHNAME))    :COMPILE NIL)   (COMPILER:COMPILER-WARNINGS-CONTEXT-BIND     (COMPILE-BUFFER-CHANGED-FUNCTIONS BUFFER *NUMERIC-ARG-P*)))))  (FORMAT T "~&Done.~%")  DIS-NONE) (DEFINE-COMMAND-SYNONYM COM-COMPILE-CHANGED-SECTIONSCOM-COMPILE-CHANGED-DEFINITIONS) ;;;  Changed the following from "Tags-Compile-Changed-Sections".  2/22/85  gmb(DEFCOM COM-TAGS-COMPILE-CHANGED-DEFINITIONS   "Compile any sections in files in tag table which have been edited.Only sections that contain definitions will be compiled.A numeric arg means ask about each section individually." ()   (DOLIST (BUFFER (TAG-TABLE-BUFFERS ()))     (AND (MEMBER (IF (EQ BUFFER *INTERVAL*)      *MAJOR-MODE*      (BUFFER-SAVED-MAJOR-MODE BUFFER))  '(COMMON-LISP-MODE ZETALISP-MODE) :TEST #'EQ)  ;; Don't consider buffers never modified.  (> (NODE-TICK BUFFER) (BUFFER-FILE-READ-TICK BUFFER))  (SYSTEM:FILE-OPERATION-WITH-WARNINGS    ((AND (BUFFER-FILE-ID BUFFER)  (SEND (SEND BUFFER :GENERIC-PATHNAME) :GENERIC-PATHNAME))     :COMPILE NIL)    (COMPILER:COMPILER-WARNINGS-CONTEXT-BIND      (COMPILE-BUFFER-CHANGED-FUNCTIONS BUFFER *NUMERIC-ARG-P*)))))   (FORMAT T "~&Done.~%")   DIS-NONE) (DEFINE-COMMAND-SYNONYM COM-TAGS-COMPILE-CHANGED-SECTIONSCOM-TAGS-COMPILE-CHANGED-DEFINITIONS) ;;;  The following changed from EVALUATE-BUFFER-CHANGED-SECTIONS.  2/22/85  gmb(DEFCOM COM-EVALUATE-BUFFER-CHANGED-DEFINITIONS   "Evaluate any sections in this buffer which have been edited.Only sections that contain definitions will be evaluated.A numeric arg means ask about each section individually." ()   (COMPILE-BUFFER-CHANGED-FUNCTIONS *INTERVAL* *NUMERIC-ARG-P* ()     '("Evaluate" "Evaluating" "evaluated."))   (FORMAT T "~&Done.~%")   DIS-NONE) (DEFINE-COMMAND-SYNONYM COM-EVALUATE-BUFFER-CHANGED-SECTIONSCOM-EVALUATE-BUFFER-CHANGED-DEFINITIONS) (DEFINE-COMMAND-SYNONYM COM-EVALUATE-CHANGED-DEFINITIONS-OF-BUFFERCOM-EVALUATE-BUFFER-CHANGED-DEFINITIONS) ;;;  The following changed from EVALUATE-CHANGED-SECTIONS.  2/22/85  gmb(DEFCOM COM-EVALUATE-CHANGED-DEFINITIONS"Evaluate any sections which have been edited.Only sections that contain definitions will be evaluated.A numeric arg means ask about each section individually." ()  (DOLIST (BUFFER *ZMACS-BUFFER-LIST*)    (AND (MEMBER (IF (EQ BUFFER *INTERVAL*)     *MAJOR-MODE*     (BUFFER-SAVED-MAJOR-MODE BUFFER)) '(COMMON-LISP-MODE ZETALISP-MODE) :TEST #'EQ) ;; Don't consider buffers never modified. (> (NODE-TICK BUFFER) (BUFFER-FILE-READ-TICK BUFFER)) (COMPILE-BUFFER-CHANGED-FUNCTIONS BUFFER *NUMERIC-ARG-P* ()   '("Evaluate" "Evaluating" "evaluated."))))  (FORMAT T "~&Done.~%")  DIS-NONE) (DEFINE-COMMAND-SYNONYM COM-EVALUATE-CHANGED-SECTIONSCOM-EVALUATE-CHANGED-DEFINITIONS) ;;;  The following changed from TAGS-EVALUATE-CHANGED-SECTIONS.  2/22/85  gmb(DEFCOM COM-TAGS-EVALUATE-CHANGED-DEFINITIONS"Evaluate any definitions in files in tag table which have been edited.Only sections that contain definitions will be evaluated.A numeric arg means ask about each section individually." ()  (DOLIST (BUFFER (TAG-TABLE-BUFFERS ()))    (AND (EQ (IF (EQ BUFFER *INTERVAL*) *MAJOR-MODE* (BUFFER-SAVED-MAJOR-MODE BUFFER))     'LISP-MODE) ;; Don't consider buffers never modified. (> (NODE-TICK BUFFER) (BUFFER-FILE-READ-TICK BUFFER)) (COMPILE-BUFFER-CHANGED-FUNCTIONS BUFFER *NUMERIC-ARG-P* ()   '("Evaluate" "Evaluating" "evaluated."))))  (FORMAT T "~&Done.~%")  DIS-NONE) (DEFINE-COMMAND-SYNONYM COM-TAGS-EVALUATE-CHANGED-SECTIONSCOM-TAGS-EVALUATE-CHANGED-DEFINITIONS) (DEFUN COMPILE-BUFFER-CHANGED-FUNCTIONS (BUFFER ASK-P &OPTIONAL (COMPILE-P T) (NAMES '("Compile" "Compiling" "compiled.")) &AUX (*QUERY-IO* *STANDARD-OUTPUT*))  "Recompile or evaluate all changed sections in BUFFER (that contain definitions).COMPILE-P is T to compile, NIL to eval, or else a function to evaluate and print a form.ASK-P if non-NIL means query user for each section to be processed.NAMES has three elements, that are like (\"Compile\" \"Compiling\" \"compiled.\")."  (LET ((*INTERVAL* BUFFER))    (RESECTIONIZE-BUFFER *INTERVAL*)    (DOLIST (SECTION (NODE-INFERIORS *INTERVAL*))      (IF (AND (TYPEP SECTION 'SECTION-NODE) (NOT (STRINGP (SECTION-NODE-NAME SECTION)))       (NOT (BP-= (INTERVAL-FIRST-BP SECTION) (INTERVAL-LAST-BP SECTION)))       (> (NODE-TICK SECTION) (SECTION-NODE-COMPILE-TICK SECTION))       (OR (NOT ASK-P)   (FQUERY '(:SELECT T) "~A ~A? " (FIRST NAMES) (SECTION-NODE-NAME SECTION))))  (COMPILE-PRINT-INTERVAL SECTION () T COMPILE-P () (SECOND NAMES) (THIRD NAMES) T T () T))))) eparately.The comments must begin at the start of the line." (KM)  (LET (BP1 BP2 LINE1 LINE2(MINEND 177777)LINE3)    (INTERVAL-LINES ((INTERVAL-FIRST-BP *INTERVAL*) (INTERVAL-LAST-BP *INTERVAL*))    (START-LINE STOP-LINE)      ;; Find beginning of this run of comment lines.      (DO ((LINE (BP-LINE (POINT)) (LINE-PREVIOUS LINE)))  ((NEQ (LINE-TYPE LINE) :COMMENT))(SETQ LINE1 LINE)(IF (EQ LINE START-LINE)    (RETURN)))      ;; If we found nothing, point was not on a comment line.      ;; If point's line is blank and the next nonblank is a comment line, set LINE1 to that.      (OR LINE1  (PROGN    (DO ((LINE (BP-LINE (POINT)) (LINE-NEXT LINE)))((EQ LINE STOP-LINE))      (CASE (LINE-TYPE LI