archive/src/mudoc.lisp

   1 ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;;     The data in this file contains enhancments.                    ;;;;;
   4 ;;;                                                                    ;;;;;
   5 ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
   6 ;;;     All rights reserved                                            ;;;;;
   7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8 ;;;     (c) Copyright 1981 Massachusetts Institute of Technology         ;;;
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 (in-package "MAXIMA")
  12 (macsyma-module mudoc)
  13
  14 ;; Macsyma user Documentation.
  15 ;; 8/30/81 16:52:50 -GJC
  16
  17 (defvar apropos-search)
  18 (defvar apropos-string-length)
  19 (defvar apropos-found)
  20
  21 (defmspec $apropos (form)
  22   (let ((apropos-search (mapcar #'(lambda (u) (format nil "~A" (fullstrip1 u))) (cdr form))))
  23     (cond ((null apropos-search)
  24            (format *standard-output*
  25                    "~
  26                     ~%APROPOS takes arguments which should be a symbols or strings.~
  27                     ~%It searches the symbol table, returning a list of all symbols~
  28                     ~%which contain the arguments as substrings of their print name.~%")
  29            '((MLIST)))
  30           ('ELSE
  31            (let ((apropos-found ())
  32                  (apropos-string-length (apply 'max (mapcar #'length apropos-search))))
  33              (setq apropos-string-length (f1+ apropos-string-length))
  34              (mapatoms #'(lambda (ssymbol)
  35                            (LET ((sSTRING (SYMBOL-NAME SSYMBOL)))
  36                              (if (and (>= (length (the string  sstring)) apropos-string-length)
  37                                       (memq (character sstring) '(#\$ #\% #\&)))
  38                                  (do ((l apropos-search (cdr l)))
  39                                      ((null l)
  40                                       (push ssymbol apropos-found))
  41                                    (or (string-search (car l) sstring 1)
  42                                        (return nil))))))
  43                        ;; Only search the MACSYMA package.
  44                        'MACSYMA
  45                        ;; Don't bother searching its superiors, i.e. GLOBAL.
  46                        NIL)
  47              `((MLIST),@(SORT APROPOS-FOUND #'STRING-LESSP)))))))
  48
  49 \f
  50 ;; The DESCRIBE datafile contains a large body of text which should
  51 ;; be randomly accesable.
  52
  53 (DEFvar DESCRIBE-DATA-FILE
  54           #+ITS "MC:LMMAXR;DOCDAT >"
  55           #+cl "macsyma-object:documentation;docdat lisp"
  56           ())
  57
  58 (DEFvar DESCRIBE-DATA-FILE-OPEN-OPTIONS '(:FIXNUM :BYTE-SIZE 8.))
  59
  60 ;; The format of the data-file is as follows:
  61 ;; [1] The at :SET-POINTER of (- :LENGTH 25.) a lisp-readable FIXNUM
  62 ;;     giving the :SET-POINTER of the DOC-ALIST
  63 ;; [2] The lisp-readable DOC-ALIST, of the form
  64 ;;     (("INTEGRATE" (FILEPOS . LENGTH) (FILEPOS . LENGTH) ...)
  65 ;;      ("FROBULATE" (FILEPOS . LENGTH))
  66 ;;      ...)
  67 ;; [3] Starting from the begining of the file, a string of text, referenced
  68 ;;     by using :SET-POINTER, and having no special syntax or pointers.
  69
  70 (DEFVAR DESCRIBE-ALIST NIL)
  71 (DEFVAR DESCRIBE-FILE  NIL)
  72
  73 (DEFUN LOAD-DESCRIBE-ALIST-IF-NEEDED ()
  74   (IF (NOT (AND DESCRIBE-FILE (PROBE-FILE DESCRIBE-FILE)))
  75       (WITH-OPEN-FILE (STREAM DESCRIBE-DATA-FILE
  76                               (CONS ':IN DESCRIBE-DATA-FILE-OPEN-OPTIONS))
  77         (FORMAT *standard-output*
  78                 "~&; Loading describe database, please stand by...")
  79         (FUNCALL STREAM ':SET-POINTER (- (FUNCALL STREAM ':LENGTH) 25.))
  80         (FUNCALL STREAM ':SET-POINTER (READ STREAM))
  81         (SETQ DESCRIBE-ALIST (READ STREAM))
  82         (FORMAT *standard-output*
  83                 "~&; Loading of describe database done.~%")
  84         (SETQ DESCRIBE-FILE (FUNCALL STREAM ':TRUENAME)))))
  85
  86 #-cl
  87 (DEFMSPEC $DESCRIBE (FORM)
  88   (IF (NULL (CDR FORM))
  89       (INTERNAL-$DESCRIBE "DESCRIBE")
  90       (APPLY #'INTERNAL-$DESCRIBE
  91              (MAPCAR #'(LAMBDA (X)
  92                          (STRING-UPCASE (FORMAT NIL "~A" (FULLSTRIP1 X))))
  93                      (CDR FORM)))))
  94
  95 (DEFUN INTERNAL-$DESCRIBE (&REST L)
  96   (LOAD-DESCRIBE-ALIST-IF-NEEDED)
  97   (WITH-OPEN-FILE (STREAM DESCRIBE-DATA-FILE
  98                           (CONS ':IN DESCRIBE-DATA-FILE-OPEN-OPTIONS))
  99     (DO ()
 100         ((NULL L))
 101       (PRINT-DESCRIPTIONS (POP L) STREAM))))
 102
 103 (DEFUN PRINT-DESCRIPTIONS (SsTRING INPUT-STREAM)
 104   (DO ((L (LET ((INFO (zl-ASSOC SSTRING DESCRIBE-ALIST)))
 105               (COND (INFO (CDR INFO))
 106                     ('ELSE
 107                      (FORMAT *standard-output* "~&No information for ~A~%" sSTRING)
 108                      NIL)))
 109             (CDR L)))
 110         ((NULL L))
 111       (FUNCALL INPUT-STREAM ':SET-POINTER (CAAR L))
 112       (DO ((J 0 (f1+ J))
 113            (C #\Return (FUNCALL INPUT-STREAM ':TYI)))
 114           ((> J (CDAR L)))
 115         (FUNCALL *standard-output* ':TYO C))))
 116
 117 \f
 118 (DEFvar describe-master-file
 119           #+ITS "MC:MANUAL;MACSYM DOC"
 120           #+cl "macsyma-object:documentation;macsyma documentation"
 121           ())
 122
 123 ;; The present format of the documentation file is as follows:
 124 ;; [1] it is fully character-at-time oriented, not line-at-time.
 125 ;; [2] A #/& character marks the END of a documentation section,
 126 ;;     unless quoted by a #^Q.
 127 ;; [3] The first thing in a documentation section is a key, readable
 128 ;;     with lisp READ. The PRINC representation of this object is the
 129 ;;     PRINC representation of the cooresponding macsyma object
 130 ;;     which has been FULLSTRIP1'd.
 131
 132 (DEFUN READ-DOC-KEY (INPUT-STREAM EOF)
 133   (LET ((READ-PRESERVE-DELIMITERS T))
 134     (READ INPUT-STREAM EOF)))
 135
 136 (DEFMFUN $UPDATE_DESCRIBE_DATA_FILE ()
 137   ;; Provide a user entry point for convenience
 138   (FORMAT *standard-output*
 139           "~&; Using master documentation file ~S, to construct~
 140            ~%; data file ~S for lispmachine macsyma documentation.~%"
 141           describe-master-file
 142           describe-data-file)
 143   (cond ((or (zl-MEMBER user-id '("ELLEN" "JPG" "GJC" "CWH" "LMMAX" "LISPM"))
 144              (yes-or-no-p "Are you a Macsyma System-Maintainer? "))
 145          (update-describe-data-file)
 146          (setq describe-file nil)
 147          `((mlist) ,(probe-file describe-master-file) ,(probe-file describe-data-file)))
 148         ('else
 149          "You don't need to use this command then.")))
 150
 151 (DEFUN UPDATE-DESCRIBE-DATA-FILE ()
 152   (WITH-OPEN-FILE (INPUT-STREAM DESCRIBE-MASTER-FILE '(:IN :ASCII))
 153     (WITH-OPEN-FILE (OUTPUT-STREAM DESCRIBE-DATA-FILE
 154                                    (CONS ':OUT DESCRIBE-DATA-FILE-OPEN-OPTIONS))
 155       (BEGIN-UPDATE-DESCRIBE-FILE INPUT-STREAM OUTPUT-STREAM)
 156       (DO ((DOC-ALIST NIL)
 157            (DOC-CELL  NIL)
 158            (DOC-START-POS)
 159            (EOF "**EOF**")
 160            (C #\& (FUNCALL INPUT-STREAM ':TYI NIL)))
 161           ((NULL C)
 162            (ERROR () "End of file inside documentation for ~S" (CAR DOC-CELL)))
 163         (COND ((= C #.(LOGAND #o77 #+cl (char-int #\Q) #-cl #\Q))
 164                ;; From a pdp-10 file this is how control-Q reads.
 165                (FUNCALL OUTPUT-STREAM ':TYO (FUNCALL INPUT-STREAM ':TYI)))
 166               ((= C #\&)
 167                (LET ((DOC-END-POS (FUNCALL OUTPUT-STREAM ':READ-POINTER)))
 168                  (IF DOC-CELL
 169                      (NCONC DOC-CELL (LIST (CONS DOC-START-POS
 170                                                  (f- DOC-END-POS DOC-START-POS)))))
 171                  (SETQ DOC-START-POS DOC-END-POS))
 172                (LET* ((KEY (READ-DOC-KEY INPUT-STREAM EOF))
 173                       (PKEY (FORMAT NIL "~A" KEY))
 174                       (CELL (zl-ASSOC PKEY DOC-ALIST)))
 175                  (IF (EQ KEY EOF)
 176                      (RETURN (END-UPDATE-DESCRIBE-FILE OUTPUT-STREAM
 177                                                        (SORTCAR DOC-ALIST #'STRING-LESSP))))
 178                  (PRIN1 KEY OUTPUT-STREAM)
 179                  (SETQ DOC-CELL (IF CELL
 180                                     CELL
 181                                     (CAR (SETQ DOC-ALIST
 182                                                (CONS (LIST PKEY) DOC-ALIST)))))))
 183               ('ELSE
 184                (FUNCALL OUTPUT-STREAM ':TYO C)))))))
 185
 186 (DEFUN BEGIN-UPDATE-DESCRIBE-FILE (INPUT-STREAM OUTPUT-STREAM)
 187   (FORMAT OUTPUT-STREAM
 188           "~
 189            ~%***********************************************************************~
 190            ~%**            Macsyma User-Documentation Datafile                    **~
 191            ~%**      (c) Copyright 1981 Massachusetts Institute of Technology     **~
 192            ~%** Created by ~10A from master file ~26A **~
 193            ~%** on ~62A **~
 194            ~%***********************************************************************~
 195            ~%"
 196           USER-ID (FUNCALL (FUNCALL INPUT-STREAM ':TRUENAME) ':STRING-FOR-HOST)
 197           (TIME:PRINT-CURRENT-DATE NIL)))
 198
 199 (DEFUN END-UPDATE-DESCRIBE-FILE (OUTPUT-STREAM DOC-ALIST)
 200   (FORMAT OUTPUT-STREAM
 201           "~3%This is the end, my only friend, the end.~
 202            ~%    - From `The END' by the CARS.~2%")
 203   (LET ((ALIST-START-POS (FUNCALL OUTPUT-STREAM ':READ-POINTER)))
 204     (PRINC "   " OUTPUT-STREAM)
 205     (LET ((*print-base* 10.)
 206           (*NOPOINT NIL)
 207           (PRINLEVEL NIL)
 208           (PRINLENGTH NIL))
 209       (PRIN1 DOC-ALIST OUTPUT-STREAM))
 210     (FORMAT OUTPUT-STREAM "  ~25D. " ALIST-START-POS)))
 211
 212 (defun mgrind-string (&rest l)
 213   (WITH-OUTPUT-TO-STRING (STREAM)
 214     (DO ((L L (CDR L)))
 215         ((NULL L))
 216       (TERPRI STREAM)
 217       (MGRIND (CAR L) STREAM)
 218       (TERPRI STREAM))))
 219
 220 (DEFMFUN $BUG (&REST L)
 221   (LET ((S (apply #'mgrind-string l)))
 222     (LET ((ZWEI:*HOST-FOR-BUG-REPORTS* "MIT-MC"))
 223       (BUG 'LMMAX S))))
 224
 225 (defun $mail (who &rest l)
 226   (let ((s (apply #'mgrind-string l)))
 227     (mail (fullstrip1 who) s)))
 228
 229