;	Sunday  June 5,1983  00:01  LQ+1D.21H.32M.59S.  -*- Lisp -*-


;;;; NIL Manual bolio frobs


(include ((dsk bolio) justdf #+TENEX lisp))


(defvar computerese-font
  lisp-block-font)

(defprop left-curly "//{" just-value)
(defprop right-curly "//}" just-value)
(defprop mitlcs "MIT Laboratory for Computer Science, Cambridge, Mass/."
	 just-value)
(defprop mitai "MIT Artificial Intelligence Laboratory, Cambridge, Mass/."
	 just-value)

(defun get-frobbed-string (&aux (s (get-line-string)) (foo nil) tem)
  (cond ((setq tem (string-search-char #\cr s))
	   (as-1 #\sp s tem)
	   (push `(lf ,tem) foo)
	   (cond ((setq tem (string-search-char #\lf s))
		    (push `(cr ,tem) foo)
		    (as-1 #\sp s tem))))
	((setq tem (string-search-char #\lf s))
	   (as-1 #\sp s tem)
	   (push `(lf ,tem) foo)))
  (cond ((not (null foo))
	 (cond ((not (null (cdr foo)))
		(setq s (string-append (substring s 0 tem)
				       (substring s (1+ tem) nil)))))
	 (format msgfiles '|~&//~S: ~S| (make-symbol s) foo)))
  s)

(defun frob-in-font-1 (s jin-cur-font)
  (loop for i from 0 below (string-length s)
	do (jin-stuff-printing-char (ar-1 s i) 0)))
(defun frob-in-font (font)
  (frob-in-font-1 (get-frobbed-string) font))

(defun (sym request) ()
  (frob-in-font lisp-text-font))

(defun frob-in-font_i (font i suffix)
  (let ((s (get-frobbed-string)))
    (frob-in-font-1 s font)
    (add-to-index (if suffix (string-append s '|/i| suffix '|/*|) s) i)))

(defun (kwd request) ()
  (frob-in-font lisp-text-font))

(defun (kwd_i request) ()
  (frob-in-font_i lisp-text-font 'concept-index nil))

(defun (term request) ()
  (frob-in-font italic-font))

(defun (term_i request) ()
  (frob-in-font_i italic-font 'concept-index nil))

(defun (fun request) ()
  (frob-in-font lisp-text-font))

(defun (fun_i request) ()
  (frob-in-font_i lisp-text-font 'function-index ()))

(defun (mac request) ()
  (frob-in-font lisp-text-font))

(defun (mac_i request) ()
  (frob-in-font_i lisp-text-font 'macro-index ()))

(defun (spec request) ()
  (frob-in-font lisp-text-font))

(defun (spec_i request) ()
  (frob-in-font_i lisp-text-font 'special-form-index ()))
 
(defun (var request) ()
  (frob-in-font lisp-text-font))

(defun (var_i request) ()
  (frob-in-font_i lisp-text-font 'variable-index ()))

(defun (msg request) ()
  (frob-in-font lisp-text-font))

(defun (msg_i request) ()
  (frob-in-font_i lisp-text-font 'message-index ()))


(defun casecopy (use-case-from-this-string to-generate-this-string)
  (if (lessp #.(1- #/A) (ar-1 use-case-from-this-string 0) #.(1+ #/Z))
      (let ((s (string-append to-generate-this-string)))
	(as-1 (char-upcase (ar-1 s 0)) s 0)
	s)
      to-generate-this-string))

(defun (lan request) (&aux (lan (get-frobbed-string)))
  (cond ((string-equal lan '|brandx|)
	   (setq lan (casecopy lan '|brand-x|)))
	((string-equal lan '|lispm|)
	   (setq lan (casecopy lan '|lisp machine lisp|)))
	((string-equal lan '|zetalisp|)
	  (setq lan (casecopy lan '|lisp machine lisp|))))
  (loop with upper = jin-cur-font
	 and lower = (transform-font #/S jin-cur-font)	; the small version
		     ;(if (= jin-cur-font italic-font) small-italic-font
		     ;    small-text-font)
	 and jin-cur-font = jin-cur-font
	for i from 0 below (string-length lan)
	as ch fixnum = (ar-1 lan i)
	when (lessp #.(1- #/A) ch #.(1+ #/Z))
	  do (setq jin-cur-font upper)
	  else do (setq jin-cur-font lower ch (char-upcase ch))
	do (jin-stuff-printing-char ch 0)))

(defun (computer request) ()
  (frob-in-font computerese-font))


(defvar start-ref
  (just-string '|/3/[|))
(defvar end-ref
  (just-string '|/]/*|))

(defvar font-unshift
  (just-string '|/*|))

(defvar references-used
  ())


(defun (ref request) ()
  (let ((name (string-intern (string-append (get-word-string) '|-ref|))))
    (jin-push end-ref)
    (jin-push (just-symeval name '|/2ref/*| 'ref))
    (jin-push start-ref)
    (or (memq name references-used) (push name references-used))
    t))

(defvar reference-count
  0)

(defun (start_references request) ()
  (check-env 'text 'start_references)
  (check-font-status text-font)
  (push primary-section-toc-leading table-of-contents) ;leading
  (add-to-index (just-string '|References|) 'table-of-contents)
  (or (need-space-mills 2000.) (output-leading-mills section-pre-leading))
  (set-hpos left-margin)
  (let ((jin-cur-font primary-section-title-font))
    (put-string-flush-left '|References|)
    (line-advance))
  (setq begin-new-paragraph t)
  (format t '|~& References|)
  (output-leading-mills primary-section-post-leading)
  (setq reference-count 0))

(defun (finish_references request) ()
  (check-env 'text 'finish_references)
  (check-font-status text-font)
  (setq references-used () begin-new-paragraph t))


(defun (defref request) ()
  (check-env 'text 'defref)
  (check-font-status text-font)
  (let ((name (string-intern (string-append (get-word-string) '|-ref|))))
    (flush-request-line)
    (or (memq name references-used)
	(format t '|~&(Reference ~A not used)~%| name))
    ;Since references come in their own section we don't bother with
    ; paragraph-leading hacking.
    (OUTPUT-LEADING-MILLS interparagraph-leading)
    (OUTPUT-PENDING-LEADING)
    (setq begin-new-paragraph nil)
    (let ((wid (string-push-get-width
		  (format nil '|~D.|
			  (setq reference-count
				(1+ reference-count))))))
      (SET-HPOS (+ left-margin (- (convert-mills 200.) wid)))
      (OUTPUT-NOFILL-LINE))
    (just-setq name (string-number reference-count))
    (LET ((LEFT-INDENT (+ LEFT-INDENT (convert-mills 500.)))
	  (ENVIRONMENT-TYPE 'DEFREF)
	  (FILL-MODE-P T)
	  (jin-cur-font 1))
      (*catch 'defref (main-loop))
      (OUTPUT-LEADING-MILLS 50.))))

(defun (end_defref request) ()
  (CHECK-ENV 'defref 'end_defref)
  (CHECK-FONT-STATUS 1)
  (SETQ BEGIN-NEW-PARAGRAPH NIL)
  (*throw 'defref nil))


(defun (foo request) ()
  (COND ((need-space-mills 200.) (setq begin-new-paragraph nil))
	(BEGIN-NEW-PARAGRAPH
	 (SETQ BEGIN-NEW-PARAGRAPH NIL)
	 (OUTPUT-LEADING-MILLS INTERPARAGRAPH-LEADING)
	 (OUTPUT-PENDING-LEADING)))
  (loop for x in '(200. 2700. 5000.)
	do (set-hpos (+ left-margin (convert-mills x)))
	   (put-string-flush-left (get-word-string)))
  (LET ((LEFT-INDENT (+ LEFT-INDENT (CONVERT-MILLS 400.)))
	(ENVIRONMENT-TYPE 'foo)
	(FILL-MODE-P t))
    (let ((jin-cur-font text-font))
      (FLUSH-REQUEST-LINE)
      (CHECK-FONT-STATUS text-font)
      (*catch 'foo (main-loop)))))

(defun end-foo-request ()
  (check-env 'foo 'end_foo)
  (check-font-status text-font)
  (*throw 'foo nil))

(defprop end_foo end-foo-request request)

(defun (syntax_table request) ()
  (jin-push (just-string '|.table 3 250 250 0 40/M/
|)))


(defun footnote-request ()
  (COND ((need-space-mills 200.) (setq begin-new-paragraph nil))
	(BEGIN-NEW-PARAGRAPH
	 (SETQ BEGIN-NEW-PARAGRAPH NIL)
	 (OUTPUT-LEADING-MILLS INTERPARAGRAPH-LEADING)
	 (OUTPUT-PENDING-LEADING)))
  (LET ((LEFT-INDENT (+ LEFT-INDENT (CONVERT-MILLS 200.)))
	(ENVIRONMENT-TYPE 'footnote)
	(FILL-MODE-P t))
    (let ((jin-cur-font italic-font))
      (FLUSH-REQUEST-LINE)
      (CHECK-FONT-STATUS italic-font)
      (*catch 'footnote (main-loop)))))

(defprop footnote footnote-request request)
(defun end-footnote-request ()
  (check-env 'footnote 'end_footnote)
  (check-font-status italic-font)
  (*throw 'footnote nil))
(defprop end_footnote end-footnote-request request)

;Kludge.  Compensate for some bug somewhere (probably in xgp -> dover
; conversion) which makes it look like you haven't reached the bottom
; of the page when you have.
(DEFUN HEADINGS-REQUEST ()
  (LET ((WD (GET-WORD-STRING)))
    (COND ((STRING-EQUAL WD 'ON)
	     (setq alarm-vpos-internal
		   (convert-mills (setq alarm-vpos 9900.)))
	     (SETQ SUPPRESS-HEADINGS NIL)
	     (RESET-PAGE-NUMBER 1))
	  ((STRING-EQUAL WD 'OFF)
	     (SETQ SUPPRESS-HEADINGS T
		   alarm-vpos-internal
		   (convert-mills (setq alarm-vpos bottom-heading-vpos))))
	  (T (BARF '|.HEADINGS arg of | WD '| should be ON or OFF|)))))


(DEFUN DEFconstant-REQUEST ()
  (CHECK-ENV 'TEXT 'defconstant)
  (OR (NEED-SPACE-MILLS 1000.) ;1 inch
      (OUTPUT-LEADING-MILLS DEFUN-PRE-LEADING))
  (CHECK-FONT-STATUS TEXT-FONT)
  ((LAMBDA (LEFT-INDENT ENVIRONMENT-TYPE EXTRA-LEFT-INDENT-FIRST-LINE-OF-PARAGRAPH)
      (DEFconstant1-REQUEST)  ;Gobble the arguments, put out line, index, etc.
      (FLUSH-REQUEST-LINE)
      (DEFUN-HORRIBLE-TAB-CROCK)
      (*CATCH 'DEFconstant (MAIN-LOOP)))
   (CONVERT-MILLS 500.) ;1/2 inch indent
   'DEFconstant
   0))


(DEFUN DEFconstant1-REQUEST ()
  (CHECK-ENV 'DEFconstant 'DEFconstant1)
  (variable-defining-request '|Constant| '|Constant|))

(DEFUN END-DEFconstant-REQUEST ()
  (end-documentation-block 'defconstant 'end_defconstant text-font))

(defprop defconstant defconstant-request request)
(defprop defconstant1 defconstant1-request request)
(defprop end_defconstant end-defconstant-request request)

(defun variable-defining-request (remark index-remark)
  (SETQ CUR-HPOS 0)
  (let ((variable-name (get-word-string))
	(other-randomness (get-line-string))
	(jin-cur-font lisp-title-font))
    (or variable-name (barf '|Variable name missing in .DEFVAR or .DEFVAR1|))
    (ADD-TO-LISTING
       (if index-remark (list variable-name index-remark) VARIABLE-NAME)
       'VARIABLE-INDEX)
    (AUTO-SETQ VARIABLE-NAME '|var|)
    (SET-HPOS LEFT-MARGIN)
    (PUT-STRING-FLUSH-LEFT VARIABLE-NAME)
    (cond ((plusp (string-length other-randomness))
	     (setq jin-cur-font text-font)
	     (output-nofill-string (just-string '|  |))
	     (output-nofill-string other-randomness)))
    (put-defspec-remark remark)
    (LINE-ADVANCE)
    (SETQ BEGIN-NEW-PARAGRAPH NIL)))

;Paranoia.
(sstatus uuolinks)

