Artifact 1b8be70c8786186551547adf1900334b21a36f62b7ff455d304cbe3753e6b3c9:
- File
psl-1983/3-1/nmode/doc.sl
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 6988) [annotate] [blame] [check-ins using] [more...]
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % Doc.SL - NMODE On-line Documentation % % Author: Jeffrey Soreff % Hewlett-Packard/CRC % Date: 15 February 1983 % Revised: 8 April 1983 % % 8-April-83 Jeff Soreff % Altered doc-filter-predicate and apply-filter method to adhere to the % "return list of self" convention (see code for apply filter method). % Declare-flavor was used to preserve efficiency of doc-filter-predicate. % 31-Mar-83 Jeff Soreff % Altered set-up-documentation to remove interaction with FRL. % A use of channelread was replaced with nmode-read-and-evaluate-file. % 14-Mar-83 Alan Snyder % Convert for changes in browser mechanism. Clear modified flag of % documentation buffer. Fixup external declarations and load statement. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% (BothTimes (load objects extended-char fast-strings numeric-operators)) (on fast-integers) % External variables: (fluid '(text-mode)) % Internal static variables: (fluid '(view-mode doc-obj-list doc-browser-mode doc-browser-command-list doc-browser-documentation-text doc-browser-help-text doc-filter-argument-list doc-text-file reference-text-file doc-text-buffer)) (setf doc-obj-list nil) (setf doc-text-file "SS:<PSL.NMODE-DOC>FRAMES.LPT") (setf reference-text-file "SS:<PSL.NMODE-DOC>COSTLY.SL") (setf doc-browser-help-text ["? View Edit Filter uNdo-filter Ignore Quit"]) (setf doc-browser-documentation-text ["The Documentation Browser displays documentation on NMODE." "Terminology: the current item is the item pointed at by the cursor." "The View (V) and Edit (E) commands both display the current item." "In split-screen mode, Edit selects the bottom window while View does not." "The Filter (F) command asks for a string and removes all items that" "do not match the string." "The Ignore (I) command removes the current item from the display." "The uNdo-Filter (N) command restores the items removed by the most" "recent Filter command or by the most recent series of Ignore commands." "The Quit (Q) command exits the browser." ]) (de set-up-documentation () (when (null doc-obj-list) (setf doc-text-buffer (create-unnamed-buffer text-mode)) (insert-file-into-buffer doc-text-buffer doc-text-file) (=> doc-text-buffer set-modified? NIL) (nmode-read-and-evaluate-file reference-text-file) (let ((browser (create-nmode-documentation-browser))) (=> browser set-items doc-obj-list) ) NIL )) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % Documentation Browser Commands % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% (setf view-mode (nmode-define-mode "View" '((nmode-define-commands Read-Only-Text-Command-List) (nmode-define-commands Read-Only-Terminal-Command-List) (nmode-define-commands Window-Command-List) (nmode-define-commands Essential-Command-List) (nmode-define-commands Basic-Command-List) (nmode-define-commands (list (cons (x-char Q) 'select-previous-buffer-command))) ))) (setf Doc-Browser-Mode (nmode-define-mode "Doc-Browser" '( (nmode-define-commands Doc-Browser-Command-List) (nmode-establish-mode Read-Only-Text-Mode) ))) (setf Doc-Browser-Command-List (list (cons (x-char ?) 'browser-help-command) (cons (x-char F) 'doc-filter-command) (cons (x-char E) 'browser-edit-command) (cons (x-char I) 'browser-ignore-command) (cons (x-char N) 'browser-undo-filter-command) (cons (x-char V) 'browser-view-command) (cons (x-char Q) 'browser-exit-command) (cons (x-char SPACE) 'move-down-command) )) (de doc-obj-compare (obj1 obj2) (let ((indx1 (doc-browse-obj$index obj1)) (indx2 (doc-browse-obj$index obj2))) (< indx1 indx2))) (de doc-filter-command () (let ((browser (current-browser)) (doc-filter-argument-list (list (prompt-for-string "Search for what string in a command's name or references?" "")))) (=> browser filter-items #'doc-filter-predicate) )) (declare-flavor doc-browse-obj doc-obj obj-temp) (de doc-filter-predicate (doc-obj) (let* ((old-name (=> doc-obj name)) (ref-list (=> doc-obj ref-list)) (pattern (string-upcase (first doc-filter-argument-list))) (pattern-length (string-length pattern)) (name-list (cons old-name (for (in ref ref-list) (with name-list obj-temp) (collect (let ((obj-temp (eval ref))) (=> obj-temp name)) name-list) (returns name-list))))) (for (in name name-list) (with found) (do (when (let ((limit (- (string-length name) pattern-length)) (char-pos 0)) (while (<= char-pos limit) (if (pattern-matches-in-line pattern name char-pos) (exit char-pos)) (incr char-pos))) (setf found t))) (returns found)))) (undeclare-flavor doc-obj obj-temp) (de create-nmode-documentation-browser () (create-browser 'DOCUMENTATION-BROWSER "Documentation" "NMODE" doc-browser-mode (create-unnamed-buffer view-mode) ["NMODE Documentation Browser Subsystem" ""] doc-browser-documentation-text doc-browser-help-text () #'doc-obj-compare) ) (de apropos-command () (let* ((doc-filter-argument-list (list (prompt-for-string "Search for what string in a command's name or references?" ""))) (jnk (set-up-documentation)) (browser (or (find-browser 'DOCUMENTATION-BROWSER "NMODE") (create-nmode-documentation-browser) ))) (=> browser set-items doc-obj-list) (=> browser filter-items #'doc-filter-predicate) (browser-enter browser) )) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % % The doc-browse-obj (documentation-browser-object) flavor: % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% (defflavor doc-browse-obj ( name type index (start-line NIL) (end-line NIL) (ref-list ()) ) () initable-instance-variables gettable-instance-variables ) (defmethod (doc-browse-obj display-text) () (string-concat (id2string type) ": " name)) (defmethod (doc-browse-obj view-buffer) (buffer) (unless buffer (setf buffer (create-unnamed-buffer view-mode))) (=> buffer reset) (if (not (and start-line end-line)) (=> buffer insert-string "Sorry, no documentation is availible on this topic.") (=> buffer insert-text (cdr (=> doc-text-buffer extract-region NIL (cons start-line 0) (cons end-line 0))))) (=> buffer move-to-buffer-start) (=> buffer set-modified? nil) buffer) (defmethod (doc-browse-obj update) () T ) (defmethod (doc-browse-obj cleanup) () NIL) (defmethod (doc-browse-obj apply-filter) (filter) (apply filter (list self))) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% (off fast-integers)