%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% NMODE-9836.SL - HP9836 Nmode Stuff (intended only for HP9836 version)
%
% Author: Alan Snyder
% Hewlett-Packard/CRC
% Date: 20 January 1983
% Revised: 15 February 1983
%
% 15-Feb-83 Alan Snyder
% No longer sets NMODE-AUTO-START (inconsistent with other systems).
% Add new online documentation stuff.
% 7-Feb-83 Alan Snyder
% Load browser.
% 31-Jan-83 Alan Snyder
% Add softkey stuff, keyboard mapping stuff, load window-label.
% Redefine PasFiler and PasEditor to refresh the screen upon exit, if NMODE
% was running.
% 25-Jan-83 Alan Snyder
% Added dummy version of current-date-time function; load M-XCMD and REC.
% 21-Jan-83 Alan Snyder
% Load more stuff. Change INIT to return NIL.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(compiletime (load fast-strings fast-int extended-char))
(bothtimes (load strings common))
(fluid '(alpha-terminal
color-terminal
nmode-file-list
nmode-source-prefix
*quiet_faslout
*usermode
*redefmsg
installkeys-address
uninstallkeys-address
nmode-softkey-label-screen-height
nmode-softkey-label-screen-width
doc-text-file
reference-text-file
))
(if (or (unboundp 'nmode-source-prefix) (null nmode-source-prefix))
(setf nmode-source-prefix "pn:"))
(if (funboundp 'pre-nmode-main)
(copyd 'pre-nmode-main 'main))
(if (funboundp 'pre-nmode-pasfiler)
(copyd 'pre-nmode-pasfiler 'pasfiler))
(if (funboundp 'pre-nmode-paseditor)
(copyd 'pre-nmode-paseditor 'paseditor))
(setf installkeys-address (system-address "NMODEKEYS_INSTALL_KEYMAP"))
(setf uninstallkeys-address (system-address "NMODEKEYS_UNINSTALL_KEYMAP"))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 9836 Customization:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(de nmode-9836-init ()
% This function modifies "standard" NMODE for use on the 9836.
(let ((*usermode nil) (*redefmsg nil))
(copyd 'nmode-initialize 'original-nmode-initialize)
(copyd 'actualize-file-name '9836-actualize-file-name)
)
(original-nmode-initialize)
(add-to-command-list 'basic-command-list (x-chars C-X C-Z) 'exit-nmode)
(nmode-establish-current-mode)
(setf alpha-terminal nmode-terminal)
(setf color-terminal (make-instance '9836-color))
nil % for looks
)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Useful Functions for Compiling:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(de load-nmode ()
% Load NMODE.
% Any system-dependent customization is done here so that it can
% be overrided by the user before nmode is initialized.
(nmode-load-required-modules)
(nmode-load-all)
(setf nmode-softkey-label-screen-height 2) % two rows
(setf nmode-softkey-label-screen-width 5) % of five keys each
(setf doc-text-file "psl:nmode.frames")
(setf reference-text-file "psl:nmode.xref")
(let ((*usermode nil) (*redefmsg nil))
(if (funboundp 'original-nmode-initialize)
(copyd 'original-nmode-initialize 'nmode-initialize))
(copyd 'nmode-initialize 'nmode-9836-init)
))
(de compile-lisp-file (source-name object-name)
(let ((*quiet_faslout T))
(if (not (filep source-name))
(printf "Unable to open source file: %w%n" source-name)
% else
(printf "%n----- Compiling %w to %w%n"
source-name (string-concat object-name ".b"))
(faslout object-name)
(unwind-protect
(dskin source-name)
(faslend)
)
(printf "%n----------------------------------------------------------%n")
)))
(de file-compile (s)
(let ((object-name s)
(source-name (string-concat s ".sl"))
)
(compile-lisp-file source-name object-name)
))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% System-Dependent Stuff:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(de current-date-time () "") % dummy version
(de 9836-actualize-file-name (fn) fn)
(de nmode-use-color ()
% Use the COLOR screen (only).
(setf nmode-terminal color-terminal)
(nmode-new-terminal)
)
(de nmode-use-alpha ()
% Use the ALPHA screen as the primary screen.
(setf nmode-terminal alpha-terminal)
(nmode-new-terminal)
)
(de install-nmode-keymap ()
(setf nmode-meta-bit-prefix-character (x-char ^!\))
(lpcall0 installkeys-address)
)
(de uninstall-nmode-keymap ()
(setf nmode-meta-bit-prefix-character (x-char ^![))
(lpcall0 uninstallkeys-address)
)
(de pasfiler ()
(pre-nmode-pasfiler)
(if *NMODE-RUNNING (nmode-full-refresh))
)
(de paseditor ()
(pre-nmode-paseditor)
(if *NMODE-RUNNING (nmode-full-refresh))
)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Stuff for Building NMODE:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
(de nmode-load-required-modules ()
(load addr2id)
(load objects)
(load common)
(load useful)
(load strings)
(load pathnames)
(load ring-buffer)
(load extended-char)
(load directory)
(load input-stream)
(load output-stream)
(load processor-time)
(load wait)
(load vector-fix)
(load nmode-parsing)
(load windows)
(lapin "PHP:DEFPCALL.SL")
(lapin "PHP:NMODE-AIDS.SL")
)
(de nmode-fixup-name (s)
(if (> (string-length s) 12)
(substring s 0 12)
s
))
(de nmode-load-all ()
(for (in s nmode-file-list)
(do (nmode-load s))
))
(de nmode-load (s)
(nmode-faslin nmode-source-prefix s)
)
(de nmode-faslin (directory-name module-name)
(setf module-name (nmode-fixup-name module-name))
(setf module-name (string-concat module-name ".b"))
(let ((object-name (string-concat directory-name module-name)))
(if (filep object-name)
(faslin object-name)
(continuableerror 99
(bldmsg "Unable to FASLIN %w" object-name)
(list 'faslin object-name)
))))
(setf nmode-file-list
(list
"browser"
"browser-support"
"buffer"
"buffer-io"
"buffer-position"
"buffer-window"
"buffers"
"case-commands"
"command-input"
"commands"
"defun-commands"
"dispatch"
"extended-input"
"fileio"
"incr"
"indent-commands"
"kill-commands"
"lisp-commands"
"lisp-indenting"
"lisp-interface"
"lisp-parser"
"m-x"
"m-xcmd"
"modes"
"mode-defs"
"move-commands"
"nmode-break"
"nmode-init"
"prompting"
"query-replace"
"reader"
"rec"
"screen-layout"
"search"
"set-terminal"
"softkeys"
"structure-functions"
"terminal-input"
"text-buffer"
"text-commands"
"window"
"window-label"
% These must be last:
"autofill"
"buffer-browser"
"dired"
"doc"
))