;;; -*- Mode:LISP; Package:Zwei; Fonts:(CPTFONT); Base:10 -*- ;;; Copyright (C) Lisp Machine, Inc. 1984, 1985, 1986 ;;; See filename "Copyright" for ;;; licensing and release information. ;;; The commands executed when the user wants Gateway to do something. ;;; Constants and routines closely associated with a particular command are ;;; adjacent to it. Most commands are executed in response to menu selections ;;; or Zmacs keystrokes. A few are used internally by Gateway; these have to have ;;; associated keystrokes to keep the Zmacs command loop happy, but they are ;;; not meant to be invoked directly from the keyboard. The keystrokes ;;; associated with the various commands are given in the comtab in the ;;; file G-BASICS. Internal commands are at the end of this file. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; ;;; ;;; DISPLAY-INFORMATION COMMANDS ;;; ;;; ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; NEXT-NODE ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display the next node in the current script. (defun NEXT-NODE () (let ((script-frame (get-name-of-next-node))) (if script-frame (seek-data-node script-frame) (barf "~% ***** THIS IS THE BOTTOM OF THE CURRENT SCRIPT *****")))) (defun GET-NAME-OF-NEXT-NODE () (script-frame-next *current-script-frame*)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; PREVIOUS-NODE ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display the previous node in the current script. (defun PREVIOUS-NODE () (let ((script-frame (get-name-of-previous-node))) (if script-frame (seek-data-node script-frame) (barf "~% ***** THIS IS THE TOP OF THE CURRENT SCRIPT *****")))) (defun GET-NAME-OF-PREVIOUS-NODE () (script-frame-previous *current-script-frame*)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; FIRST-NODE ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display the first node in the current script. (defun FIRST-NODE () (let ((script-frame (get-name-of-first-node))) (seek-data-node script-frame))) (defun GET-NAME-OF-FIRST-NODE () (gnode-first-script-frame (get-node (script-frame-script-name *current-script-frame*) 'complain 'throw))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; CURRENT-SCRIPT ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display the current script. (defun CURRENT-SCRIPT () (let ((script-frame (get-name-from-current-script))) (when script-frame (seek-data-node script-frame)))) (defun GET-NAME-FROM-CURRENT-SCRIPT () (let* ((item-list (gnode-script-item-list (get-node (script-frame-script-name *current-script-frame*) 'complain 'throw))) (script-frame (tv:menu-choose item-list))) script-frame)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; INITIAL-SCRIPT ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display the initial script. (defun INITIAL-SCRIPT () (let ((script-frame (get-name-from-initial-script))) (when script-frame (seek-data-node script-frame)))) (defun GET-NAME-FROM-INITIAL-SCRIPT () (let* ((item-list (gnode-script-item-list (get-node *initial-script* 'complain 'throw))) (script-frame (tv:menu-choose item-list))) script-frame)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; DEFAULT-SCRIPT ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display the default script. (defun DEFAULT-SCRIPT () (let ((script-frame (get-name-from-default-script))) (when script-frame (seek-data-node script-frame)))) (defun GET-NAME-FROM-DEFAULT-SCRIPT () (let* ((item-list (gnode-script-item-list (get-node *default-script-nodename* 'complain 'throw))) (script-frame (tv:menu-choose item-list))) script-frame)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; ;;;; TYPE-TITLE-AND-FILE ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Type in the title and the file for a node. (defun TYPE-TITLE-AND-FILE (&aux sought-node) (setq sought-node (get-defaulted-title-and-file)) (get-node sought-node 'complain 'throw) (add-entry-to-default-script sought-node) (seek-data-node (get-script-frame-for-node sought-node *default-script-nodename*))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; ;;; ;;; ACCESS-INDEX COMMANDS ;;; ;;; ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; SELECT-INDEX ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Select a menu element to get the index page for that range of topics. (defun SELECT-INDEX (&aux index-page) (setq *index-chosen* (tv:menu-choose *index-system*)) (cond ((string-equal *index-chosen* "lmm-1") (when (setq index-page (tv:menu-choose *index-lmm-1*)) (setq *index-default-page* index-page) (get-index-page))) ((string-equal *index-chosen* "lmm-2") (when (setq index-page (tv:menu-choose *index-lmm-2*)) (setq *index-default-page* index-page) (get-index-page))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; GET-INDEX-PAGE ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Get an index entry; display the page described in the entry. (defun GET-INDEX-PAGE (&aux index-node index-value index-item-list script script-frame) (setq index-node (get-node *index-default-page* 'complain 'throw)) (unless (setq index-item-list (gnode-index-item-list index-node)) (setq index-item-list (index-page-item-list-setup index-node))) (when (setq index-value (tv:menu-choose index-item-list)) (setq script (get-node (cadr index-value) 'complain 'throw)) (setq script-frame (gnode-first-script-frame script)) (seek-data-node (get-script-frame-for-node (car index-value) (script-frame-script-name script-frame))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; INDEX-PAGE-ITEM-LIST-SETUP ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Setup the menu item list which is to be displayed for an index page. (defun INDEX-PAGE-ITEM-LIST-SETUP (index-node) (setq index-node index-node) (let ((item-list nil)) (do* ((index (gnode-index index-node)(cdr index)) (index-element (caar index)(caar index)) (end (length index)(1- end)) (first-time t nil)) ((equal end 0) (alter-gnode index-node :index-item-list item-list) item-list) (when first-time (setq item-list (nconc item-list (list (list "USE LEFT SCROLL BAR TO SEE ADDITIONAL ENTRIES" :no-select nil :font fonts:hl10b)))) (setq item-list (nconc item-list (list (skip-a-line)))) (setq item-list (nconc item-list (list (list (caddr (gnode-nodename index-node)) :no-select nil :font fonts:hl10b)))) (setq item-list (nconc item-list (list (skip-a-line))))) (setq item-list (nconc item-list (index-item-setup index-element)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; INDEX-ITEM-SETUP ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Create an index item for a menu item list. (defun INDEX-ITEM-SETUP (index-element &aux index-entry raw-node-id raw-script-id cooked-node-id cooked-script-id bar-posn-1 bar-posn-2) (setq index-entry (substring index-element 0 (setq bar-posn-1 (string-search-set "|" index-element)))) (setq bar-posn-1 (plus 1 bar-posn-1)) (setq raw-node-id (substring index-element bar-posn-1 (setq bar-posn-2 (string-search-set "|" index-element bar-posn-1)))) (setq bar-posn-2 (plus 1 bar-posn-2)) (setq raw-script-id (substring index-element bar-posn-2 (string-search-set "|" index-element bar-posn-2))) (multiple-value-bind (raw-node-file raw-node-title) (parse-script-reference raw-node-id) (setq cooked-node-id (read-from-string (make-nodename raw-node-file raw-node-title)))) (multiple-value-bind (raw-script-file raw-script-title) (parse-script-reference raw-script-id) (setq cooked-script-id (read-from-string (make-nodename raw-script-file raw-script-title)))) (list (list index-entry :value (list cooked-node-id cooked-script-id) :font fonts:hl10 :documentation "MOUSE THE HIGHLIGHTED ENTRY TO DISPLAY A NODE ABOUT ITS TOPIC. USE THE LEFT SCROLL BAR TO SEE ADDITIONAL ENTRIES."))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; ;;; ;;; SELECT-BY-HISTORY COMMANDS ;;; ;;; ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; FULL-HISTORY ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display a list of all previously selected data and script nodes. (defun FULL-HISTORY () (let ((history-frame (get-name-from-full-history))) (when history-frame (seek-data-node (get-script-frame-for-history-frame history-frame))))) (defun GET-NAME-FROM-FULL-HISTORY () (tv:menu-choose *top-full-history-list*)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; DATA-NODE-HISTORY ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display a list of all previously selected data nodes. (defun DATA-NODE-HISTORY () (let ((history-frame (get-name-from-data-node-history))) (when history-frame (seek-data-node (get-script-frame-for-history-frame history-frame))))) (defun GET-NAME-FROM-DATA-NODE-HISTORY () (tv:menu-choose *top-data-node-history-list*)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; SCRIPT-HISTORY ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display a list of all previously selected script nodes. (defun SCRIPT-HISTORY () (let ((history-frame (get-name-from-script-history))) (when history-frame (seek-data-node (get-script-frame-for-history-frame history-frame))))) (defun GET-NAME-FROM-SCRIPT-HISTORY () (tv:menu-choose *top-script-history-list*)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; EDITING-HISTORY ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display a list of all nodes that have been edited. (defun EDITING-HISTORY () (let ((history-frame (get-name-from-editing-history))) (when history-frame (seek-data-node (get-script-frame-for-history-frame history-frame))))) (defun GET-NAME-FROM-EDITING-HISTORY () (tv:menu-choose *top-editing-history-list*)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; NODE-MARKS ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display a list of all node marks. (defun NODE-MARKS () (let ((history-frame (get-name-from-node-mark-list))) (when history-frame (seek-data-node (get-script-frame-for-history-frame history-frame))))) (defun GET-NAME-FROM-NODE-MARK-LIST () (tv:menu-choose *top-node-mark-list*)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; BACKTRACK ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Redisplay the node that was current before the one now on display. (defun BACKTRACK () (let ((history-frame (third (cadr *backtrack-list*)))) (if (null history-frame) (barf "~% **** THIS IS THE FIRST NODE THAT WAS PREVIOUSLY DISPLAYED ****") (seek-data-node (get-script-frame-for-history-frame history-frame) :backtrack t) (pop *backtrack-list*)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; ;;; ;;; EDIT-DATA-NET COMMANDS ;;; ;;; ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ENTER-EDITOR ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Enter edit mode, either due to the enter-editor command or via assure-edit-mode. (defun ENTER-EDITOR () (setq *current-gateway-mode* 'edit-mode) (send *herald-pane* :set-item-list (edit-herald)) (redisplay-current-node) t) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ASSURE-EDIT-MODE ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; If the user has given an edit-mode command, but we are not in edit mode, ;;; ask if the user wants to go ther, and act accordingly. (defun ASSURE-EDIT-MODE () (if (edit-mode-p) t (tv:beep) (when (y-or-n-p (cond ((gateway-p) "That is an LMI-GATEWAY editor command. Enter the editor?") ((guide-p) "That is an LMI-GUIDE editor command. Enter editor?") ((odm-p) "That is an LMI-ODM editor command. Enter the editor?"))) (enter-editor)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; CREATE-NODE ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Create a new node, possibly in a new file/buffer. (defun CREATE-NODE (&aux new-file) (when (assure-edit-mode) ;;; Set up defaults for choose-variable-values. (setq *file-title* (send *interval* :pathname)) (setq *node-title* (second (script-frame-node-name *current-script-frame*))) ;;; Find out what the user wants to create. (condition-case () (let ((fs:*name-specified-default-type* "GATE")) (tv:choose-variable-values `(" "(*node-type* "Type of Node" :documentation "Choose Data or Script" :assoc (("Data" . "=Text:") ("Script" . "=Script:")) ) (*node-title* "Name for the node" :string) (*file-title* "Filename for the node" :pathname ,*file-title* ) " ") :label "Create Data Node or Script Node" :near-mode '(:point 500 500) :extra-width 15 :margin-choices '("Do It" ("Abort" (signal 'sys:abort :format-string "abort"))))) (sys:abort nil) (:no-error ;;; Process the user's input into the format we will need. (let ((node-to-create (list *file-title* *node-title* *node-title*)) (pathname (make-absolute-pathname *file-title*)) (node-id *node-title*)) ;;; Avoid creation of a redundant node. (check-node-nonexistent node-to-create 'complain 'throw) ;;; Obtain the file/buffer, creating it if necessary. (setq new-file (make-current-a-file-that-might-exist pathname)) ;;; Mark the buffer for resectionization. (puthash pathname t *resectionize-p-hash-table*) ;;; Create the header for the new node. (cond (new-file (move-bp (point) (insert (point) (format nil "=Node: ~A~2%~A~2%" node-id *node-type*)))) (t (move-bp (point) (interval-last-bp *interval*)) (move-bp (point) (insert (point) (format nil "~2%=Node: ~A~2%~A~2%" node-id *node-type*))))) ;;; Add the node to the default script, then display it for editing.. (add-entry-to-default-script node-to-create) (seek-data-node (get-script-frame-for-node node-to-create *default-script-nodename*)) (com-goto-end)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; MODIFY-NODE ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Modify an existing node in an existing file/buffer. (defun MODIFY-NODE () (when (assure-edit-mode) ;;; Set up defaults for choose-variable-values. (setq *file-title* (send *interval* :pathname)) (setq *node-title* (second (script-frame-node-name *current-script-frame*))) ;;; Find out what the user wants to modify. (condition-case () (let ((fs:*name-specified-default-type* "GATE")) (tv:choose-variable-values `(" " (*node-title* "Name of the node" :string) (*file-title* "Filename of the node" :pathname ,*file-title* ) " ") :label "Modify Data Node or Script Node" :width 60 :margin-choices '("Do It" ("Abort" (signal 'sys:abort :format-string "abort"))))) (sys:abort nil) (:no-error ;;; Process the user's input into the format we will need. (let ((node-to-modify (list *file-title* *node-title* *node-title*)) (pathname (make-absolute-pathname *file-title*))) ;;; Be sure the node already exists. (get-node node-to-modify 'complain 'throw) ;;; Mark the node's buffer for resectionizing (puthash pathname t *resectionize-p-hash-table*) ;;; Add the node to the default script, then display it for editing.. (add-entry-to-default-script node-to-modify) (seek-data-node (get-script-frame-for-node node-to-modify *default-script-nodename*)) (com-goto-beginning)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; *GENERATE-SCRIPT-CHOICES* ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Menu used by the GENERATE-SCRIPT command. (defconst *GENERATE-SCRIPT-CHOICES* (make-instance 'tv:momentary-menu :item-list '((" Generate Script From: " :no-select nil :font fonts:cptfontb) ("" :no-select nil) ("File//Buffer" :value fb :font fonts:cptfont :documentation "Generate script from the nodes in a file or buffer") ("Full History" :value fh :font fonts:cptfont :documentation "Generate script from Full History") ("Data Node History" :value nh :font fonts:cptfont :documentation "Generate script from Data Node History") ("Script Node History" :value sh :font fonts:cptfont :documentation "Generate script from Script Node History") ("Editing History" :value eh :font fonts:cptfont :documentation "Generate script from Editing History") ("Node Marks" :value nm :font fonts:cptfont :documentation "Generate script from Node Marks List") ("" :no-select nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; GENERATE-SCRIPT ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Generate a script from a file/buffer, history, or node mark list. (defun GENERATE-SCRIPT (&aux buffer buf) (when (assure-edit-mode) ;;; Set up the defaults for choose-variable-values. (setq *file-title* (send *interval* :pathname)) (setq *node-title* (second (script-frame-node-name *current-script-frame*))) (condition-case () ;;; Find out what the user wants to generate. (let ((fs:*name-specified-default-type* "GATE")) (tv:choose-variable-values `("" (*creation-source* "Generate Script From" :documentation "Choose a source for Script Generation" :assoc ((" File or Buffer " . fb) (" Full History " . fh) (" Data Node History " . nh) (" Script Node History " . sh) (" Editing History " . eh) (" Node Marks " . nm)) ) (*node-title* "Name for the node" :string) (*file-title* "Filename for the node" :pathname ,*file-title*) "" "") :label "Generate a Script Node" :near-mode '(:point 500 500) :extra-width 15 :margin-choices '("Do It" ("Abort" (signal 'sys:abort :format-string "abort"))))) (sys:abort nil) (:no-error ;;; If the script is to be generated from a file/buffer, get its name, then ;;; be sure it exists before proceeding. (and (eq *creation-source* 'fb) (null (setq buffer (find-a-file-that-does-exist (setq buf (make-absolute-pathname (read-defaulted-pathname "Create from File or Buffer Named:" (send *interval* :pathname) "GATE" nil :new-ok)) )))) (barf "~% **** FILE NOT FOUND: ~A ****" (send buf :string-for-printing))) ;;; Process the user's input into the format we will need. (let ((node-to-create (list *file-title* *node-title* *node-title*)) (pathname (make-absolute-pathname *file-title*)) (node-id *node-title*)) ;;; Avoid creating a redundant node (check-node-nonexistent node-to-create 'complain 'throw) ;;; Mark the new node's file for resectionizing. (puthash pathname t *resectionize-p-hash-table*) ;;; Create the header for the node. (cond ((make-current-a-file-that-does-exist pathname) (move-bp (point) (interval-last-bp *interval*)) (move-bp (point) (insert (point) (format nil "~2%=Node: ~A~2%=Script:~2%" node-id)))) ((make-current-a-file-that-does-not-exist pathname) ;RETURNS nil (move-bp (point) (insert (point) (format nil "=Node: ~A~2%=Script:~2%" node-id))))) ;;; Create the script the user wants. (selectq *creation-source* (fb (generate-from-file buffer)) (fh (generate-from-history-list *top-full-history-list*)) (nh (generate-from-history-list *top-data-node-history-list*)) (sh (generate-from-history-list *top-script-history-list*)) (eh (generate-from-history-list *top-editing-history-list*)) (nm (generate-from-history-list *top-node-mark-list*))) ;;; Put the node on the default script, then display it for further editing. (add-entry-to-default-script node-to-create) (seek-data-node (get-script-frame-for-node node-to-create *default-script-nodename*)) (com-goto-end)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; GENERATE-FROM-FILE ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Create a script that references all the nodes in a file. (defun GENERATE-FROM-FILE (buffer &aux name-from-pathname scan-bp line) (setq name-from-pathname (send (send buffer :pathname) :name)) (setq scan-bp (copy-bp (send buffer :first-bp))) (tagbody loop (when (node-start (setq line (car scan-bp))) (com-beginning-of-line) (move-bp (point) (insert (point) (string-remove-epsilon-fonts (format nil "~C (~A)~A~%" #/@ name-from-pathname (get-title-from-header line)))))) (when (setq line (line-next (car scan-bp))) (move-bp scan-bp line 0) (go loop))) (setq *mark-stays* nil)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; GENERATE-FROM-HISTORY-LIST ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Create a script that references all the nodes in a history or node-mark list. (defun GENERATE-FROM-HISTORY-LIST (&optional (list *top-full-history-list*)) (dolist (thing (cdr list)) (let* ((parse-item (aref (third thing) 1)) (thing-1 (car parse-item)) (thing-2 (cadr parse-item))) (com-beginning-of-line) (move-bp (point) (insert (point) (string-remove-epsilon-fonts (format nil "@ (~A)~A~%" (send (make-absolute-pathname thing-1) :name) thing-2)))))) (setq *mark-stays* nil)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; CREATE-FILE ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Create a new Gateway file for editing as a whole. The effect of create-file ;;; also occurs when the user does a create-node in a file/buffer that does not ;;; exist. (defun CREATE-FILE () (when (assure-edit-mode) ;;; Set the defaults for choose-variable-values. (setq *file-title* (send *interval* :pathname)) (condition-case () ;;; Find out what file the user wants to create. (let ((fs:*name-specified-default-type* "GATE")) (tv:choose-variable-values `(" " (*file-title* "Filename to create" :pathname ,*file-title* ) " ") :label "Create File" :near-mode '(:point 500 500) :extra-width 15 :margin-choices '("Do It" ("Abort" (signal 'sys:abort :format-string "abort"))))) (sys:abort nil) (:no-error ;;; If the file already exists, give an error message. Otherwise, ;;; create it and display it for editing. (if (not (make-current-a-file-that-does-not-exist *file-title*)) (barf "~% ***** FILE ALREADY EXISTS *****") (setq *current-node-title* "") (must-redisplay *window* dis-all)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; MODIFY-FILE ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Modify a Gateway file as a whole. (defun MODIFY-FILE () (when (assure-edit-mode) ;;; Set defaults for choose-variable-values. (setq *file-title* (send *interval* :pathname)) (condition-case () ;;; Find out what file the user wants to modify. (let ((fs:*name-specified-default-type* "GATE")) (tv:choose-variable-values `(" " (*file-title* "Filename to modify" :pathname ,*file-title* ) " ") :label "Modify File" :near-mode '(:point 500 500) :extra-width 15 :margin-choices '("Do It" ("Abort" (signal 'sys:abort :format-string "abort"))))) (sys:abort nil) (:no-error ;;; If the file does not exist, give an error message. Otherwise, be ;;; sure it is in GATE mode, mark any nodes it contains as potentially ;;; changed, then display it for editing (if (not (make-current-a-file-that-does-exist *file-title*)) (barf "~% ***** FILE DOES NOT EXIST *****") (force-meta-x-gate-mode-command) (puthash (make-absolute-pathname *file-title*) t *resectionize-p-hash-table*) (do ((line (bp-line (interval-first-bp *interval*)) (line-next line))) ((not line)) (when (node-start line) (let ((nodename (read-from-string (make-nodename *file-title* (node-name line))))) (puthash nodename nil *node-hash-table*)))) (setq *current-node-title* "") (com-goto-beginning) (reparse-buffer-attribute-list-or-mode-line *interval*) (must-redisplay *window* dis-all)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; WRITE-CHANGES ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Scan all known Zmacs buffers, and offer to write to disk any buffer that is ;;; a Gateway buffer, has been modified, and is not one of Gateway's utility ;;; buffers. (defun WRITE-CHANGES (&aux modified-buffers buffer-name buffer-name-length) (when (assure-edit-mode) (dolist (list-name *zwei-buffer-list-names*) (setq modified-buffers ()) (dolist (buffer (symeval list-name)) (if (and (buffer-modified-p buffer) (eq (send buffer :saved-major-mode) 'gate-mode) (setq buffer-name (send buffer :name)) (setq buffer-name-length (string-length buffer-name)) (not (string-equal (substring buffer-name 0 (min buffer-name-length 22)) "SCRIPT-DISPLAY-BUFFER-")) (not (string-equal (substring buffer-name 0 (min buffer-name-length 19)) "XREF-DISPLAY-BUFFER")) (not (string-equal (substring buffer-name 0 (min buffer-name-length 22)) "DEFAULT-SCRIPT-BUFFER-")) (not (string-equal (substring buffer-name 0 (min buffer-name-length 18)) "PRINT-NODE-BUFFER-"))) (push buffer modified-buffers))) (if (not modified-buffers) (barf "~% ***** NO CHANGES TO GATEWAY DATA NEED TO BE WRITTEN *****") (dolist (buffer modified-buffers) (when (fquery nil "Save buffer ~A ? " (buffer-name buffer)) (normalize-gateway-buffer buffer) (write-buffer buffer))))) (redisplay-current-node))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; RETURN TO DISPLAYER ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Return from edit mode to display mode. (defun RETURN-TO-DISPLAYER (&aux return-ok) ;;; Mark the node to be redisplayed for reprocessing. This takes care of a ;;; fencepost that occurs when GATEWAY-DISPLAY-NODE displays in Display Mode ;;; the same node it was displaying in Edit Mode. (let ((node-being-redisplayed (script-frame-node-name *current-script-frame*))) (puthash node-being-redisplayed nil *node-hash-table*) (puthash (make-absolute-pathname (car node-being-redisplayed)) t *resectionize-p-hash-table*)) ;;; We unwind-protect this so that if the user has damaged the ODM's ;;; data so much that there's no way back to display mode, he'll at least ;;; be left in a usable edit mode so that the damage can be repaired. (unwind-protect (progn (setq *current-gateway-mode* 'display-mode) (send *herald-pane* :set-item-list (display-herald)) (redisplay-current-node) (setq return-ok t)) (unless return-ok (setq *current-gateway-mode* 'edit-mode) (send *herald-pane* :set-item-list (edit-herald)))) t) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; ;;; ;;; MISCELLANEOUS COMMANDS ;;; ;;; ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; *CREATE-NODE-MARK-CHOICES* ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Menu used by the CREATE-NODE-MARK command. (defconst *CREATE-NODE-MARK-CHOICES* (make-instance 'tv:momentary-menu :item-list '((" Create Using? " :no-select nil :font fonts:cptfontb) ("" :no-select nil) ("Current Node" :value cn :font fonts:cptfont :documentation "Add the current node to Node Mark List") ("Full History" :value fh :font fonts:cptfont :documentation "Add an item from Full History to Node Mark List") ("Data Node History" :value nh :font fonts:cptfont :documentation "Add an item from Data Node History to Node Mark List") ("Script Node History" :value sh :font fonts:cptfont :documentation "Add an item from Script Node History to Node Mark List") ("Editing History" :value eh :font fonts:cptfont :documentation "Add an item from Editing History to Node Mark List") ("" :no-select nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; CREATE-NODE-MARK ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Create a node mark. (defun CREATE-NODE-MARK (&aux name) (selectq (send *create-node-mark-choices* :choose) (cn (setq *top-node-mark-list* (update-a-history-list *top-node-mark-list* *current-script-frame*))) (fh (when (setq name (get-name-from-full-history)) (setq *top-node-mark-list* (update-a-history-list *top-node-mark-list* name)))) (nh (when (setq name (get-name-from-data-node-history)) (setq *top-node-mark-list* (update-a-history-list *top-node-mark-list* name)))) (sh (when (setq name (get-name-from-script-history)) (setq *top-node-mark-list* (update-a-history-list *top-node-mark-list* name)))) (eh (when (setq name (get-name-from-editing-history)) (setq *top-node-mark-list* (update-a-history-list *top-node-mark-list* name)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; RELATED-INFORMATION ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Show related information for this node. (defun RELATED-INFORMATION (&aux ref-node see-also-list) (setq ref-node (get-node (script-frame-node-name *current-script-frame*) 'complain 'throw)) (if (not (setq see-also-list (gnode-related-information-item-list ref-node))) (barf "~% **** THERE IS NO RELATED INFORMATION FOR THIS NODE ****") (initialize-xref-stuff ref-node) (let ((script-frame (get-name-from-any-item-list see-also-list))) (if script-frame (seek-data-node script-frame) (redisplay-current-node))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; INITIALIZE-XREF-STUFF ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Set up the structures needed to handle a list of cross-references. (defun INITIALIZE-XREF-STUFF (ref-node) (let* ((newname (string-append (cadr (script-frame-node-name *current-script-frame*)) " References")) (related-information-items (cdr (gnode-related-information-item-list ref-node))) (xref-script (make-gnode :nodename (list *xref-display-buffer* newname newname) :script (gnode-related-information ref-node) :script-item-list (gnode-related-information-item-list ref-node) :first-script-frame (third (cadr (gnode-related-information-item-list ref-node)))))) (dolist (related-information-script-frame related-information-items) (setf (script-frame-script-name (third related-information-script-frame)) (gnode-nodename xref-script))) (setup-xref-buffer newname xref-script) ;NOT CLEAR WHAT ARGS newname and xref-script )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; SETUP-XREF-BUFFER ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Create or get the xref buffer and put the cross-references into it. (defun SETUP-XREF-BUFFER (newname xref-script) (make-current-a-file-that-might-exist *xref-display-buffer*) (let-globally ((*interval* *current-gateway-buffer*)) (puthash (make-absolute-pathname *xref-display-buffer*) t *resectionize-p-hash-table*) (delete-interval *interval*) (generate-script-from-any-item-list newname (gnode-script-item-list xref-script)) (puthash (gnode-nodename xref-script) nil *node-hash-table*) )) ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; GET-NAME-FROM-ANY-ITEM-LIST ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display for selection an item list whose :VALUEs are script frames. (defun GET-NAME-FROM-ANY-ITEM-LIST (list) (let ((script-frame (tv:menu-choose list) )) script-frame)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; GENERATE-SCRIPT-FROM-ANY-ITEM-LIST ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Generate a script from an item list whose :VALUEs are script frames. (defun GENERATE-SCRIPT-FROM-ANY-ITEM-LIST (nodename &optional (item-list *top-full-history-list*)) (move-bp (point) (insert (point) (format nil "=Node: ~A~2%=Script:~2%" nodename))) (dolist (thing (cdr item-list)) (let* ((parse-item (aref (third thing) 1)) ;pathname and nodename twice in a list (thing-1 (car parse-item)) ;pathname (thing-2 (cadr parse-item))) ;nodename (com-beginning-of-line) (move-bp (point) (insert (point) (string-remove-epsilon-fonts (format nil "@ (~A)~A~%" (send (make-absolute-pathname thing-1) :name) thing-2)))))) (setq *mark-stays* nil)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; EXECUTE FUNCTION ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Execute function associated with the current node. (defun execute-function (&aux function) (if (null (setq function (gnode-function (get-node (script-frame-node-name *current-script-frame*) 'complain 'throw)))) (barf "~% ***** THERE IS NO FUNCTION FOR THIS NODE *****") (eval function))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; *FORGET-HISTORY-CHOICES* ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Menu used by the FORGET-HISTORY command (defconst *FORGET-HISTORY-CHOICES* (make-instance 'tv:momentary-menu :item-list '((" Which history? " :no-select nil :font fonts:cptfontb) ("" :no-select nil) ("Full History" :value fh :font fonts:cptfont :documentation "Reinitialize Full History") ("Data Node History" :value nh :font fonts:cptfont :documentation "Reinitialize Data Node History") ("Script Node History" :value sh :font fonts:cptfont :documentation "Reinitialize Script Node History") ("Editing History" :value eh :font fonts:cptfont :documentation "Reinitialize Editing History") ("Node Marks" :value nm :font fonts:cptfont :documentation "Reinitialize Node Mark List") ("" :no-select nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; FORGET-HISTORY ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Forget (clear and re-initialize) the node, script, or combined histories. (defun FORGET-HISTORY () (selectq (send *forget-history-choices* :choose) (fh (setq *top-full-history-list* '(("FULL HISTORY" :no-select nil :font fonts:bigfnt))) (redisplay-full-history-pane) (format *query-io* "~% **** FULL HISTORY FORGOTTEN ****") ) (nh (setq *top-data-node-history-list* '(("DATA NODE HISTORY" :no-select nil :font fonts:bigfnt))) (format *query-io* "~% **** DATA NODE HISTORY FORGOTTEN ****") ) (sh (setq *top-script-history-list* '(("SCRIPT NODE HISTORY" :no-select nil :font fonts:bigfnt))) (format *query-io* "~% **** SCRIPT NODE HISTORY FORGOTTEN ****") ) (eh (setq *top-editing-history-list* '(("EDITING HISTORY" :no-select nil :font fonts:bigfnt))) (format *query-io* "~% **** EDITING HISTORY FORGOTTEN ****") ) (nm (setq *top-node-mark-list* '(("NODE MARKS" :no-select nil :font fonts:bigfnt))) (format *query-io* "~% **** NODE MARKS FORGOTTEN ****")) )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; PRINT-DATA ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Print nodes, scripts, or indexes. (defun PRINT-DATA () (print-gateway-node (get-node (script-frame-node-name *current-script-frame*) 'complain 'throw))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; PRINT-GATEWAY-NODE ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Print the node named in the argument. Fonts and layout are exactly as ;;; displayed on the screen. (defun PRINT-GATEWAY-NODE (node &optional (*standard-output* *query-io*)) (format-node-for-printing node) (let* ((fonts (send *print-node-buffer* :get-attribute ':fonts)) ; (interval-first-bp (send *print-node-buffer* :first-bp)) (stream (if (atom fonts) (zwei:interval-stream *print-node-buffer*) (zwei:interval-stream *print-node-buffer* nil nil t)))) ; (when (display-mode-p) ; (move-bp interval-first-bp (line-next (car interval-first-bp)))) (si:hardcopy-stream stream :file-name (format:output nil "ZWEI Buffer " (princ (or (buffer-pathname *print-node-buffer*) (buffer-name *print-node-buffer*))) (and (typep (car-safe (buffer-file-id *print-node-buffer*)) 'fs:pathname) (format t " (~D)" (send (car (buffer-file-id *print-node-buffer*)) :version)))))) (format t " -- Done.") t) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; HELP WITH GATEWAY ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Explain basic LMI-GATEWAY Commands. (defun HELP-WITH-GATEWAY () (format t "You are using the LMI Information Manager. For more help, select /"Help with Gateway/" from the Initial Script. DISPLAY INFORMATION Next Node Super-N Displays the next node in the current script. Previous Node Super-P Displays the previous node in the current script. First Node Super-F Displays the first node in the current script. Current Script Super-S Displays the current script. Initial Script Super-I Displays the initial script. Default Script Super-D Displays the default script. Type Title & File Super-T Displays any node; asks for title & file. ACCESS INDEXES Select Index Hyper-S Selects one of the system indexes for page selection. Get Index Page Hyper-I Chooses a page from the current index. SELECT BY HISTORY Full History Hyper-Super-F Displays list of all nodes selected during a session. Data Node History Hyper-Super-D Displays list of data nodes selected during a session Script Node History Hyper-Super-S Displays list of script nodes selected during session Editing History Hyper-Super-E Displays list of nodes edited during a session. Node Marks Hyper-Super-N Displays list of nodes marked during a session. Backtrack Hyper-Super-B Displays previously selected node. EDIT DATA NET Enter Editor Super-Meta-E Enters edit mode. Create Node Super-C Creates a new node; asks for title & filename. Create File Super-Meta-C Creates a new file; asks for filename. Generate Script Node Hyper-G Automatically generates a script. Modify Node Super-M Modify an existing node; asks for title & filename. Modify File Super-Meta-M Modify an existing file; asks for filename. Write Changes Super-Meta-W Writes all editing changes to disk. Return to Displayer Super-Meta-R Returns to display mode. MISCELLANEOUS Create Node Mark Hyper-Super-M Adds an item you select to the node mark history. Related Information Hyper-Super-R Displays any cross-references for the current node. Execute Function Hyper-Super-X Execute a function associated with the current node. Forget History Super-Meta-F Forgets the contents of a selected history. Print Data Hyper-Super-P Prints the current editor or display node. Help with Gateway  Choose G; prints this screen. Type the key to continue with Gateway. ")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; HELP WITH GUIDE ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Explain basic LMI-GUIDE Commands. (defun HELP-WITH-GUIDE () (format t " You are using GUIDE, the LMI Interactive Tutor. The available commands are: GUIDE COMMANDS Next Node Super-N Displays the next node in the current script. Previous Node Super-P Displays the previous node in the current script. Lesson Contents Super-S Displays the contents of the lesson. Full History Hyper-Super-F Displays list of all nodes selected during a session. Help with Guide  Choose =; prints this screen. Type the key to continue with Guide.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; HELP WITH ODM ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Explain basic LMI-ODM Commands (defun HELP-WITH-ODM (&aux display-pane saved-more-p) (setq display-pane (dolist (inf (send *display-pane-1* :inferiors)) (when (typep inf 'zmacs-window-pane) (return inf)))) (setq saved-more-p (send (send display-pane :typeout-window) :more-p)) (send display-pane :set-more-p nil) (format t "You are using the LMI Online Document Manager. For more help, select /"ODM-SCRIPT/" from the Initial Script, or read the manual /"Online Document Manager/" LMI Part # 3142-0000. DISPLAY INFORMATION Next Node Super-N Displays the next node in the current script. Previous Node Super-P Displays the previous node in the current script. First Node Super-F Displays the first node in the current script. Current Script Super-S Displays the current script. Initial Script Super-I Displays the default initial script. Default Script Super-D Displays the default script. Type Title & File Super-T Displays any node; asks for title & file. ACCESS INDEXES Select Index Hyper-S Selects one of the system indexes for page selection. Get Index Page Hyper-I Chooses a page from the current index. SELECT BY HISTORY Full History Hyper-Super-F Displays list of all nodes selected during a session. Data Node History Hyper-Super-D Displays list of data nodes selected during a session Script Node History Hyper-Super-S Displays list of script nodes selected during session Editing History Hyper-Super-E Displays list of nodes edited during a session. Node Marks Hyper-Super-N Displays list of nodes marked during a session. Backtrack Hyper-Super-B Displays previously selected node. EDIT DATA NET Enter Editor Super-Meta-E Enters edit mode. Create Node Super-C Creates a new node; asks for title & filename. Create File Super-Meta-C Creates a new file; asks for filename. Generate Script Node Hyper-G Automatically generates a script. Modify Node Super-M Modify an existing node; asks for title & filename. Modify File Super-Meta-M Modify an existing file; asks for filename. Write Changes Super-Meta-W Writes all editing changes to disk. Return to Displayer Super-Meta-R Returns to display mode. MISCELLANEOUS Create Node Mark Hyper-Super-M Adds an item you select to the node mark history. Related Information Hyper-Super-R Displays any cross-references for the current node. Forget History Super-Meta-F Forgets the contents of a selected history. Print Data Hyper-Super-P Prints the current node. Help with ODM  Choose O; prints this screen. Type SPACE-BAR to continue with ODM.") (send display-pane :set-more-p saved-more-p) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; ;;; ;;; INTERNAL COMMANDS ;;; ;;; ;;; ;;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; REDISPLAY-CURRENT-NODE ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Redisplay the node currently on display (internal command). (defun REDISPLAY-CURRENT-NODE () (let ((script-frame (get-name-of-current-display-node))) (seek-data-node script-frame))) (defun GET-NAME-OF-CURRENT-DISPLAY-NODE () *current-script-frame*) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; FIRST-FULL-HISTORY-ENTRY ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display the first node named in the full-history pane (internal command). (defun FIRST-FULL-HISTORY-ENTRY () (let* ((history-frame (third (cadr *top-full-history-list*))) (script-frame (get-script-frame-for-history-frame history-frame))) (seek-data-node script-frame))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; SECOND-FULL-HISTORY-ENTRY ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display the second node named in the full-history pane (internal command). (defun SECOND-FULL-HISTORY-ENTRY () (let* ((history-frame (third (caddr *top-full-history-list*))) (script-frame (get-script-frame-for-history-frame history-frame))) (seek-data-node script-frame))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; THIRD-FULL-HISTORY-ENTRY ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display the third node named in the full-history pane (internal command). (defun THIRD-FULL-HISTORY-ENTRY () (let* ((history-frame (third (cadddr *top-full-history-list*))) (script-frame (get-script-frame-for-history-frame history-frame))) (seek-data-node script-frame))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; FOURTH-FULL-HISTORY-ENTRY ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display the fourth node named in the full-history pane (internal command). (defun FOURTH-FULL-HISTORY-ENTRY () (let* ((history-frame (third (car (cddddr *top-full-history-list*)))) (script-frame (get-script-frame-for-history-frame history-frame))) (seek-data-node script-frame))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; NEXT-TWICE-CURRENT-SCRIPT ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display the fourth node named in the current script pane (internal command). (defun NEXT-TWICE-CURRENT-SCRIPT () (let ((script-frame (script-frame-next (script-frame-next *current-script-frame*)))) (if script-frame (seek-data-node script-frame) (barf "~% ***** THIS IS THE BOTTOM OF THE CURRENT SCRIPT *****")))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; DISPLAY-FROM-TUTORIAL-PANE ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display a node whose name was given literally in a menu-item's value (internal command) ;;; (unused). (defun DISPLAY-FROM-TUTORIAL-PANE () (seek-data-node *selected-node*)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; EXECUTE-GATEWAY-COMMAND ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Execute a Gateway command whose name was given literally in a menu-item's value ;;; (internal command). (defun EXECUTE-GATEWAY-COMMAND () (funcall *selected-command*)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ODM-DOCUMENT-SYMBOL ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ODM-DOCUMENT-SYMBOL () (select-via-symbol (get-mini-buffer-string "Document Symbol:")))