LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032453. :SYSTEM-TYPE :LOGICAL :VERSION 3. :TYPE "LISP" :NAME "HOST" :DIRECTORY ("REL3-SOURCE" "ZMACS") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758739007. :AUTHOR "REL3" :LENGTH-IN-BYTES 7138. :LENGTH-IN-BLOCKS 7. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    ;;; ZWEI host -*- Mode:Common-Lisp; Package:ZWEI; Base:10; -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151;;;;;; Copyright (C) 1985, 1987 Texas Instruments Incorporated. All rights reserved.;;; Copyright (C) 1980, Massachusetts Institute of Technology;;; Copyright (c) 1982 Devon S. McCullough, all rights reserved.;;; I may give you permission to use this -- ask if you;;; are interested -- but I will insist that you agree to;;; return all improvements to me for redistribution.; Make ZWEI a host so Lisp Machine programs can treat buffers like files.; hosts:  ED:  accepts any name the completing reader would;         ED-FILE:  accepts a pathname and does a find file (like Control-X Control-F);         ED-BUFFER:  must have the exact buffer name or will create new buffer; known bugs:  ED-FILE won't allow :NEW-FILE nil (I'll fix later); --- ZWEI-HOST ---(DEFMACRO ZWEI-HOST-DEF (FLAVOR NAME)  `(PROGN 'COMPILE  (DEFFLAVOR ,FLAVOR () (SI:BASIC-HOST)); hmmmm, tasty...    (DEFMETHOD (,FLAVOR :NAME) (); what's your use name?    ,NAME)    (DEFMETHOD (,FLAVOR :SYSTEM-TYPE) ()    ':ZWEI)  (DEFMETHOD (,FLAVOR :host-version) ()    host:*current-host-version*)  (DEFMETHOD (,FLAVOR :cache-timestamp) ()    0)  (DEFMETHOD (,FLAVOR :local-host-p) ()    nil)  (DEFMETHOD (,FLAVOR :initialize) (&rest ignore)    nil)    (DEFMETHOD (,FLAVOR :NAME-AS-FILE-COMPUTER) (); what can I call you?    ,NAME)    (DEFMETHOD (,FLAVOR :PATHNAME-FLAVOR) ()        ; how can I reach you?    ',(INTERN (STRING-APPEND NAME "-PATHNAME")))    (DEFMETHOD (,FLAVOR :PATHNAME-HOST-NAMEP) (NAME); zwei, is that you?    (OR (TYPEP NAME ',FLAVOR)(STRING-EQUAL NAME ,NAME)))))   (ZWEI-HOST-DEF ZWEI-HOST "ED") (ZWEI-HOST-DEF ZWEI-FILE-HOST "ED-FILE") (ZWEI-HOST-DEF ZWEI-BUFFER-HOST "ED-BUFFER")   ; -- ZWEI-PATHNAME --(DEFFLAVOR ED-BASIC-PATHNAME () (PATHNAME)) (DEFFLAVOR ED-PATHNAME () (ED-BASIC-PATHNAME)) (DEFFLAVOR ED-FILE-PATHNAME () (ED-BASIC-PATHNAME)) (DEFFLAVOR ED-BUFFER-PATHNAME () (ED-BASIC-PATHNAME)) (DEFMETHOD (ED-BASIC-PATHNAME :STRING-FOR-PRINTING) (); print our name  (STRING-APPEND (SEND (SEND SELF :HOST) :NAME) ": " (SEND SELF :NAME)))(DEFMETHOD (ED-BASIC-PATHNAME :SHORT-STRING-FOR-PRINTING) ()  (SEND SELF :STRING-FOR-PRINTING))(DEFMETHOD (ED-BASIC-PATHNAME :STRING-FOR-EDITOR) ()  (STRING-APPEND (SEND SELF :NAME) " " (SEND (SEND SELF :HOST) :NAME) ":")) ; PARSE-NAMESTRING accepts HOST-SPECIFIED (t or nil) which I ignore;                          NAMESTRING (to be parsed);                          optional START and END indices into NAMESTRING; returns multiple values DEVICE DIRECTORY NAME TYPE VERSION(DEFMETHOD (ED-BASIC-PATHNAME :PARSE-NAMESTRING) (IGNORED  NAMESTRING  &OPTIONAL (START 0) END)  (VALUES :UNSPECIFIC :UNSPECIFIC  (STRING-UPCASE (SUBSEQ NAMESTRING START END))  :UNSPECIFIC  :UNSPECIFIC)) (DEFMETHOD (ED-BASIC-PATHNAME :HOMEDIR) (USER)  USER  (MAKE-PATHNAME :HOST FS::HOST :DIRECTORY :UNSPECIFIC :DEVICE :UNSPECIFIC)) ; OPEN returns what?  it's called from SI:INSTANCE-HASH-FAILURE from OPEN;      (LEXPR-FUNCALL FILENAME ':OPEN FILENAME KEYWORD-ARGS); So I need to understand KEYWORD-ARGS in order to implement this right.;;; Possible keywords and values include the following:; :DIRECTION is ignored if specified, ZWEI is always open for IO.; :CHARACTERS (T and :DEFAULT for character mode, NIL for 16-bit :WRITE-CHAR mode); :BYTE-SIZE is ignored if specified, since :CHARACTERS does the job; :ERROR if nil, return error string instead of bombing; :NEW-FILE mustn't be T for ZWEI:;           shouldn't (or should it?) be NIL for ZWEI-FILE:;           if T, allows creation of new buffer for ZWEI-BUFFER:; :OLD-FILE (T and :REWRITE = normal, :APPEND start at end); other keywords are totally ignored.(DEFMETHOD (ED-PATHNAME :OPEN) ED-PATHNAME-OPEN) (DEFMETHOD (ED-FILE-PATHNAME :OPEN) ED-PATHNAME-OPEN) (DEFMETHOD (ED-BUFFER-PATHNAME :OPEN) ED-PATHNAME-OPEN) (DEFMACRO OPEN-ERROR (MESSAGE &REST REST); expects value of :ERROR keyword in ERROR  (CHECK-TYPE MESSAGE :STRING)  `(IF ERROR       (FERROR () ,MESSAGE ,@REST)       ,(IF REST    `(GLOBAL:FORMAT () ,MESSAGE ,@REST)    MESSAGE))) (DEFUN ED-PATHNAME-OPEN (IGNORED PATHNAME &KEY &OPTIONAL (CHARACTERS T) (DIRECTION :INPUT) (ERROR T) (IF-EXISTS :APPEND) (IF-DOES-NOT-EXIST (IF (EQ DIRECTION :OUTPUT):CREATE:ERROR)) &ALLOW-OTHER-KEYS)  "parse OPEN keywords and then call the :REALLY-OPEN method"  (LET ((STREAM (SEND SELF :REALLY-OPEN PATHNAME CHARACTERS ERROR      (EQ IF-DOES-NOT-EXIST :CREATE))))    (IF (AND (EQ DIRECTION :OUTPUT)     (EQ IF-EXISTS :APPEND))(SEND STREAM :READ-UNTIL-EOF))    STREAM)) (DEFMETHOD (ED-PATHNAME :REALLY-OPEN) (PATHNAME CHARACTERS ERROR NEW-FILE)  PATHNAME  "Use completing reader to find buffer name.  Never make a new file."  (AND NEW-FILE       (NEQ NEW-FILE :DEFAULT)       (OPEN-ERROR "can't handle :NEW-FILE keyword, use ED-BUFFER: instead"))  (MULTIPLE-VALUE-BIND (IGNORE ALIST)      (COMPLETE-STRING (SEND SELF :NAME)       *ZMACS-BUFFER-NAME-ALIST*       '(#\SPACE #\- #\. #\\ #\/ #\#))    (IF ALIST(IF (= (LENGTH ALIST) 1)    (INTERVAL-STREAM (CDAR ALIST)     NIL NIL     (IF CHARACTERS NIL :WRITE-CHAR)     T)    (OPEN-ERROR "ambiguous name"))(OPEN-ERROR "not found")))) (DEFMETHOD (ED-FILE-PATHNAME :REALLY-OPEN) (PATHNAME CHARACTERS ERROR NEW-FILE)  PATHNAME ERROR NEW-FILE  (LET ((NAME (FS:PARSE-PATHNAME (SEND SELF :NAME)))(*INTERVAL* NIL))    (INTERVAL-STREAM (OR (FIND-BUFFER-NAMED PATHNAME); don't bash existing buffer! (FIND-FILE NAME NIL T))     NIL NIL     (IF CHARACTERS () :WRITE-CHAR)     T))) (DEFMETHOD (ED-BUFFER-PATHNAME :REALLY-OPEN) (PATHNAME CHARACTERS ERROR NEW-FILE)  PATHNAME  (LET ((BUFFER (FIND-BUFFER-NAMED (SEND SELF :NAME) (NOT (NULL NEW-FILE)))))    (IF BUFFER(INTERVAL-STREAM BUFFER NIL NIL (IF CHARACTERS     ()     :WRITE-CHAR) T)(OPEN-ERROR "ED-BUFFER: not found")))) (DEFVAR ZWEI-HOST (MAKE-INSTANCE 'ZWEI-HOST)) (DEFVAR ZWEI-BUFFER-HOST (MAKE-INSTANCE 'ZWEI-BUFFER-HOST)) (DEFVAR ZWEI-FILE-HOST (MAKE-INSTANCE 'ZWEI-FILE-HOST)) (DEFUN ADD-ZWEI-HOSTS ()  (host:add-foreign-host-to-namespace  zwei-host)  (host:add-foreign-host-to-namespace  zwei-buffer-host)  (host:add-foreign-host-to-namespace  zwei-file-host)) (COMPILE-FLAVOR-METHODS ZWEI-HOST ZWEI-BUFFER-HOST ZWEI-FILE-HOSTED-PATHNAME ED-BUFFER-PATHNAME ED-FILE-PATHNAME) (ADD-INITIALIZATION "Add ZWEI Hosts" '(ADD-ZWEI-HOSTS) NIL 'NET:*NETWORK-WARM-INITIALIZATION-LIST*) STORY-ELEMENT "Reuse"  TYP