LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032438. :SYSTEM-TYPE :LOGICAL :VERSION 1. :TYPE "LISP" :NAME "DOC" :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 2758738778. :AUTHOR "REL3" :LENGTH-IN-BYTES 27302. :LENGTH-IN-BLOCKS 27. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   ;;; Self-Documentation. -*- 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;;; Worry about whether DOCUMENTATION-FUNCTION stuff will get called;;; with the right streams set up.  ;;;  Total reorganization. - pf, Apr 19, 1985;;;  Macro for suggestions added by rpm 11-26-86.(DEFCOM COM-DOCUMENTATION "The central documentation command.Options are available:   to find out what a given keystroke does,   to find out what a given named command does,   to find out which commands or variables contain a given substring,   to find out which keystrokes invoke a given command,   to undo the last operation (if possible),   to list the last sixty characters typed inside the editor,   to list the characters available with the symbol key,   to describe a Zwei variable.With a numeric argument, prompt in something like the old style,in the echo area, which may be useful for documenting mouse clicks.The Zwei variable *HELP-PROMPTS-IN-OLD-STYLE*, when T, makes thisbehavior the usual one." ()  (SYS:WITH-SUGGESTIONS-MENUS-FOR ZWEI:COM-DOCUMENTATION    (TYPEIN-LINE-PREPARE)    (COND ((OR *HELP-PROMPTS-IN-OLD-STYLE* *NUMERIC-ARG-P*)   (LET ((OPTIONS (MAPCAR #'CAR *COM-DOCUMENTATION-ALIST*)))     (TYPEIN-LINE "Help.  Type one of ~:@C~{, ~:@C~}, ~:@C, ~:@C, ~:@C."  (FIRST OPTIONS)  (CDR OPTIONS)  #\HELP  #\ABORT  #\SPACE)))  (:ELSE   (FORMAT T "~&Help:~&")   (PRINT-DOCUMENTATION-OPTIONS)))    (LOOP DOING (TYPEIN-LINE "Documentation option: ")  AS CHAR = (SEND *QUERY-IO* :READ-ANY)  AS DOC-FUNCTION-ELT = (UNLESS (CONSP CHAR)  (ASSOC (CHAR-UPCASE CHAR) *COM-DOCUMENTATION-ALIST* :TEST #'EQL))  DOING (COND ((AND (CONSP CHAR)    (EQ (CAR CHAR) :TYPEOUT-EXECUTE))       (FUNCALL (SECOND CHAR) (THIRD CHAR)))      ((AND DOC-FUNCTION-ELT    (OR (NULL (THIRD DOC-FUNCTION-ELT))(NOT (NULL (EVAL (THIRD DOC-FUNCTION-ELT))))))       (TYPEIN-LINE-MORE (COMMAND-NAME (SECOND DOC-FUNCTION-ELT)))       (FUNCALL (SECOND DOC-FUNCTION-ELT))       (FORMAT T "~2&"))      ((EQL CHAR #\HELP)       (PRINT-DOCUMENTATION-OPTIONS))      (:ELSE       ;;  Exit on anything else, including space.       (FORMAT T "~&Exiting ...")       (SEND *STANDARD-OUTPUT* :MAKE-COMPLETE)       (SEND *TYPEIN-WINDOW* :SET-TYPEIN-STATUS :USED)       ;;for standalone editor. gsl 3-28-85       (UNLESS (EQL CHAR #\SPACE) (SEND *STANDARD-INPUT* :UNREAD-ANY CHAR))       (RETURN DIS-NONE)))))) (DEFUN PRINT-DOCUMENTATION-OPTIONS ()  (FORMAT T "~&Type one of the following characters to choose an option:~2&")  (LOOP FOR (HELP-CHAR HELP-COMMAND COND-FORM) IN *COM-DOCUMENTATION-ALIST*WHEN (OR (NULL COND-FORM) (NOT (NULL (EVAL COND-FORM))))DOING (FORMAT T "~&~C  ~A" HELP-CHAR      (LET* ((DOC (DOCUMENTATION HELP-COMMAND))     (FIRST-CR (POSITION #\NEWLINE (THE STRING (STRING DOC)) :TEST #'CHAR-EQUAL)))(IF FIRST-CR    (NSUBSTRING DOC 0 FIRST-CR)    DOC)))FINALLY (FORMAT T "~2&You may continue choosing options until you exit.~   ~2&Press the space bar to exit this command.~    ~&Any other non-option key will exit and be executed.~2&"))) (DEFCOM COM-DOCUMENT-CONTAINING-COMMAND "Print documentation on the command that youare in the middle of." ()  (CONTEXT-CHECK '*OUTER-LEVEL-MINI-BUFFER-COMMAND*)  (FORMAT T "~&You are typing in the minibuffer.Type ~A to go back to editing the previous minibuffer ~A.~@[The command in progress is ~A:~]~%"  (KEY-FOR-COMMAND 'COM-POP-MINIBUFFER-HISTORY *COMTAB* NIL NIL #\c-m-Y)  (IF (CDR *OUTER-LEVEL-MINI-BUFFER-COMMAND*)      "argument of this command"      "command")  (COMMAND-NAME *MINI-BUFFER-COMMAND-IN-PROGRESS* T))  (PRINT-DOC :FULL *MINI-BUFFER-COMMAND-IN-PROGRESS*)  (FRESH-LINE)  (COND (*MINI-BUFFER-ARG-DOCUMENTER* (FUNCALL *MINI-BUFFER-ARG-DOCUMENTER*)))  DIS-NONE) ;;; A command (a COM- symbol) either has "smart" or "normal" handling of;;; documentation.  All commands should have a COMMAND-NAME property, whose;;; value is the nice-looking string form of the command's name.;;; It should also have a DOCUMENTATION property, whose value is the;;; string which is the full documentation.  If short documentation;;; (the one-line kind produced by List Commands) is needed, it is just;;; the first line of the full documentation.;;; A command with "smart" handling is detected by the presence of;;; a DOCUMENTATION-FUNCTION property.  The value of this property;;; should be a function, which is called with three arguments:;;;    First, the command symbol itself.;;;    Secondly, the character typed to get this command, or NIL.  If the second;;;       argument is NIL, that means that the caller does not have any particular;;;       character in mind (e.g. in List Commands).  The documentation-function;;;       should be prepared to deal with this case.;;;    Thirdly, an operation which tells the function what to do.  They are:;;;       :NAME  Return your name as a string, (e.g. "Self Insert");;;       :FULL  Type out full documentation to *STANDARD-OUTPUT*.;;;       :SHORT Type out short documentation to *STANDARD-OUTPUT*.;;; The symbols on the *COMMAND-HOOK* may also want to document;;; themselves when the user asks for self-documentation.  Any hook;;; which does should have a HOOK-DOCUMENTATION-FUNCTION property,;;; whose value is a function of two arguments: the command which the;;; hook is preceeding, and the character typed.  (The second argument;;; will never be NIL.) This function will only be called on the user's;;; request for FULL (not SHORT) documentation. The function should print;;; out stuff to *STANDARD-OUTPUT*.  It may assume the cursor is at the left;;; edge, and it should leave the cursor there.(DEFCOM COM-SELF-DOCUMENT "Print out documentation for the command on a given key." (KM)  (LET (CHAR)    (FORMAT *QUERY-IO* "~&Document command: ")    (TYPEIN-LINE-ACTIVATE      (WITHOUT-IO-BUFFER-OUTPUT-FUNCTION(SETQ CHAR (W:READ-ANY *QUERY-IO*))))    (LOOP      (AND (CONSP CHAR)   (EQ (CAR CHAR) :MOUSE-BUTTON)   (SETQ CHAR (SECOND CHAR)))      (COND ((ATOM CHAR)     (FORMAT *QUERY-IO* "~:@C" CHAR)     (DOCUMENT-KEY CHAR *COMTAB*)     (RETURN))    ((EQ (CAR CHAR) :TYPEOUT-EXECUTE)     (FORMAT T "~a:~%" (SECOND CHAR))     (PRINT-DOC :FULL (SECOND CHAR))     (RETURN))    ((EQ (CAR CHAR) 'SCROLL)     (FORMAT *QUERY-IO* "Mouse-Scroll")     (FORMAT T     "Mouse Scrolling:  When the mouse cursor is an up-and-down arrow, near the left edge,it is in the \"scroll bar\".  Clicking the mouse in the scroll barscrolls the text in the window.When the mouse is near the top or bottom edge and the cursor is a thick arrow,that too is a place you can scroll, by pushing the mouse against the edge.In the scroll bar, click left to scroll the line the mouse is on to thetop of the window.  Click right scrolls the same amount in the oppositedirection; the line at the top of the window moves down to the mouse.Click middle uses the position of the mouse along the edge to choosea portion of the buffer to view, so that if the mouse is near the bottomyou see something near the end of the file.A portion of the left edge is thickened to show you what part of thebuffer is currently on the screen.")     (RETURN)))))  DIS-NONE) (DEFUN DOCUMENT-KEY (CHAR COMTAB)  "Print full documentation of character CHAR's definition in COMTAB, on *STANDARD-OUTPUT*."  (IF (OR (ATOM CHAR)  (AND (CONSP CHAR)       (EQ (CAR CHAR) :MOUSE-BUTTON)       (SETQ CHAR (SECOND CHAR))))      (FORMAT T "~&~:@C" CHAR)      (FORMAT T "~&~S" CHAR))  (PROG (TEM PREFIX)     L (SETQ TEM (COMMAND-LOOKUP CHAR COMTAB T))(COND ((NULL TEM)       (FORMAT T " is undefined.~%"))      ((SYMBOLP TEM)       (IF (NOT (GET TEM 'COMMAND-NAME))   (FORMAT T " is ~A, which is not implemented.~%" TEM)   (PROGN     (FORMAT T " is ~A, implemented by " (COMMAND-NAME TEM))     (SEND *STANDARD-OUTPUT* :ITEM 'FUNCTION-NAME TEM)     (FORMAT T ":~%")     (DO ((L *COMMAND-HOOK* (CDR L))) ((NULL L)  NIL)       (LET ((DOCFN (GET (CAR L) 'HOOK-DOCUMENTATION-FUNCTION))) (AND DOCFN (FUNCALL DOCFN TEM CHAR))))     (PRINT-DOC :FULL TEM CHAR))))      ((CONSP TEM)       (FORMAT T " is an alias for ~@[~:@C ~]~:@C.~%~@[~:@C ~]~:@C" PREFIX       (SETQ CHAR (MAKE-CHAR (SECOND TEM) (FIRST TEM)))       PREFIX CHAR)       (GO L))      ((MACRO-COMMAND-P TEM)       (FORMAT T       " is a user defined macro named ~A.With no argument, run the macro with the repeat count in its definition.With an argument, ignore the repeat count in its definition and usethe argument instead.~%"       (SYMEVAL-IN-CLOSURE TEM 'SYMBOL)))      ((PREFIX-COMMAND-P TEM)       (FORMAT T " is an escape-prefix for more commands.It reads a character (subcommand) and dispatches on it.Type a subcommand to document (or * for all):~%")       (SETQ PREFIX CHAR     CHAR (WITHOUT-IO-BUFFER-OUTPUT-FUNCTION (READ-CHAR)))       (FORMAT T "~%~:@C" PREFIX)       (COND ((CHAR= CHAR #\*)      (FORMAT T " has these subcommands:~%")      (DOCUMENT-PREFIX-CHAR-TABLE (GET-PREFIX-COMMAND-COMTAB TEM)))     (T      (FORMAT T " ~:@C" CHAR)      (SETQ COMTAB (GET-PREFIX-COMMAND-COMTAB TEM))      (GO L))))      ((MENU-COMMAND-P TEM)       (FORMAT T " is a menu command with the following subcommands:~%")       (DO ((L (GET-MENU-COMMAND-COMMANDS TEM) (CDR L))    (FLAG T NIL))   ((NULL L) (TERPRI)) (FORMAT T "~:[, ~]~A" FLAG (CAAR L))))      (T (FORMAT T " is garbage!?~%"))))) (DEFUN DOCUMENT-PREFIX-CHAR-TABLE (COMTAB)  (LOOP FOR BUCKY FROM 0 BELOW 20 DOING(LOOP FOR LETTER FROM 0 BELOW 400      AS KEY = (CODE-CHAR LETTER BUCKY)      DOING (PRINT-SHORT-DOC-FOR-TABLE KEY COMTAB 3)))) ;; Macro for suggestions added by rpm 11-26-86.(DEFUN PRINT-DOC (OP COMMAND &OPTIONAL (CHAR NIL) OVERRIDE-DOCUMENTATION-FUNCTION &AUX DOC)  "Print documentation of COMMAND (a symbol defined with DEFCOM).OP is the type of documentation wanted: :FULL or :SHORT.CHAR is the character COMMAND was supposedly invoked thru; it is used only to pass to the documentation function if any.OVERRIDE-DOCUMENTATION-FUNCTION means ignore any documentation functionand just use the documentation string.A documentation function is the ZWEI:DOCUMENTATION-FUNCTION prop of COMMAND,and it gets as arguments COMMAND, CHAR and OP."  (SYS:WITH-SUGGESTIONS-MENUS-FOR ZWEI:PRINT-DOC    (COND ((NULL COMMAND)   (FORMAT T "The command is undefined.~%"))  ((SYMBOLP COMMAND)   (COND ((AND (NOT OVERRIDE-DOCUMENTATION-FUNCTION)       (GET COMMAND 'DOCUMENTATION-FUNCTION))  (FUNCALL (GET COMMAND 'DOCUMENTATION-FUNCTION) COMMAND CHAR OP)  (FORMAT T "~&")) ((SETQ DOC (DOCUMENTATION COMMAND 'FUNCTION))  (FORMAT T "~A~&"  (CASE OP    (:FULL DOC)    (:SHORT     (IF DOC (LET ((FIRST-CR (POSITION #\NEWLINE (THE STRING (STRING DOC))   :TEST #'CHAR-EQUAL)))   (IF FIRST-CR       (NSUBSTRING DOC 0 FIRST-CR)       DOC)) ""))    (OTHERWISE (FERROR () "Bad op ~A" OP)))))))  ((MACRO-COMMAND-P COMMAND)   (CASE OP     (:FULL      (FORMAT T "A user-defined macro named ~A.~          ~&With no argument, run the macro with the repeat count in its definition.~          ~&With an argument, ignore the repeat count in its definition and use~          ~&the argument instead.~&"      (SYMEVAL-IN-CLOSURE COMMAND 'SYMBOL)))     (:SHORT      (FORMAT T "A user-defined macro named ~A." (SYMEVAL-IN-CLOSURE COMMAND 'SYMBOL)))     (OTHERWISE (FERROR () "Bad op ~A" OP))))  ((PREFIX-COMMAND-P COMMAND)   (FORMAT T "The command is an escape-prefix for more commands.~%"))))) (DEFUN COMMAND-NAME (COMMAND &OPTIONAL NO-ERROR-P &AUX FN)  "Return the pretty name of COMMAND (a symbol defined with a DEFCOM).NO-ERROR-P means return NIL if data is not present (no DEFCOM was done)."  (CHECK-ARG COMMAND SYMBOLP "a symbol")  (COND ((SETQ FN (GET COMMAND 'DOCUMENTATION-FUNCTION)) (FUNCALL FN COMMAND NIL :NAME))((GET COMMAND 'COMMAND-NAME))(NO-ERROR-P NIL)(T (FERROR NIL "~S does not have a name" COMMAND)))) (DEFCOM COM-LIST-COMMANDS "List all extended commands." ()  (FORMAT T "~%   Extended commands:~2%")  (DO ((L (EXTENDED-COMMAND-ALIST *COMTAB*) (CDR L)))      ((NULL L) NIL)    (COND ((CONSP L)   (FORMAT T "~30,5,2A" (CAAR L))   (PRINT-DOC :SHORT (CDAR L))   (FORMAT T "~&"))))  (FORMAT T "~&~%Done.    Type SPACE to remove.")  DIS-NONE) (DEFUN NON-CURRENT-COMTABS (*COMTAB* &AUX CURRENT-COMTABS)  (DECLARE (SPECIAL CURRENT-COMTABS))  ;; Removed colon, patch 98.160.   ddd, 3/13/84.  (DO ((COMTAB *COMTAB* (COMTAB-INDIRECT-TO COMTAB)))      ((NULL COMTAB))    (SETQ CURRENT-COMTABS (CONS COMTAB CURRENT-COMTABS)))  (REMOVE-IF #'(LAMBDA (ELT) (MEMBER (SYMBOL-VALUE ELT) CURRENT-COMTABS :TEST #'EQUAL))     EVERY-COMTAB)) (DEFUN SEARCH-OTHER-COMTABS (COMMAND COMTAB-NAMES)  (LOOP WITH FOUND = NIL        FOR COMTAB IN COMTAB-NAMES        AS TABLE = (SYMBOL-VALUE COMTAB)        AS KEY = (KEY-FOR-COMMAND COMMAND TABLE)        WHEN KEY        DO (FORMAT T                   "  ~:[which~;and~] can be invoked via: ~A when using the ~A command table.~%"                   FOUND KEY (PRETTY-COMTAB-NAME COMTAB))        (SETQ FOUND T)        FINALLY (RETURN FOUND))) (DEFUN PRETTY-COMTAB-NAME (COMTAB)  (LET ((NAME (OR (GET COMTAB 'COMMAND-NAME)  (LET ((N (MAKE-COMMAND-NAME COMTAB)))    (SETF (GET COMTAB 'COMMAND-NAME) N)    N))))    (NSUBSTRING NAME 0 (- (LENGTH NAME) 7)))) ;;;  Make the function names mouse-sensitive.;;;  Make the other-comtab search a question or option.(DEFCOM COM-APROPOS "List commands whose names contain a given string.Tell on which key(s) each command can be found.Leading and trailing spaces in the substring are NOT ignored - theymust be matched by spaces in the command name." ()  (MULTIPLE-VALUE-BIND (FUNCTION KEY STR)      (GET-EXTENDED-SEARCH-STRINGS "Apropos. (Substring:)")    (LET ((EXTENDED-CMD (KEY-FOR-COMMAND *EXTENDED-COMMAND-COMMAND* *COMTAB* NIL NIL #\m-X))  (ANY-EXTENDED-CMD (KEY-FOR-COMMAND *ANY-EXTENDED-COMMAND-COMMAND* *COMTAB* NIL NIL #\c-m-X))  (NON-REACHABLE-COMMANDS NIL))      (WITH-TYPEOUT-FONT-MAP-OF ((GET-SEARCH-MINI-BUFFER-WINDOW)) (FORMAT T "~&Commands matching \"~A\"." STR) (FORMAT T "  Command names are mouse-sensitive.~2&") (LOOP FOR ELEMENT IN *COMMAND-ALIST*       AS NAME = (CAR ELEMENT)       AND COMMAND-FUNCTION = (CDR ELEMENT)       WHEN (FUNCALL FUNCTION KEY NAME)       DO (COND ((OR (KEY-FOR-COMMAND COMMAND-FUNCTION)     (EXTENDED-COMMAND-P COMMAND-FUNCTION)) (FORMAT T "~&") (SEND *STANDARD-OUTPUT* :ITEM 'ZMACS-COMMAND COMMAND-FUNCTION NAME) (FORMAT T "~30,5T  ") (PRINT-DOC :SHORT COMMAND-FUNCTION) (FORMAT T "~&") (COND ((> (FIND-COMMAND-ON-KEYS COMMAND-FUNCTION 4 "  which can be invoked via: ")   0))       ((AND EXTENDED-CMD     (EXTENDED-COMMAND-P COMMAND-FUNCTION))(FORMAT T "  which can be invoked via: ~A ~A" EXTENDED-CMD NAME))))(:ELSE (PUSH ELEMENT NON-REACHABLE-COMMANDS)))) (WHEN (AND (NEQ *APROPOS-SEARCH-OTHER-COMTABS* :NEVER)    NON-REACHABLE-COMMANDS    (OR (EQ *APROPOS-SEARCH-OTHER-COMTABS* :ALWAYS)(LET ((*QUERY-IO* *TYPEOUT-WINDOW*))  (Y-OR-N-P "~2&Search inaccessible command tables?"))))   (FORMAT T "~2&")   (LOOP FOR ELEMENT IN NON-REACHABLE-COMMANDS AS NAME = (CAR ELEMENT) AND COMMAND-FUNCTION = (CDR ELEMENT) DOING (FORMAT T "~&") (SEND *STANDARD-OUTPUT* :ITEM 'ZMACS-COMMAND COMMAND-FUNCTION NAME) (FORMAT T "~30,5T  ") (PRINT-DOC :SHORT COMMAND-FUNCTION) (FORMAT T "~&") (COND ((SEARCH-OTHER-COMTABS COMMAND-FUNCTION (NON-CURRENT-COMTABS *COMTAB*)))       (:ELSE(FORMAT T "  Not intended for the current context, but can be invoked via: ~A ~A."(OR ANY-EXTENDED-CMD    (SETQ ANY-EXTENDED-CMD (KEY-FOR-COMMAND *ANY-EXTENDED-COMMAND-COMMAND*                                                                            *COMTAB* NIL NIL #\c-m-X)))NAME))))) (FORMAT T "~2&Done."))))  DIS-NONE) ;;;;;;  Mouse command to print full documentation.(W:ADD-TYPEOUT-ITEM-TYPE *TYPEOUT-COMMAND-ALIST*  ZMACS-COMMAND "Document"  APROPOS-DESCRIBE-COMMAND  'T  "Describe this command");;;;;;  New function, full documentation on a mouse-sensitive function.(DEFUN APROPOS-DESCRIBE-COMMAND (COMMAND)  (FORMAT T "~2&~A:~&" (COMMAND-NAME COMMAND))  (PRINT-DOC :FULL COMMAND)  DIS-NONE);;;  EXECUTE mouse selection added by rpm on 7-8-86. (W:ADD-TYPEOUT-ITEM-TYPE *TYPEOUT-COMMAND-ALIST*  ZMACS-COMMAND "Execute"  APROPOS-EXECUTE-COMMAND  'NIL  "Execute this command");;;  Right click for menu, then select EXECUTE for the function. Added by rpm on 7-8-86.(DEFUN APROPOS-EXECUTE-COMMAND (COMMAND)  (FUNCALL COMMAND)  DIS-NONE)(DEFCOM COM-WHERE-IS "List all characters that invoke a given command.Reads the command name with completion from the mini-buffer." ()  (LET ((CMD (COMPLETING-READ-FROM-MINI-BUFFER       "Where is:" *COMMAND-ALIST* NIL NIL       "You are typing the name of a command, and you will be toldall characters that invoke the command.")))    (COND ((EQUAL CMD "")   (BARF))  (T   (FORMAT T (CAR CMD))   ;;; The whole following COND stmt has been changed around.   ddd   ;;; It now searches other comtabs if cmd not found on current one.   ;;; patch 98.146. ddd, 3/6/84.   (COND ((PLUSP (FIND-COMMAND-ON-KEYS (CDR CMD) 77777 " can be invoked via: "))  (TERPRI)) ((SEARCH-OTHER-COMTABS (CDR CMD) (NON-CURRENT-COMTABS *COMTAB*))) (T  (FORMAT T " is not on any keys.~%"))))))  DIS-NONE) (DEFUN FIND-COMMAND-ON-KEYS (COMMAND LIMIT MESSAGE &OPTIONAL (COMTAB *COMTAB*))  "Print a description of characters that would invoke COMMAND in COMTAB.LIMIT is the maximum number of characters to mention.MESSAGE is printed before the first character, if there are any.Returns the number of characters found and printed."  (DO ((STARTING-CHAR (INT-CHAR 0) (INT-CHAR (1+ (CHAR-INT CHAR))))       (STARTING-COMTAB COMTAB)       CHAR-STRING       CHAR       (COUNT 0 (1+ COUNT)))      (NIL)    (SETF (VALUES CHAR-STRING CHAR STARTING-COMTAB)  (KEY-FOR-COMMAND COMMAND COMTAB STARTING-CHAR STARTING-COMTAB))    (AND (NULL CHAR-STRING) (RETURN COUNT))    (COND ((> COUNT LIMIT)   (FORMAT T ", etc.")   (RETURN COUNT)))    (FORMAT T (IF (= COUNT 0)  MESSAGE  ", "))    (PRINC CHAR-STRING))) ;Returns a list of the commands which are in *COMMAND-ALIST* but not reachable;from the current comtab.(DEFUN UNREACHABLE-COMMAND-LIST (&AUX (L (MAPCAR #'CDR *COMMAND-ALIST*)))  (DOLIST (COMTAB ALL-COMTABS)    (SETQ L (UNREACHABLE-COMMAND-LIST-INTERNAL (SYMBOL-VALUE COMTAB) L)))  (SORT L #'STRING-LESSP)) (DEFUN UNREACHABLE-COMMAND-LIST-INTERNAL (*COMTAB* L &AUX CHAR TEM KBD)  (DO ((CT *COMTAB* (COMTAB-INDIRECT-TO CT)))      ((ARRAYP (SETQ KBD (COMTAB-KEYBOARD-ARRAY CT)))))  (DOTIMES (I (ARRAY-DIMENSION KBD 1))    (DOTIMES (J (ARRAY-DIMENSION KBD 0))      (SETQ CHAR (CODE-CHAR J I))      (SETQ TEM (COMMAND-LOOKUP CHAR *COMTAB* T))      (COND ((AND TEM (SYMBOLP TEM))     (SETQ L (DELETE TEM (THE LIST L) :TEST #'EQ)))    ((PREFIX-COMMAND-P TEM)     (SETQ L (UNREACHABLE-COMMAND-LIST-INTERNAL (GET-PREFIX-COMMAND-COMTAB TEM) L))))))  (DOLIST (C L)    (AND (EXTENDED-COMMAND-P C) (SETQ L (DELETE C (THE LIST L) :TEST #'EQ))))  L) (DEFUN EXTENDED-COMMAND-P (SYMBOL &OPTIONAL (COMTAB *COMTAB*))  "T if SYMBOL (a DEFCOM name) is reachable thru M-X using COMTAB."  (BLOCK EXTENDED-COMMAND-P    (DO ((C COMTAB (COMTAB-INDIRECT-TO C)))((NULL C) NIL)      (DOLIST (X (EXTENDED-COMMAND-ALIST C))(AND (EQ (CDR X) SYMBOL)     (RETURN-FROM EXTENDED-COMMAND-P T)))))) (DEFCOM COM-DESCRIBE-COMMAND "Describe a command, specified by name.Prints the full documentation for a command.  The commandmay be a function name or an extended command name, and youneed only type enough to be unique." ()  (LET ((X (COMPLETING-READ-FROM-MINI-BUFFER     "Describe command:"     *COMMAND-ALIST*     NIL     NIL     "You are typing the name of a command, which will be described.")))    (COND ((EQUAL X "")   (BARF))  (:ELSE   (FORMAT T "~&~A:~&" (CAR X))   (PRINT-DOC :FULL (CDR X)))))  DIS-NONE) ;;;  The following provides help for the symbol key.(DEFCOM COM-SYMBOL-HELP "List the special characters available in this buffer." ()  (SEND *STANDARD-OUTPUT* :CLEAR-SCREEN)  (LET ((FONT-LIST (OR (SEND *INTERVAL* :SAVED-FONT-ALIST)       (CONS (CONS (STRING (W:FONT-NAME W::*DEFAULT-FONT*))   W::*DEFAULT-FONT*)     NIL))))    ;;Put out header    (FORMAT T "~10@TFONT:")    (LOOP FOR (FONT-NAME) IN FONT-LIST  AS FONT-INDEX FROM #\A  AS TAB-TO FROM FIRST-COLUMN BY COLUMN-SPACING  DOING (FORMAT T "~VT~C (~A)" TAB-TO FONT-INDEX FONT-NAME))    ;;Put out characters    (FORMAT T "~2%")    (LOOP FOR (START-OF-RANGE . END-OF-RANGE) IN SPECIAL-CHARACTERS-TO-LIST DOING  (LOOP FOR CHAR FROM START-OF-RANGE TO END-OF-RANGEDOING (FORMAT T "~&~:@C" CHAR)DOING (LOOP FOR (NIL . FONT) IN FONT-LIST    AS FONT-CHAR-WIDTH-TABLE = (W:FONT-CHAR-WIDTH-TABLE FONT)    AS FONT-CHARS-EXIST-TABLE = (W:FONT-CHARS-EXIST-TABLE FONT)    AS TAB-TO FROM FIRST-COLUMN BY COLUMN-SPACING    DOING (WHEN (AND (OR (NULL FONT-CHARS-EXIST-TABLE) (AND (ARRAY-IN-BOUNDS-P FONT-CHARS-EXIST-TABLE (CHAR-CODE CHAR))      (AREF FONT-CHARS-EXIST-TABLE (CHAR-CODE CHAR))))     (OR (NULL FONT-CHAR-WIDTH-TABLE) (> (AREF FONT-CHAR-WIDTH-TABLE (CHAR-CODE CHAR)) 0)))    (FORMAT T "~VT" TAB-TO)    (W::SHEET-TYO *TYPEOUT-WINDOW* CHAR FONT))))))  DIS-NONE) ;;; This command goes on keys which are normally self-inserting.;;; *STANDARD-COMMAND* is usually COM-SELF-INSERT.(DEFCOM COM-ORDINARILY-SELF-INSERT DOCUMENT-STANDARD-COMMAND ()  (FUNCALL *STANDARD-COMMAND*)) ;;; This is the documentation function for *STANDARD-COMMAND*.(DEFUN DOCUMENT-STANDARD-COMMAND (COMMAND CHAR OP)  (CASE OP(:FULL (FORMAT T "Ordinarily a self-inserting character.  Currently, these characters do: ")       (PRINT-DOC :FULL *STANDARD-COMMAND* CHAR))(:SHORT (PRINC "Ordinarily self-inserting character.  Currently: ")(PRINT-DOC :SHORT *STANDARD-COMMAND* CHAR))(:NAME "Ordinarily Self Insert")(OTHERWISE (FERROR NIL "Unknown operation ~A; ~S ~S" OP COMMAND CHAR)))) (DEFUN PRINT-SHORT-DOC-FOR-TABLE (CHAR COMTAB INDENTATION)  "Document what CHAR does in COMTAB, for subcommands of prefix characters.It prints one or two lines of stuff, with the given INDENTATION."  (LET ((X (COMMAND-LOOKUP CHAR COMTAB T)))    (COND ((NULL X));undefined  ((CONSP X));alias  ((MACRO-COMMAND-P X)   (FORMAT T "~&~V@T~:C is a user defined macro.~%" INDENTATION CHAR))  ((PREFIX-COMMAND-P X)   (FORMAT T "~&~V@T~:C reads another character and dispatches.~%"   INDENTATION CHAR))  ((NOT (SYMBOLP X)));??  (T   (FORMAT T "~&~V@T~:C is ~A:~%~V@T" INDENTATION CHAR (COMMAND-NAME X) (+ 5 INDENTATION))   (PRINT-DOC :SHORT X CHAR))))) (DEFCOM COM-DOCUMENT-CONTAINING-PREFIX-COMMAND "Document this command" ()  (DECLARE (SPECIAL COMTAB))  (CONTEXT-CHECK 'COMTAB)  (DOCUMENT-PREFIX-CHAR-TABLE COMTAB)  DIS-NONE) ;;; Generate a ZMACS Wall chart.(DEFUN WALLCHART (&OPTIONAL (*STANDARD-OUTPUT* *STANDARD-OUTPUT*) &OPTIONAL COMTAB)  (IF COMTAB      (WALLCHART-COMTAB COMTAB)      (LET ((COMMANDS (MAPCAR #'CDR *COMMAND-ALIST*)))(DOLIST (COMTAB ALL-COMTABS)  (SETQ COMMANDS (WALLCHART-COMTAB COMTAB COMMANDS))  (TERPRI))(FORMAT T "~|~%Not in any comtab: ~%~%")(MAPC #'(LAMBDA (X)  (FORMAT T "~%~A" (MAKE-COMMAND-NAME X)))      COMMANDS)))  (TERPRI)) (DEFUN WALLCHART-COMTAB (COMTAB &OPTIONAL COMMANDS)  (LET ((TABLE (SYMBOL-VALUE COMTAB)))    (FORMAT T "~|~%Command chart of ~A:~%~%" (MAKE-COMMAND-NAME COMTAB))    (LOOP FOR BUCKY FROM 0 BELOW 20  DOING (LOOP FOR LETTER FROM 0 TO 377      AS KEY = (CODE-CHAR LETTER BUCKY)      AS COMMAND = (COMMAND-LOOKUP KEY TABLE)      WHEN (AND COMMAND(NEQ COMMAND 'COM-STANDARD)(NEQ COMMAND 'COM-NUMBERS)(NEQ COMMAND 'COM-ORDINARILY-SELF-INSERT)(NEQ COMMAND 'COM-NEGATE-NUMERIC-ARG))      DO (TERPRI)      (SEND *STANDARD-OUTPUT* :STRING-OUT; So ~T works on all streams.    (FORMAT () "~:@C~32,1T~A" KEY (IF (SYMBOLP COMMAND)      (MAKE-COMMAND-NAME COMMAND)      "Prefix command")))      (SETQ COMMANDS (DELETE COMMAND (THE LIST COMMANDS) :TEST #'EQ))))    (TERPRI)    (LET ((EXTENDED-COMMANDS (EXTENDED-COMMAND-ALIST TABLE)))      (WHEN (AND EXTENDED-COMMANDS (NOT (LOCATIVEP EXTENDED-COMMANDS)))(FORMAT T "~|~%Extended commands of ~A:~2%" (MAKE-COMMAND-NAME COMTAB))(LOOP FOR EXTENDED-COMMAND IN EXTENDED-COMMANDS      AS MATCH = (MEMBER (CDR EXTENDED-COMMAND) COMMANDS :TEST #'EQ)      DOING (FORMAT T "~%~A" (CAR EXTENDED-COMMAND))      WHEN MATCH      DO (SETQ COMMANDS (DELETE (CDR EXTENDED-COMMAND) (THE LIST COMMANDS) :TEST #'EQ)))))    COMMANDS)) (DEFUN GENERATE-WALLCHART (&OPTIONAL (FILENAME "ZWEI-COMMANDS.TABLE") COMTAB)  (WITH-OPEN-FILE (FILE FILENAME :CHARACTERS T :DIRECTION :OUTPUT)    (WALLCHART FILE COMTAB))) (DEFCOM COM-GENERATE-WALLCHART "Generates a Wallchart a la emacs for one or all comtabs.The comtabs and the destination file are read from the minbufferOrganised into keyboard and extended (i.e. not on a key) commands. Mousecommands are ignored because they are not generally useful. Numeric andself-inserting commands are not mentioned because they are obvious." ()  (LET ((COMPLETION-ARRAY (MAKE-ARRAY (1+ (LENGTH ALL-COMTABS))      :TYPE :ART-Q-LIST      :LEADER-LENGTH 2)))    (DOTIMES (ELT (1- (ARRAY-TOTAL-SIZE COMPLETION-ARRAY)))      (SETF (AREF COMPLETION-ARRAY ELT)    (LET ((NAME (NTH ELT ALL-COMTABS)))      (CONS (MAKE-COMMAND-NAME NAME) NAME))))    (SETF (AREF COMPLETION-ARRAY (1- (ARRAY-TOTAL-SIZE COMPLETION-ARRAY)))  (CONS "All" NIL))    (SORT-COMPLETION-AARRAY COMPLETION-ARRAY)    (LET ((COMTAB (COMPLETING-READ-FROM-MINI-BUFFER "Wallchart of: (Type ALL for all)"    ;; patch 94.114 ddd/gsl    COMPLETION-ARRAY    NIL NIL "You are typing the name of a comtab, from which a wallchart will be generated. \"All\" will list all commands, including those not on any key.")))      (AND (ATOM COMTAB) (BARF))      (GENERATE-WALLCHART (READ-DEFAULTED-AUX-PATHNAME "Put wallchart into:") (CDR COMTAB))))  DIS-NONE) TURN)))     ;; Check for the last line in the interval.     (COND ((EQ LINE STOP-LINE)    (SETF LAST-BP-DISPLAYED-P T)    (OR (< PLINE N-PLINES) (RETURN-FROM LINES))    (AND (NULL (PLINE-LINE SELF PLINE)) (PLINE-TICK SELF PLINE) (> (PLINE-TICK SELF PLINE) 0) (RETURN-FROM LINES));Return if screen already blanked