(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "XCL" BASE 10) (filecreated "10-Mar-89 15:14:52" |{EG:PARC:XEROX}LISP>USERS>VANILLA-INIT.;16| 88924 |changes| |to:| (vars db-init-commands compute-directories-init-commands change-background-init-commands idle-init-commands programming-init-commands pcl-init-commands loops-init-commands mail-init-commands talk-init-commands demos-init-commands games-init-commands) |previous| |date:| " 2-Mar-89 15:30:16" |{EG:PARC:XEROX}LISP>USERS>VANILLA-INIT.;15| ) ; Copyright (c) 1988, 1989 by Xerox Corporation. All rights reserved. (prettycomprint vanilla-initcoms) (rpaqq vanilla-initcoms ((* |;;| "Macro to avoid problems when trying to maintain file.") (coms (p (cl:proclaim (quote (global *vanilla-init-loaded*)))) (initvars (*vanilla-init-loaded* nil)) (functions eval-at-greet)) (* |;;| "Silent loads") (coms (p (cl:proclaim (quote (global *load-silent* prettyheader)))) (initvars (*load-silent* nil)) (vars (\\original-load-verbose *load-verbose*) (\\original-prettyheader prettyheader) (*load-verbose* (if *load-silent* then nil else *load-verbose*)) (prettyheader (if *load-silent* then nil else prettyheader)))) (* |;;| "Environment setup") (coms * compute-directories-init-commands) (coms * env-tailoring-init-commands) (coms * patch-init-commands) (coms * font-setup-init-commands) (declare\: eval@loadwhen (not *vanilla-init-loaded*) donteval@compile docopy (files (sysload from lispusers) loadmenuitems)) (* |;;| "Machine status") (coms * who-line-commands) (coms * vstats-init-commands) (* |;;| "Display control") (coms * screen-setup-init-commands) (coms * rooms-init-commands) (coms * change-background-init-commands) (coms * display-control-init-commands) (coms * idle-init-commands) (coms * clock-init-commands) (* |;;| "Programming stuff") (coms * programming-init-commands) (coms * old-utils-commands) (coms * wizard-init-commands) (coms * dinfo-init-commands) (coms * pcl-init-commands) (coms * loops-init-commands) (* |;;| "Documentation") (coms * tedit-init-commands) (coms * sketch-init-commands) (coms * notecards-init-commands) (* |;;| "Communication & Info") (coms * mail-init-commands) (coms * chat-init-commands) (coms * talk-init-commands) (coms * calendar-init-commands) (coms * printer-init-commands) (coms * db-init-commands) (coms * nfs-init-commands) (* |;;| "Files") (coms * file-watch-init-commands) (coms * file-server-init-commands) (coms * dirgrapher-init-commands) (coms * fb-init-commands) (coms * compare-files-init-commands) (* |;;| "Random stuff") (coms * unix-init-commands) (coms * demos-init-commands) (coms * games-init-commands) (* |;;| "Cleanup") (coms * background-menu-cleanup-init-commands) (coms * do-load-utilities-init-commands) (coms (* |;;| "Send the Tool Work's a message telling it about this user.") (functions log-vanilla-init-user) (initvars (\\cc-generic-init-msg t)) (p (eval-at-greet (cl:unless *vanilla-init-loaded* (log-vanilla-init-user))))) (vars (*load-verbose* \\original-load-verbose) (prettyheader \\original-prettyheader) (*vanilla-init-loaded* t)) (* |;;| "Make the FileManager happy") (declare\: dontcopy (prop makefile-environment vanilla-init)))) (* |;;| "Macro to avoid problems when trying to maintain file.") (cl:proclaim (quote (global *vanilla-init-loaded*))) (rpaq? *vanilla-init-loaded* nil) (defmacro eval-at-greet (&body forms) "Evaluate the forms only when loading the compiled file, and then only when greeting" (bquote (cl:eval-when (cl:load) (cl:unless (or *vanilla-init-loaded* (memb dfnflg (quote (prop allprop)))) (\\\,@ forms))))) (* |;;| "Silent loads") (cl:proclaim (quote (global *load-silent* prettyheader))) (rpaq? *load-silent* nil) (rpaq \\original-load-verbose *load-verbose*) (rpaq \\original-prettyheader prettyheader) (rpaq *load-verbose* (if *load-silent* then nil else *load-verbose*)) (rpaq prettyheader (if *load-silent* then nil else prettyheader)) (* |;;| "Environment setup") (rpaqq compute-directories-init-commands ((declare\: donteval@compile (vars (|\\BasicUserName| (let* ((name (username)) (registry-pos (strpos "." name nil nil nil nil nil t))) (cond (registry-pos (substring name 1 (sub1 registry-pos))) (t name)))) (loginhost/dir (cond ((or (null loginhost/dir) (eq loginhost/dir (quote {dsk}))) (let ((greetfile (greetfilename |\\BasicUserName|))) (if greetfile then (packfilename.string (quote host) (filenamefield greetfile (quote host)) (quote directory) (filenamefield greetfile (quote directory))) else loginhost/dir))) (t loginhost/dir))))) (initvars (|\\UserHomeDirectory| (u-case (let ((host (filenamefield loginhost/dir (quote host))) (dirs (cl:do* ((directory (filenamefield loginhost/dir (quote directory)) (substring directory (cl:1+ sepr-pos))) (sepr-table (makebittable (list "/" ">"))) (sepr-pos (strposl sepr-table directory) (strposl sepr-table directory)) (dirs (list))) ((null sepr-pos) (cl:reverse (cl:if (null directory) dirs (cons directory dirs)))) (cl:push (substring directory 1 (cl:1- sepr-pos)) dirs)))) (|if| (not (strpos "/n" host nil nil t nil uppercasearray t)) |then| (* |;;| "On everything but an NFS server, standard setup is {host}") (packfilename.string (quote host) host (quote directory) (cl:first dirs)) |elseif| (strpos "~" (cl:first dirs) 1 nil t) |then| (* |;;| "On an NFS server, with directory of the form <~Username>") (packfilename.string (quote host) host (quote directory) (cl:first dirs)) |else| (* |;;| "On an NFS server, the standard setup is {host/n}user>") (packfilename.string (quote host) host (quote directory) (concat (cl:first dirs) ">" (cl:second dirs))))))) (tempdir (concat |\\UserHomeDirectory| "TEMP>")) (home-machine-name "") (private-lispusersdirectories nil) (*cache-directories* nil)))) (declare\: donteval@compile (rpaq |\\BasicUserName| (let* ((name (username)) (registry-pos (strpos "." name nil nil nil nil nil t))) (cond (registry-pos (substring name 1 (sub1 registry-pos))) (t name)))) (rpaq loginhost/dir (cond ((or (null loginhost/dir) (eq loginhost/dir (quote {dsk}))) (let ((greetfile (greetfilename |\\BasicUserName|))) (if greetfile then (packfilename.string (quote host) (filenamefield greetfile (quote host)) (quote directory) (filenamefield greetfile (quote directory))) else loginhost/dir))) (t loginhost/dir))) ) (rpaq? |\\UserHomeDirectory| (u-case (let ((host (filenamefield loginhost/dir (quote host))) (dirs (cl:do* ((directory (filenamefield loginhost/dir (quote directory)) (substring directory (cl:1+ sepr-pos))) (sepr-table (makebittable (list "/" ">"))) (sepr-pos (strposl sepr-table directory) (strposl sepr-table directory)) (dirs (list))) ((null sepr-pos) (cl:reverse (cl:if (null directory) dirs (cons directory dirs)))) (cl:push (substring directory 1 (cl:1- sepr-pos)) dirs)))) (|if| (not (strpos "/n" host nil nil t nil uppercasearray t)) |then| (* |;;| "On everything but an NFS server, standard setup is {host}") (packfilename.string (quote host) host (quote directory) (cl:first dirs)) |elseif| (strpos "~" (cl:first dirs) 1 nil t) |then| (* |;;| "On an NFS server, with directory of the form <~Username>") (packfilename.string (quote host) host (quote directory) (cl:first dirs)) |else| (* |;;| "On an NFS server, the standard setup is {host/n}user>") (packfilename.string (quote host) host (quote directory) (concat (cl:first dirs) ">" (cl:second dirs))))))) (rpaq? tempdir (concat |\\UserHomeDirectory| "TEMP>")) (rpaq? home-machine-name "") (rpaq? private-lispusersdirectories nil) (rpaq? *cache-directories* nil) (rpaqq env-tailoring-init-commands ((declare\: donteval@load donteval@compile (files (sysload noerror from lispusers) pagehold) (vars (|MaxValueLeftMargin| 512) (scrollbarwidth 20) (fixspelldefault (quote \n)) (\\ethertimeout 3000) (empress#sides 2) (*print-case* :downcase)) (vars (cleanupoptions (quote (rc st))) (copyrightflg (quote default)) (recompiledefault (quote exprs)) (*default-cleanup-compiler* (quote cl:compile-file)) (*default-makefile-environment* (quote (:package "XCL-USER" :readtable "XCL" :base 10)))) (vars (*original-give-and-take-directories* *give-and-take-directories*) (*give-and-take-directories* (if (boundp (quote *give-and-take-directories*)) then (cl:remove-if (cl:function (cl:lambda (file) (cl:member (cl:pathname-host file) (quote ("ERIS" "ERINYES")) :test (cl:function string-equal)))) *give-and-take-directories*) else nil))) (advise files?) (p (eval-at-greet (cl:when (and (eq (machinetype) (quote dorado)) (cl:fboundp (quote describe-virtual-memory))) (describe-virtual-memory)))) (addvars (afterlogoutforms (|for| greet-date |in| greetdates |bind| (today _ (date)) |when| (eql 1 (strpos (car greet-date) today nil nil nil nil (uppercasearray))) |do| (|printout| t t (cdr greet-date) t))))))) (declare\: donteval@load donteval@compile (filesload (sysload noerror from lispusers) pagehold) (rpaqq |MaxValueLeftMargin| 512) (rpaqq scrollbarwidth 20) (rpaqq fixspelldefault \n) (rpaqq \\ethertimeout 3000) (rpaqq empress#sides 2) (rpaq *print-case* :downcase) (rpaqq cleanupoptions (rc st)) (rpaqq copyrightflg default) (rpaqq recompiledefault exprs) (rpaqq *default-cleanup-compiler* cl:compile-file) (rpaqq *default-makefile-environment* (:package "XCL-USER" :readtable "XCL" :base 10)) (rpaq *original-give-and-take-directories* *give-and-take-directories*) (rpaq *give-and-take-directories* (if (boundp (quote *give-and-take-directories*)) then (cl:remove-if (cl:function (cl:lambda (file) (cl:member (cl:pathname-host file) (quote ("ERIS" "ERINYES")) :test (cl:function string-equal)))) *give-and-take-directories*) else nil)) (xcl:reinstall-advice (quote files?) :before (quote ((:last (setq notlistedfiles nil))))) (readvise files?) (eval-at-greet (cl:when (and (eq (machinetype) (quote dorado)) (cl:fboundp (quote describe-virtual-memory))) (describe-virtual-memory))) (addtovar afterlogoutforms (|for| greet-date |in| greetdates |bind| (today _ (date)) |when| (eql 1 (strpos (car greet-date) today nil nil nil nil (uppercasearray))) |do| (|printout| t t (cdr greet-date) t))) ) (rpaqq patch-init-commands nil) (rpaqq font-setup-init-commands ((alists (fontdefs generic-init)) (initvars (\\font-profile-name (quote generic-init))) (declare\: donteval@load donteval@compile (p (eval-at-greet (fontset \\font-profile-name t) (cl:when (boundp (quote promptfont)) (undosave (bquote (dspfont (\\\, (dspfont promptfont promptwindow)) (\\\, promptwindow))))))) (advise getpromptwindow)))) (addtovar fontdefs (generic-init (fontchangeflg . all) (filelinelength . 102) (commentlinelength 80 . 102) (lambdafontlinelength . 95) (firstcol . 60) (prettylcom . 25) (listfilestr . " ") (|ObjectDontPPFlag| . t) (sysprettyflg . t) (**comment**flg) (fontprofile (defaultfont 1 (gacha 10) (gacha 8) (terminal 8)) (boldfont 2 (helvetica 10 brr) (helvetica 8 brr) (modern 8 brr)) (littlefont 3 (helvetica 8) (helvetica 6 mir) (modern 6 mir)) (bigfont 4 (helvetica 12 brr) (helvetica 10 brr) (modern 10 brr)) (userfont boldfont) (commentfont littlefont) (lambdafont bigfont) (systemfont) (clispfont boldfont) (changefont) (prettycomfont boldfont) (tinyfont littlefont) (font1 defaultfont) (font2 boldfont) (font3 littlefont) (font4 bigfont) (font5 5 (helvetica 10 bir) (helvetica 8 bir) (modern 8 bir)) (font6 6 (helvetica 10 brr) (helvetica 8 brr) (modern 8 brr)) (font7 7 (gacha 12) (gacha 12) (terminal 12)) (font8 8 (modern 10 mir) (modern 10 mir) (modern 10 mir)) (font9 9 (modern 10 bir) (modern 10 bir) (modern 10 bir)) (font10 10 (modern 12 mir) (modern 12 mir) (modern 12 mir)) (font11 11 (timesroman 10) (timesroman 10) (classic 10)) (|\\WindowTitleFont| bigfont) (lafitetitlefont |\\WindowTitleFont|) (chat.font font7)))) (rpaq? \\font-profile-name (quote generic-init)) (declare\: donteval@load donteval@compile (eval-at-greet (fontset \\font-profile-name t) (cl:when (boundp (quote promptfont)) (undosave (bquote (dspfont (\\\, (dspfont promptfont promptwindow)) (\\\, promptwindow)))))) (xcl:reinstall-advice (quote getpromptwindow) :before (quote ((:last (cond ((and (null font) (boundp (quote promptfont))) (setq font promptfont))))))) (readvise getpromptwindow) ) (declare\: eval@loadwhen (not *vanilla-init-loaded*) donteval@compile docopy (filesload (sysload from lispusers) loadmenuitems) ) (* |;;| "Machine status") (rpaqq who-line-commands ((declare\: donteval@load donteval@compile (files (sysload from lispusers) who-line) (vars (*who-line-anchor* (quote (:justify :top))) (*who-line-display-names?* t) (*who-line-directories* (list |\\UserHomeDirectory|)) (*who-line-entries* (list *who-line-vmem-entry* *who-line-symbol-space-entry* *who-line-package-entry* *who-line-readtable-entry* *who-line-tty-proc-entry* *who-line-tty-state-entry* *who-line-directory-entry* *who-line-time-entry*))) (p (eval-at-greet (install-who-line-options) (cl:when (and (boundp (quote *who-line*)) (windowp *who-line*)) (undosave (bquote (closew (\\\, *who-line*)))))))))) (declare\: donteval@load donteval@compile (filesload (sysload from lispusers) who-line) (rpaqq *who-line-anchor* (:justify :top)) (rpaqq *who-line-display-names?* t) (rpaq *who-line-directories* (list |\\UserHomeDirectory|)) (rpaq *who-line-entries* (list *who-line-vmem-entry* *who-line-symbol-space-entry* *who-line-package-entry* *who-line-readtable-entry* *who-line-tty-proc-entry* *who-line-tty-state-entry* *who-line-directory-entry* *who-line-time-entry*)) (eval-at-greet (install-who-line-options) (cl:when (and (boundp (quote *who-line*)) (windowp *who-line*)) (undosave (bquote (closew (\\\, *who-line*)))))) ) (rpaqq vstats-init-commands ((initvars (vstats.clock.interval 0) (vstats.mutil.interval nil) (vstats.position (createposition (difference screenwidth 147) 0))) (declare\: donteval@load donteval@compile (loadmenuitems "System-Aids" (((sysload from lispusers) "VStats") (let ((vstats-item (|for| item |in| |BackgroundMenuCommands| |thereis| (string-equal "VStats" (car item))))) (cl:when vstats-item (/dremove vstats-item |BackgroundMenuCommands|)))) (((sysload from lispusers) |Storage|) (showstorage (quote item))))))) (rpaq? vstats.clock.interval 0) (rpaq? vstats.mutil.interval nil) (rpaq? vstats.position (createposition (difference screenwidth 147) 0)) (declare\: donteval@load donteval@compile (|AddLoadMenuItem| (quote "System-Aids") (quote ((sysload from lispusers) "VStats")) (quote (let ((vstats-item (|for| item |in| |BackgroundMenuCommands| |thereis| (string-equal "VStats" (car item))))) (cl:when vstats-item (/dremove vstats-item |BackgroundMenuCommands|))))) (|AddLoadMenuItem| (quote "System-Aids") (quote ((sysload from lispusers) |Storage|)) (quote (showstorage (quote item)))) ) (* |;;| "Display control") (rpaqq screen-setup-init-commands ((declare\: donteval@load donteval@compile (vars (windowtitleshade grayshade)) (files (sysload noerror from "{FS8:PARC:XEROX}Lisp>Users>") "BITMAP-GALLERY" "GRANITE") (initvars (\\rearrange-screen (not (cl:member "ROOMS" *modules* :test (cl:function string-equal))))) (p (eval-at-greet (cl:when \\rearrange-screen (cl:when (cl:fboundp (quote |GraniteBG|)) (|GraniteBG|)) (undosave (bquote (dsptexture (\\\, (dsptexture 42405 promptwindow)) (\\\, promptwindow)))) (undosave (bquote (dspoperation (\\\, (dspoperation (quote replace) promptwindow)) (\\\, promptwindow)))) (undosave (bquote (windowprop (\\\, promptwindow) border (\\\, (windowprop promptwindow (quote border)))))) (windowprop promptwindow (quote border) 1) (undosave (bquote (windowprop (\\\, promptwindow) title (\\\, (windowprop promptwindow (quote title)))))) (windowprop promptwindow (quote title) nil) (clearw promptwindow) (cl:when (openwp logow) (undosave (bquote (openw (\\\, logow)))) (closew logow)) (let* ((window-gap 2) (window-width (difference (quotient screenwidth 2) (plus window-gap window-gap)))) (undosave (bquote (shapew (\\\, promptwindow) (\\\, (windowprop promptwindow (quote region)))))) (shapew promptwindow (let ((height (heightifwindow (times 4 (fontprop (dspfont nil promptwindow) (quote height))) (windowprop promptwindow (quote title)) (windowprop promptwindow (quote border))))) (createregion window-gap (difference (|if| (and (boundp (quote *who-line*)) (windowp *who-line*)) |then| (difference screenheight (|fetch| (region height) |of| (windowprop *who-line* (quote region)))) |else| screenheight) (plus window-gap height)) window-width height))) (undosave (bquote (shapew (\\\, |\\TopLevelTtyWindow|) (\\\, (windowprop |\\TopLevelTtyWindow| (quote region)))))) (shapew |\\TopLevelTtyWindow| (let ((height (heightifwindow (times 17 (fontprop (dspfont nil |\\TopLevelTtyWindow|) (quote height))) (windowprop |\\TopLevelTtyWindow| (quote title)) (windowprop |\\TopLevelTtyWindow| (quote border))))) (createregion window-gap (difference (|fetch| (region bottom) |of| (windowprop promptwindow (quote region))) (plus window-gap height)) window-width height))))))) (initvars (\\load-grid-icons t) (enforce.icon.grid t)) (p (eval-at-greet (cl:when \\load-grid-icons (filesload (noerror from valueof (append private-lispusersdirectories lispusersdirectories)) grid-icons)) (cl:when (and \\rearrange-screen (boundp (quote loaded-files-icon-window)) (windowp loaded-files-icon-window)) (movew loaded-files-icon-window 5 100))))))) (declare\: donteval@load donteval@compile (rpaq windowtitleshade grayshade) (filesload (sysload noerror from "{FS8:PARC:XEROX}Lisp>Users>") "BITMAP-GALLERY" "GRANITE") (rpaq? \\rearrange-screen (not (cl:member "ROOMS" *modules* :test (cl:function string-equal)))) (eval-at-greet (cl:when \\rearrange-screen (cl:when (cl:fboundp (quote |GraniteBG|)) (|GraniteBG|)) (undosave (bquote (dsptexture (\\\, (dsptexture 42405 promptwindow)) (\\\, promptwindow)))) (undosave (bquote (dspoperation (\\\, (dspoperation (quote replace) promptwindow)) (\\\, promptwindow)))) (undosave (bquote (windowprop (\\\, promptwindow) border (\\\, (windowprop promptwindow (quote border)))))) (windowprop promptwindow (quote border) 1) (undosave (bquote (windowprop (\\\, promptwindow) title (\\\, (windowprop promptwindow (quote title)))))) (windowprop promptwindow (quote title) nil) (clearw promptwindow) (cl:when (openwp logow) (undosave (bquote (openw (\\\, logow)))) (closew logow)) (let* ((window-gap 2) (window-width (difference (quotient screenwidth 2) (plus window-gap window-gap)))) (undosave (bquote (shapew (\\\, promptwindow) (\\\, (windowprop promptwindow (quote region)))))) (shapew promptwindow (let ((height (heightifwindow (times 4 (fontprop (dspfont nil promptwindow) (quote height))) (windowprop promptwindow (quote title)) (windowprop promptwindow (quote border))))) (createregion window-gap (difference (|if| (and (boundp (quote *who-line*)) (windowp *who-line*)) |then| (difference screenheight (|fetch| (region height) |of| (windowprop *who-line* (quote region)))) |else| screenheight) (plus window-gap height)) window-width height))) (undosave (bquote (shapew (\\\, |\\TopLevelTtyWindow|) (\\\, (windowprop |\\TopLevelTtyWindow| (quote region)))))) (shapew |\\TopLevelTtyWindow| (let ((height (heightifwindow (times 17 (fontprop (dspfont nil |\\TopLevelTtyWindow|) (quote height))) (windowprop |\\TopLevelTtyWindow| (quote title)) (windowprop |\\TopLevelTtyWindow| (quote border))))) (createregion window-gap (difference (|fetch| (region bottom) |of| (windowprop promptwindow (quote region))) (plus window-gap height)) window-width height)))))) (rpaq? \\load-grid-icons t) (rpaq? enforce.icon.grid t) (eval-at-greet (cl:when \\load-grid-icons (filesload (noerror from valueof (append private-lispusersdirectories lispusersdirectories)) grid-icons)) (cl:when (and \\rearrange-screen (boundp (quote loaded-files-icon-window)) (windowp loaded-files-icon-window)) (movew loaded-files-icon-window 5 100))) ) (rpaqq rooms-init-commands ((declare\: donteval@load donteval@compile (initvars (user-suite-directories (list (concat |\\UserHomeDirectory| "ROOMS>"))) (roomsdirectories (bquote ((\\\,@ *cache-directories*) "{NB:PARC:XEROX}Medley>Sources>" "{Pogo:AISNorth:XEROX}Medley>Sources>"))) (roomsusersdirectories (bquote ((\\\,@ *cache-directories*) "{NB:PARC:XEROX}Medley>Users>" "{NB:PARC:XEROX}Lyric>Users>" "{Pogo:AISNorth:XEROX}Medley>Users>" "{Pogo:AISNorth:XEROX}Lyric>Users>")))) (loadmenuitems "Screen-Maintanance" (((sysload from rooms) "ROOMS") (cl:eval (quote (progn (set (cl:intern "*SUITE-DIRECTORIES*" "ROOMS") (append user-suite-directories (cl:eval (cl:intern "*SUITE-DIRECTORIES*" "ROOMS")))) (|AddLoadMenuItem| "Rooms" (bquote ((sysload from "{NB:PARC:Xerox}CURRENT>") "CLens-Rooms"))) (cl:dolist (utility (quote ("Rooms-Intro" "Rooms-Notes"))) (|AddLoadMenuItem| "Rooms" (bquote ((sysload from rooms) (\\\, utility))))) (cl:dolist (utility (bquote ("Background-Menu-Buttons" "Office.suite" "Touchy-Buttons" "Random-Window-Types" "Snuggle" "Notecards-Window-Types" (\\\,@ (if (not (cl:fboundp (quote lafite))) then nil elseif (not (cl:fboundp (quote \\lafite.getmailfolder))) then (quote ("New-Lafite-Window-Types")) else (quote ("Lafite-Window-Types")))) "Un-Hide-Tty" "Rooms-Videohax" "WallPaper"))) (|AddLoadMenuItem| "Rooms" (bquote ((sysload from roomsusers) (\\\, utility))))))))))))) (declare\: donteval@load donteval@compile (rpaq? user-suite-directories (list (concat |\\UserHomeDirectory| "ROOMS>"))) (rpaq? roomsdirectories (bquote ((\\\,@ *cache-directories*) "{NB:PARC:XEROX}Medley>Sources>" "{Pogo:AISNorth:XEROX}Medley>Sources>"))) (rpaq? roomsusersdirectories (bquote ((\\\,@ *cache-directories*) "{NB:PARC:XEROX}Medley>Users>" "{NB:PARC:XEROX}Lyric>Users>" "{Pogo:AISNorth:XEROX}Medley>Users>" "{Pogo:AISNorth:XEROX}Lyric>Users>"))) (|AddLoadMenuItem| (quote "Screen-Maintanance") (quote ((sysload from rooms) "ROOMS")) (quote (cl:eval (quote (progn (set (cl:intern "*SUITE-DIRECTORIES*" "ROOMS") (append user-suite-directories (cl:eval (cl:intern "*SUITE-DIRECTORIES*" "ROOMS")))) (|AddLoadMenuItem| "Rooms" (bquote ((sysload from "{NB:PARC:Xerox}CURRENT>") "CLens-Rooms"))) (cl:dolist (utility (quote ("Rooms-Intro" "Rooms-Notes"))) (|AddLoadMenuItem| "Rooms" (bquote ((sysload from rooms) (\\\, utility))))) (cl:dolist (utility (bquote ("Background-Menu-Buttons" "Office.suite" "Touchy-Buttons" "Random-Window-Types" "Snuggle" "Notecards-Window-Types" (\\\,@ (if (not (cl:fboundp (quote lafite))) then nil elseif (not (cl:fboundp (quote \\lafite.getmailfolder))) then (quote ("New-Lafite-Window-Types")) else (quote ("Lafite-Window-Types")))) "Un-Hide-Tty" "Rooms-Videohax" "WallPaper"))) (|AddLoadMenuItem| "Rooms" (bquote ((sysload from roomsusers) (\\\, utility)))))))))) ) (rpaqq change-background-init-commands ((declare\: donteval@load donteval@compile (loadmenuitems nil (((sysload from lispusers) "BackgroundImages" "StarBG" (nil from "{piglet/n}colab>faces>") "Dead") (|push| |BackgroundMenuCommands| (let ((bitmaps (quote (("Standard texture" . windowbackgroundshade) ("Gray shade" . grayshade) ("Light wall paper" . lightwallpaper) ("Medium wall paper" . wallpaper) ("Dark wall paper" . darkwallpaper) ("Waves" . wave-texture) ("Tweed" . xcl-user::*tweed-bm*) ("Chambray" . xcl-user::*chambray-bm*) ("Canvas" . xcl-user::*canvas-bm*) ("Corduroy" . xcl-user::*corduroy-bm*) ("Seersucker" . xcl-user::*seersucker-bm*) ("Burlap" . xcl-user::*burlap-bm*) ("Mesh" . mesh-texture)))) (images (background.files)) (menu-items (quote (("Stars" (quote (starbg)) "Fill the background with stars" (subitems ("ET go home" (quote (|SaucerOff|)) "Get rid of the saucer"))) ("Granite" (quote (|GraniteBG|)) "Fill the background with a pleasing, almost random shade") ("Dead" (changebackground (expandbitmap dead-bm 2 2)) "Put a Deadhead on the background"))))) (bquote ("Change background" (quote (changebackground)) "Change the background to the default texture" (subitems ("Random texture" (quote (let ((shade (|\\Pick-One-At-Random| (quote ((\\\,@ (cl:mapcar (cl:function (cl:lambda (bm) (|if| (cl:symbolp bm) |then| bm |else| (cdr bm)))) bitmaps)) (\\\,@ (cl:mapcar (cl:function car) menu-items)) (\\\,@ images) "Rand"))))) (cond ((for item in menu-items thereis (and (cl:consp item) (stringp (car item)) (string-equal shade (car item))) finally (if $$val then (eval (cadr item))))) ((equal shade "Rand") (changebackground (rand 0 blackshade))) ((listp shade) (background.fetch (car shade) (cdr shade))) ((litatom shade) (changebackground (evalv shade))) (t (changebackground shade))))) "Change the background texture to a randomly selected shade") (\\\,@ (|for| bm |in| bitmaps |collect| (|if| (cl:symbolp bm) |then| (bquote ((\\\, bm) (changebackground (\\\, bm)))) |else| (bquote ((\\\, (car bm)) (changebackground (\\\, (cdr bm)))))))) (\\\,@ menu-items) (\\\,@ (|for| image |in| images |collect| (bquote ((\\\, (car image)) (quote (background.fetch (quote (\\\, (car image))) (quote (\\\, (cdr image))))))))))))))))))) (declare\: donteval@load donteval@compile (|AddLoadMenuItem| (quote nil) (quote ((sysload from lispusers) "BackgroundImages" "StarBG" (nil from "{piglet/n}colab>faces>") "Dead")) (quote (|push| |BackgroundMenuCommands| (let ((bitmaps (quote (("Standard texture" . windowbackgroundshade) ("Gray shade" . grayshade) ("Light wall paper" . lightwallpaper) ("Medium wall paper" . wallpaper) ("Dark wall paper" . darkwallpaper) ("Waves" . wave-texture) ("Tweed" . xcl-user::*tweed-bm*) ("Chambray" . xcl-user::*chambray-bm*) ("Canvas" . xcl-user::*canvas-bm*) ("Corduroy" . xcl-user::*corduroy-bm*) ("Seersucker" . xcl-user::*seersucker-bm*) ("Burlap" . xcl-user::*burlap-bm*) ("Mesh" . mesh-texture)))) (images (background.files)) (menu-items (quote (("Stars" (quote (starbg)) "Fill the background with stars" (subitems ("ET go home" (quote (|SaucerOff|)) "Get rid of the saucer"))) ("Granite" (quote (|GraniteBG|)) "Fill the background with a pleasing, almost random shade") ("Dead" (changebackground (expandbitmap dead-bm 2 2)) "Put a Deadhead on the background"))))) (bquote ("Change background" (quote (changebackground)) "Change the background to the default texture" (subitems ("Random texture" (quote (let ((shade (|\\Pick-One-At-Random| (quote ((\\\,@ (cl:mapcar (cl:function (cl:lambda (bm) (|if| (cl:symbolp bm) |then| bm |else| (cdr bm)))) bitmaps)) (\\\,@ (cl:mapcar (cl:function car) menu-items)) (\\\,@ images) "Rand"))))) (cond ((for item in menu-items thereis (and (cl:consp item) (stringp (car item)) (string-equal shade (car item))) finally (if $$val then (eval (cadr item))))) ((equal shade "Rand") (changebackground (rand 0 blackshade))) ((listp shade) (background.fetch (car shade) (cdr shade))) ((litatom shade) (changebackground (evalv shade))) (t (changebackground shade))))) "Change the background texture to a randomly selected shade") (\\\,@ (|for| bm |in| bitmaps |collect| (|if| (cl:symbolp bm) |then| (bquote ((\\\, bm) (changebackground (\\\, bm)))) |else| (bquote ((\\\, (car bm)) (changebackground (\\\, (cdr bm)))))))) (\\\,@ menu-items) (\\\,@ (|for| image |in| images |collect| (bquote ((\\\, (car image)) (quote (background.fetch (quote (\\\, (car image))) (quote (\\\, (cdr image)))))))))))))))) ) (rpaqq display-control-init-commands ((declare\: donteval@load donteval@compile (loadmenuitems "Screen-Maintanance" (((sysload from lispusers) "WDWHacks")) (((sysload from lispusers) "Turbo-Windows")) (((sysload from lispusers) "Solid-Movew")) (((sysload from lispusers) "NSDisplaySizes")) (((sysload from lispusers) "SNAPW-ICON")))))) (declare\: donteval@load donteval@compile (|AddLoadMenuItem| (quote "Screen-Maintanance") (quote ((sysload from lispusers) "WDWHacks"))) (|AddLoadMenuItem| (quote "Screen-Maintanance") (quote ((sysload from lispusers) "Turbo-Windows"))) (|AddLoadMenuItem| (quote "Screen-Maintanance") (quote ((sysload from lispusers) "Solid-Movew"))) (|AddLoadMenuItem| (quote "Screen-Maintanance") (quote ((sysload from lispusers) "NSDisplaySizes"))) (|AddLoadMenuItem| (quote "Screen-Maintanance") (quote ((sysload from lispusers) "SNAPW-ICON"))) ) (rpaqq idle-init-commands ((declare\: donteval@load donteval@compile (loadmenuitems "IdlePatterns" (((sysload from lispusers) "IdleHax")) (((sysload from lispusers) "IdleDrain") (/listput idle.profile (quote displayfn) (quote idle-drain))) (((sysload from lispusers) "ReadBrush")) (((sysload from "{nb:}Andes>Users>") "Bouncing-Face")) (((sysload from lispusers) "StarBG") (/listput idle.profile (quote displayfn) (quote |Cosmos|))) (((sysload from lispusers) "Pac-Man-Idle") (/listput idle.profile (quote displayfn) (quote |Pac-Man-Idle|))) (((sysload from "{QV}Lisp>") "Idle-Cost")) (((sysload) "ScreenPaper") (/listput idle.profile (quote displayfn) (quote screenpaper))) (((sysload from private-lispusers) "Idle-Lyrics") (/listput idle.profile (quote displayfn) (quote xcl-user::idle-lyrics)))) (p (eval-at-greet (/listput idle.profile (quote forget) nil) (/listput idle.profile (quote allowed.logins) nil)))))) (declare\: donteval@load donteval@compile (|AddLoadMenuItem| (quote "IdlePatterns") (quote ((sysload from lispusers) "IdleHax"))) (|AddLoadMenuItem| (quote "IdlePatterns") (quote ((sysload from lispusers) "IdleDrain")) (quote (/listput idle.profile (quote displayfn) (quote idle-drain)))) (|AddLoadMenuItem| (quote "IdlePatterns") (quote ((sysload from lispusers) "ReadBrush"))) (|AddLoadMenuItem| (quote "IdlePatterns") (quote ((sysload from "{nb:}Andes>Users>") "Bouncing-Face"))) (|AddLoadMenuItem| (quote "IdlePatterns") (quote ((sysload from lispusers) "StarBG")) (quote (/listput idle.profile (quote displayfn) (quote |Cosmos|)))) (|AddLoadMenuItem| (quote "IdlePatterns") (quote ((sysload from lispusers) "Pac-Man-Idle")) (quote (/listput idle.profile (quote displayfn) (quote |Pac-Man-Idle|)))) (|AddLoadMenuItem| (quote "IdlePatterns") (quote ((sysload from "{QV}Lisp>") "Idle-Cost"))) (|AddLoadMenuItem| (quote "IdlePatterns") (quote ((sysload) "ScreenPaper")) (quote (/listput idle.profile (quote displayfn) (quote screenpaper)))) (|AddLoadMenuItem| (quote "IdlePatterns") (quote ((sysload from private-lispusers) "Idle-Lyrics")) (quote (/listput idle.profile (quote displayfn) (quote xcl-user::idle-lyrics)))) (eval-at-greet (/listput idle.profile (quote forget) nil) (/listput idle.profile (quote allowed.logins) nil)) ) (rpaqq clock-init-commands ((initvars (biclockinitialprops (quote (horizontal left vertical bottom size 95)))) (declare\: donteval@load donteval@compile (files (sysload noerror from lispusers) biclock) (loadmenuitems nil (((sysload from lispusers) "Crock") (cl:when (and (boundp (quote biclockwindow)) (windowp biclockwindow)) (closew biclockwindow))))))) (rpaq? biclockinitialprops (quote (horizontal left vertical bottom size 95))) (declare\: donteval@load donteval@compile (filesload (sysload noerror from lispusers) biclock) (|AddLoadMenuItem| (quote nil) (quote ((sysload from lispusers) "Crock")) (quote (cl:when (and (boundp (quote biclockwindow)) (windowp biclockwindow)) (closew biclockwindow)))) ) (* |;;| "Programming stuff") (rpaqq programming-init-commands ((functions notice) (functions make) (functions oam) (commands "BREAK" "UNBREAK" "CALLS" "DESCRIBE" "EC" "EFF" "FILES?" "IC" "NOTICE" "MAKE" "SPY") (declare\: donteval@load donteval@compile (p (eval-at-greet (selectq (machinetype) (dorado (metashift t)) nil) (sedit:reset) (filesload (sysload from lispusers) "sedit-profile"))) (loadmenuitems "ProgrammingAids" (((sysload from valueof (append private-lispusersdirectories lispusersdirectories)) "SEdit-Definers"))) (loadmenuitems "ProgrammingAids" (((sysload from valueof (append private-lispusersdirectories lispusersdirectories)) "SEdit-Eval"))) (loadmenuitems "ProgrammingAids" (((sysload from lispusers) "CL-TTYEdit")))) (declare\: donteval@load donteval@compile (loadmenuitems "ProgrammingAids" (((sysload from lispusers) "New-Where-Is"))) (loadmenuitems "ProgrammingAids" (((sysload from lispusers) "Checkpoint"))) (initvars (\spy.button.pos nil)) (loadmenuitems "ProgrammingAids" (((sysload from lispusers) spy) (spy.button \spy.button.pos))) (loadmenuitems "ProgrammingAids" (((sysload from lispusers) "GraphCalls"))) (loadmenuitems "ProgrammingAids" (((sysload from lispusers) "Manager"))) (loadmenuitems "ProgrammingAids" (((sysload from lispusers) "PP-Code-File")) (((sysload from lispusers) "PrettyFileIndex"))) (loadmenuitems "ProgrammingAids" (((sysload from lispusers) "TExec"))) (* |;;| "(loadmenuitems \"ProgrammingAids\" (((sysload from \"{Phylum}rcw>\") \"OSS\")))") (loadmenuitems nil (((sysload from lispusers) "Plot")))) (declare\: donteval@load donteval@compile (p (|AddLoadMenuItem| "ProgrammingAids" (case makesysname (:lyric (quote ((sysload from lispusers) "Port-CLFile"))) (cl:otherwise (quote ((sysload from lispusers) "XCL-Bridge"))))))))) (cl:defun notice (&rest files) (cl:labels ((canonocal-filemanager-name (path) "Return the canonical FileManager name of a file" (cl:intern (cl:string-upcase (cl:pathname-name path)) (cl:find-package "IL"))) (find-source-file (file-name &optional (search-path-list directories)) "Return the full pathname of the source file" (or (cl:probe-file file-name) (let ((original-source-file-name (cdr (cl:first (get (canonocal-filemanager-name (pathname file-name)) (quote filedates)))))) (cl:if original-source-file-name (cl:probe-file original-source-file-name) nil)) (cl:find-if (cl:function cl:probe-file) (cl:mapcar (cl:function (cl:lambda (dir) (cl:merge-pathnames file-name dir))) search-path-list)))) (file-noticed-p (path) "Has the file been noticed?" (cl:member (canonocal-filemanager-name path) filelst :test (quote eq))) (file-loaded-p (path) "Has the file been loaded?" (not (null (get (canonocal-filemanager-name path) (quote filedates))))) (notice-file (path) "Notice the file" (load path (quote prop)))) (let ((alread-noticed-files nil) (not-loaded-files nil) (noticed-files nil) (not-found-files nil)) (cl:mapc (cl:function (cl:lambda (file) (let ((pathname (find-source-file file))) (cond ((null pathname) (cl:push file not-found-files)) ((file-noticed-p pathname) (cl:push pathname alread-noticed-files)) ((file-loaded-p pathname) (loadfrom pathname nil (quote prop)) (cl:push pathname noticed-files)) (t (cl:push pathname not-loaded-files)))))) files) (cl:values noticed-files alread-noticed-files not-loaded-files not-found-files)))) (cl:defun make (files) (let ((files (or files (cl:remove-if-not (cl:function (cl:lambda (file-name) (cdr (get file-name (quote file))))) filelst))) (original-dir *default-pathname-defaults*) file-dir roopt-file) (cl:unwind-protect (cl:dolist (file files) (cl:setq roopt-file (cl:pathname-name file)) (cl:setq roopt-file (cl:typecase roopt-file (string (cl:intern (cl:string-upcase roopt-file) (cl:find-package "IL"))) (cl:symbol (cl:intern (cl:symbol-name roopt-file) (cl:find-package "IL"))))) (cndir (cl:if (get roopt-file (quote filedates)) (let ((file-dir (unpackfilename.string (cdr (cl:first (get roopt-file (quote filedates))))))) (packfilename.string (quote host) (cl:getf file-dir (quote host)) (quote device) (cl:getf file-dir (quote device)) (quote directory) (cl:getf file-dir (quote directory)))) original-dir)) (cl:when (cl:funcall (quote cleanup) roopt-file) (cl:load (packfilename.string (quote name) roopt-file (quote extension) "dfasl")))) (cndir original-dir)))) (cl:defun oam (form) (compiler:optimize-and-macroexpand-1 form (compiler:make-empty-env) (compiler:make-context))) (defcommand "BREAK" (&rest fns) "Set a breakpoint on the named functions." (eval (bquote (break (\\\,@ fns))))) (defcommand "UNBREAK" (&rest fns) "Remove a breakpoint from the named functions." (eval (bquote (unbreak (\\\,@ fns))))) (defcommand "CALLS" (fn) "Print out information about what the function calls." (cond ((not (cl:fboundp fn)) (cl:format t "~%~S has no function definition" fn)) ((cl:macro-function fn) (cl:format t "~%~S is a macro" fn)) ((cl:special-form-p fn) (cl:format t "~%~S is a special-form" fn)) (t (destructuring-bind (calls binds uses-free uses-global) (calls fn) (cl:format t "~%--- ~S ---" fn) (let ((format-string "~%~A:~{ ~S~}")) (cl:when (not (null calls)) (cl:format t format-string "CALLS" calls)) (cl:when (not (null binds)) (cl:format t format-string "BINDS" binds)) (cl:when (not (null uses-free)) (cl:format t format-string "SPECIALS USED" uses-free)) (cl:when (not (null uses-global)) (cl:format t format-string "GLOBALS USED" uses-global)))))) (cl:values)) (defcommand "DESCRIBE" (&rest objects) "Describe the named objects." (cl:mapc (cl:function (cl:lambda (x) (cl:format t "~&-- ~A --" x) (cl:describe x))) objects) (cl:values)) (defcommand "EC" (form) "Evaluate a compiled version of the form" (cl:funcall (prog2 (cl:format t "~%Compiling...") (cl:compile nil (bquote (cl:lambda nil (\\\, form)))) (cl:format t "done.~%")))) (defcommand "EFF" (&rest patterns-commands) "Edit any uses of any of the patterns on any noticed file. Args are ..patterns - ..edit comands." (let* ((position (cl:position "-" patterns-commands :key (cl:function (lambda (pattern) (if (cl:symbolp pattern) then (cl:symbol-name pattern) else ""))) :test (cl:function string-equal))) (patterns (if (null position) then patterns-commands else (cl:butlast patterns-commands (- (length patterns-commands) position)))) (edit-commands (if position then (cl:subseq patterns-commands (1+ position)) else nil))) (case (cl:length patterns) (0 nil) (1 (editfromfile nil nil (cl:first patterns) edit-commands)) (cl:otherwise (editfromfile nil nil (bquote (*any* (\\\,@ patterns))) edit-commands)))) (cl:values)) (defcommand "FILES?" nil "Tell you about what source files need to be dumped." (files?) (cl:values)) (defcommand "IC" (fn) "Inspect the code for the function." (inspectcode (if (cl:symbolp fn) then (if (ccodep (getd fn)) then fn else (cl:compile nil (getd fn))) else (cl:compile nil (if (cl:member (car fn) (quote (cl:lambda lambda)) :test (cl:function eq)) then fn else (bquote (cl:lambda nil (\\\, fn))))))) (cl:values)) (defcommand "NOTICE" (&rest files) "Notice a set of files, so things on them can be edited" (cl:flet ((tell-user (files msg) (cl:when files (cl:format t "~%~A" msg) (cl:mapcar (cl:function (cl:lambda (path) (cl:format t "~%~5T~A" (cl:pathname-name path)))) files)))) (cl:multiple-value-bind (just-noticed previously-noticed not-loaded not-found) (cl:apply (cl:function notice) files) (tell-user just-noticed "Noticed files") (tell-user previously-noticed "Previously noticed files") (tell-user not-loaded "Not loaded, so not noticed files") (tell-user not-found "Could not find files")) (cl:values))) (defcommand "MAKE" (&rest files) "Save, recompile, and reload the files." (make files) (cl:values)) (defcommand "SPY" (form) (cl:unwind-protect (progn (spy.start) (prog1 (cl:eval form) (spy.end))) (spy.end) (spy.tree))) (declare\: donteval@load donteval@compile (eval-at-greet (selectq (machinetype) (dorado (metashift t)) nil) (sedit:reset) (filesload (sysload from lispusers) "sedit-profile")) (|AddLoadMenuItem| (quote "ProgrammingAids") (quote ((sysload from valueof (append private-lispusersdirectories lispusersdirectories)) "SEdit-Definers"))) (|AddLoadMenuItem| (quote "ProgrammingAids") (quote ((sysload from valueof (append private-lispusersdirectories lispusersdirectories)) "SEdit-Eval"))) (|AddLoadMenuItem| (quote "ProgrammingAids") (quote ((sysload from lispusers) "CL-TTYEdit"))) ) (declare\: donteval@load donteval@compile (|AddLoadMenuItem| (quote "ProgrammingAids") (quote ((sysload from lispusers) "New-Where-Is"))) (|AddLoadMenuItem| (quote "ProgrammingAids") (quote ((sysload from lispusers) "Checkpoint"))) (rpaq? \spy.button.pos nil) (|AddLoadMenuItem| (quote "ProgrammingAids") (quote ((sysload from lispusers) spy)) (quote (spy.button \spy.button.pos))) (|AddLoadMenuItem| (quote "ProgrammingAids") (quote ((sysload from lispusers) "GraphCalls"))) (|AddLoadMenuItem| (quote "ProgrammingAids") (quote ((sysload from lispusers) "Manager"))) (|AddLoadMenuItem| (quote "ProgrammingAids") (quote ((sysload from lispusers) "PP-Code-File"))) (|AddLoadMenuItem| (quote "ProgrammingAids") (quote ((sysload from lispusers) "PrettyFileIndex"))) (|AddLoadMenuItem| (quote "ProgrammingAids") (quote ((sysload from lispusers) "TExec"))) (|AddLoadMenuItem| (quote nil) (quote ((sysload from lispusers) "Plot"))) ) (declare\: donteval@load donteval@compile (|AddLoadMenuItem| "ProgrammingAids" (case makesysname (:lyric (quote ((sysload from lispusers) "Port-CLFile"))) (cl:otherwise (quote ((sysload from lispusers) "XCL-Bridge"))))) ) (rpaqq old-utils-commands ((fns |DebugMode|) (fns selectw) (functions de file) (usermacros de ee fv) (fns |PrintDocFile|) (fns |\\Pick-One-At-Random|) (functions |PickOneAtRandom|) (fns |GoodNight| |NewLisp|) (fns |RememberLastPartition| |RememberLispState|) (declare\: donteval@load donteval@compile (addvars (beforelogoutforms (|RememberLispState|) (|RememberLastPartition|)))))) (defineq (|DebugMode| (lambda (debug-on-p all-execs-p) (* \; "Edited 25-Jan-88 08:19 by smL") (|if| debug-on-p |then| (setq nlsetqgag nil) (setq helpflag break!) (|if| all-execs-p |then| (putassoc 'helpflag (list 'break!) *per-exec-variables*)) |else| (setq nlsetqgag t) (setq helpflag t) (|if| all-execs-p |then| (putassoc 'helpflag (list t) *per-exec-variables*))))) ) (defineq (selectw (lambda nil (* \; "Edited 15-Jan-88 09:17 by smL") (* |;;;| "Let the user select a window") (|first| (clrprompt) (|printout| promptwindow "Move mouse to desired window." t "Then press down the CTRL key or click mouse") |until| (or (keydownp 'ctrl) (not (mousestate up))) |do| nil |finally| (getmousestate) (clrprompt) (return (whichw))))) ) (defmacro de (|fn-name| |arg-list| &rest |body|) (* |;;;| "Shorthand for defineing functions") (bquote (defineq ((\\\, |fn-name|) (\\\, |arg-list|) (\\\,@ |body|))))) (defmacro file (|file-name| &rest |file-package-commands|) (* |;;;| "Allows one to create a file giving the commands explicitly e.g. - (FILE FOO (VARS * FUMVARS) (FNS * FNSLIST)) - will create FOOCOMS and make file FOO") (let ((|real-file-name| (u-case |file-name|))) (bquote (progn (\\\, (|if| (null |file-package-commands|) |then| nil |elseif| (and (litatom (car |file-package-commands|)) (null (cdr |file-package-commands|))) |then| (bquote (/setatomval (filecoms (quote (\\\, |real-file-name|))) (getatomval (quote (\\\, (car |file-package-commands|)))))) |else| (bquote (/setatomval (filecoms (quote (\\\, |real-file-name|))) (quote (\\\, |file-package-commands|)))))) (resetform (radix 10) (makefile (quote (\\\, |real-file-name|)))))))) (addtovar usermacros (de nil (comsq (bi 1 -1) (e (dedite (\## 1)) t) (bo 1))) (ee (dummy) (e (cursor t) t) (e (windowprop ttyineditwindow (quote title) (concat "TtyInEdit of " type " " atm)) t) (coms (tted do.ee ee))) (ee nil (e (cursor t) t) (e (windowprop ttyineditwindow (quote title) (concat "TtyInEdit of " type " " atm)) t) (coms (tted do.ee ee))) (fv nil (e (freevars (\## (orr (up 1) nil)) t)))) (addtovar editcomsa de ee) (addtovar editcomsl ee) (defineq (|PrintDocFile| (lambda (utility-name print-server) (* \; "Edited 17-Mar-88 16:24 by smL") (* |;;;| "Print out the documentation file for the named package") (setq print-server (or print-server (car defaultprintinghost))) (cl:flet ((find-doc-source-file nil (or (findfile (packfilename 'name utility-name 'extension 'tedit) nil directories) (findfile (packfilename 'name utility-name 'extension 'ted) nil directories) (findfile (packfilename 'name utility-name 'extension 'txt) nil directories) (findfile (packfilename 'name utility-name 'extension 'doc) nil directories)))) (|if| (eq print-server t) |then| (let ((doc-file (find-doc-source-file))) (|if| doc-file |then| (tedit doc-file) |else| "No doc file found")) |elseif| print-server |then| (let ((doc-file (or (findfile (packfilename 'name utility-name 'extension (selectq (printertype print-server) ((press fullpress) 'press) (interpress 'ip) (help "Unknown printer type!"))) nil directories) (find-doc-source-file)))) (|if| doc-file |then| (add.process `(empress ',doc-file nil ',print-server)) (concat "Printing file " doc-file " on printer " print-server) |else| "No doc file found")) |else| "No printer specified")))) ) (defineq (|\\Pick-One-At-Random| (lambda (|list|) (* \; "Edited 15-Jan-88 09:20 by smL") (* |;;;| "Return a random element of the list") (resetlst (resetsave (randset t) `(randset ,(randset))) (car (nth |list| (rand 1 (length |list|))))))) ) (defmacro |PickOneAtRandom| (&rest |elements|) (bquote (|\\Pick-One-At-Random| (quote (\\\, (mapcar |elements| (quote eval))))))) (defineq (|GoodNight| (lambda (|flag| |altoCommandString|) (* |smL| "20-Sep-85 14:43") (let ((|stream| (openstream '{dsk}rem.cm\;1 'output 'old/new))) (prin1 (or |altoCommandString| "Q") |stream|) (terpri |stream|) (closef |stream|)) (logout |flag|))) (|NewLisp| (lambda nil (* \; "Edited 15-Jan-88 09:20 by smL") (* |;;;| "Start up a new system, assuming that {DSK}KEY1.CM starts one up.") (|if| (mouseconfirm "Do you really want to start up a new system?") |then| (|GoodNight| t "@KEY1.CM")))) ) (defineq (|RememberLastPartition| (lambda nil (* \; "Edited 15-Jan-88 09:21 by smL") (* |;;;| "Sets up the KEY3 CM file in the last partition (19 or 5) to put you back in this partition.") (selectq (machinetype) (dorado (|for| |partitionNumber| |in| '(19 5) |bind| |stream| |key3File| |eachtime| (setq |key3File| (concat "{DSK" |partitionNumber| "}KEY3.CM;1")) (setq |stream| (car (nlsetq (getstream |key3File|)))) (and |stream| (closef? |stream|)) (setq |stream| (car (nlsetq (openstream |key3File| 'output 'old/new)))) |thereis| (streamp |stream|) |finally| (|if| (and (streamp |stream|) (openp |stream|)) |then| (|printout| |stream| "// " "This will set you back in your last used partition, " firstname t "// [last used " (date) "]" t "Par " (diskpartition) t) (closef |stream|)))) nil))) (|RememberLispState| (lambda nil (* \; "Edited 15-Jan-88 09:21 by smL") (* |;;;| "Make KEY2.CM restart this lisp if the logout was not FAST...") (nlsetq (|if| (and (stkpos 'logout) (eq (machinetype) 'dorado)) |then| (|if| (nlsetq (getstream '{dsk}key2.cm\;1)) |then| (closef? (getstream '{dsk}key2.cm\;1))) (resetlst (let ((logout-arg (stkarg 1 'logout)) (stream (openstream '{dsk}key2.cm\;1 'output 'old/new))) (resetsave nil (list (function closef?) stream)) (|printout| stream "// You did a (LOGOUT") (selectq logout-arg (nil nil) (|printout| stream " " logout-arg)) (|printout| stream ") last time [" (date) "], so this will ") (selectq logout-arg ((nil ?) (|printout| stream "restart your old")) (|printout| stream "start a new")) (|printout| stream " LISP, " firstname t) (selectq logout-arg ((nil ?) (|printout| stream "Lisp") (|if| (eqp (realmemorysize) 21845) |then| (|printout| stream " 52525/c"))) (|printout| stream "@KEY1.CM")) (|printout| stream t))))))) ) (declare\: donteval@load donteval@compile (addtovar beforelogoutforms (|RememberLispState|) (|RememberLastPartition|)) ) (rpaqq wizard-init-commands ((functions atom-neighbors))) (cl:defun atom-neighbors (cl:symbol &optional (xcl-user::number-of-neighbors 8)) (cl:if (cl:symbolp cl:symbol) (let ((xcl-user::atom-number (\\loloc cl:symbol)) (xcl-user::neighbors (list cl:symbol))) (cl:dotimes (xcl-user::i xcl-user::number-of-neighbors) (cl:push (\\vag2 0 (+ xcl-user::atom-number 1 xcl-user::i)) xcl-user::neighbors)) (cl:setf xcl-user::neighbors (cl:nreverse xcl-user::neighbors)) (cl:dotimes (xcl-user::i xcl-user::number-of-neighbors) (cl:push (\\vag2 0 (- xcl-user::atom-number 1 xcl-user::i)) xcl-user::neighbors)) xcl-user::neighbors) "Not a symbol")) (rpaqq dinfo-init-commands ((declare\: donteval@load donteval@compile (vars (irm.host&dir (cond ((infilep "{DSK}HELPSYS>IRMTOP.TEDIT") "{DSK}HELPSYS>") ((and (boundp (quote irm.host&dir)) irm.host&dir) irm.host&dir) (t "{Pallas:AISNorth:XEROX}Lyric>LispUsers>IRM>"))) (dinfomodes (quote (graph)))) (initvars (irm.font (fontcreate (quote (helvetica 10)))) (irmwindowregion (let ((width (widthifwindow (cl:* 60 (stringwidth "w" irm.font))))) (createregion (- screenwidth width 5) 5 width (quotient screenheight 2))))) (loadmenuitems "ProgrammingAids" (((sysload from lispusers) "DInfo" "Helpsys") (dinfo (irm.get.dinfograph t) irmwindowregion)) (((sysload from lispusers) "LispNerd")))))) (declare\: donteval@load donteval@compile (rpaq irm.host&dir (cond ((infilep "{DSK}HELPSYS>IRMTOP.TEDIT") "{DSK}HELPSYS>") ((and (boundp (quote irm.host&dir)) irm.host&dir) irm.host&dir) (t "{Pallas:AISNorth:XEROX}Lyric>LispUsers>IRM>"))) (rpaqq dinfomodes (graph)) (rpaq? irm.font (fontcreate (quote (helvetica 10)))) (rpaq? irmwindowregion (let ((width (widthifwindow (cl:* 60 (stringwidth "w" irm.font))))) (createregion (- screenwidth width 5) 5 width (quotient screenheight 2)))) (|AddLoadMenuItem| (quote "ProgrammingAids") (quote ((sysload from lispusers) "DInfo" "Helpsys")) (quote (dinfo (irm.get.dinfograph t) irmwindowregion))) (|AddLoadMenuItem| (quote "ProgrammingAids") (quote ((sysload from lispusers) "LispNerd"))) ) (rpaqq pcl-init-commands ((initvars (pcldirectories (bquote ((\\\,@ *cache-directories*) (\\\, (if (eq (machinetype) (quote maiko)) then "{dsk}pcl>medley>" else "{pooh/n}pcl>medley>")) "{NB:PARC:XEROX}MEDLEY>")))) (declare\: donteval@load donteval@compile (p (eval-at-greet (cl:unless (cl:find-package "PCL") (|AddLoadMenuItem| "Subsystems" (quote ((from pcl) "Load-PCL"))))))))) (rpaq? pcldirectories (bquote ((\\\,@ *cache-directories*) (\\\, (if (eq (machinetype) (quote maiko)) then "{dsk}pcl>medley>" else "{pooh/n}pcl>medley>")) "{NB:PARC:XEROX}MEDLEY>"))) (declare\: donteval@load donteval@compile (eval-at-greet (cl:unless (cl:find-package "PCL") (|AddLoadMenuItem| "Subsystems" (quote ((from pcl) "Load-PCL"))))) ) (rpaqq loops-init-commands ((initvars (loopsdirectories (bquote ((\\\,@ *cache-directories*) "{NB:PARC:XEROX}Medley>Sources>" "{POGO:AISNorth:XEROX}SYSTEM>"))) (\\loops-init-form (quote (progn (filesload (noerror from "{EG:PARC:XEROX}Loops>") initloops))))) (declare\: donteval@load donteval@compile (p (eval-at-greet (cond ((cl:member "LOOPS" *features* :test (cl:function string-equal)) (eval \\loops-init-form)) (t (|AddLoadMenuItem| "Subsystems" (quote ((from loops) "Loops")) \\loops-init-form)))))))) (rpaq? loopsdirectories (bquote ((\\\,@ *cache-directories*) "{NB:PARC:XEROX}Medley>Sources>" "{POGO:AISNorth:XEROX}SYSTEM>"))) (rpaq? \\loops-init-form (quote (progn (filesload (noerror from "{EG:PARC:XEROX}Loops>") initloops)))) (declare\: donteval@load donteval@compile (eval-at-greet (cond ((cl:member "LOOPS" *features* :test (cl:function string-equal)) (eval \\loops-init-form)) (t (|AddLoadMenuItem| "Subsystems" (quote ((from loops) "Loops")) \\loops-init-form)))) ) (* |;;| "Documentation") (rpaqq tedit-init-commands ((functions load-nova-fonts) (declare\: donteval@load donteval@compile (vars (tedit.default.window (createw (let ((width (widthifwindow (times 80 (tedit.stringwidth "A")))) (height (heightifwindow (times 35 (fontprop defaultfont (quote height))) t))) (createregion (min 475 (- screenwidth (+ width 10))) (max 85 (- screenheight height 100)) width height)) "TEDIT window" nil t)) (tedit.default.props (bquote ((\\\,@ tedit.default.props) paralooks (tabs ((\\\, (times 8 (tedit.stringwidth "A"))))))))) (p (eval-at-greet (cl:when (getd (quote tedit)) (undosave (bquote (tedit.setsyntax (\\\, (charcode esc)) (\\\, (tedit.getsyntax (charcode esc)))))) (tedit.setsyntax (charcode esc) (quote redo))))) (loadmenuitems "WritingAids" (((sysload from lispusers) "ProofReader")) (((sysload from lispusers) "TMAX")) (((sysload from lispusers) "DictTool")) (((sysload from lispusers) "TEditDoradoKeys")) (((sysload from lispusers) "EditKeys")) (((sysload from lispusers) "VirtualKeyboards") (let ((keyboard-file (findfile "Code.Keyboard" t private-lispusersdirectories))) (cl:when keyboard-file (vkbd.load-keyboard-file keyboard-file)))) (((sysload from lispusers) "KeyboardEditor")) (((sysload from lispusers) "Equations" "Sketch")) (((sysload from lispusers) "NovaFont") (load-nova-fonts))) (coms (initvars (docobjectsmenufont menufont)) (alists (imageobjgetfns docobj-filestamp-getfn docobj-timestamp-getfn docobj-include-getfn)) (loadmenuitems "WritingAids" (((sysload from lispusers) "Doc-Objects"))))))) (cl:defun load-nova-fonts nil (let ((nova-font-host "Starfile Public:Parc:Xerox") (nova-fonts-to-load (quote ("VP Optima XSG Fonts>OptimaItalic" "VP Optima XSG Fonts>OptimaMedium"))) (nova-fonts-to-notice (quote ("Xerox Logo Fonts>XeroxLogo" "Xerox VP Quartz Fonts!2>QuartzBIR" "Xerox VP Quartz Fonts!2>QuartzBRR" "Xerox VP Quartz Fonts!2>QuartzMIR" "Xerox VP Quartz Fonts!2>QuartzMRR")))) (cl:flet ((find-nova-font (font) "Find the Novafont file" (cl:probe-file (cl:make-pathname :host nova-font-host :type "NovaFont" :defaults font)))) (cl:mapc (cl:function (cl:lambda (font) (let ((font-file (find-nova-font font))) (cl:when font-file (cl:format (getstream promptwindow (quote output)) "~%Loading Novafont ~A" (cl:pathname-name font-file)) (load-novafont-file font-file) (notice-novafont-file font-file))))) nova-fonts-to-load) (cl:mapc (cl:function (cl:lambda (font) (let ((font-file (find-nova-font font))) (cl:when font-file (cl:format (getstream promptwindow (quote output)) "~%Noticing Novafont ~A" (cl:pathname-name font-file)) (notice-novafont-file font-file))))) nova-fonts-to-notice))) (cl:mapc (cl:function (cl:lambda (item) (cl:pushnew item tedit.known.fonts :test (quote cl:equal)))) (quote (("XeroxLogo" (quote xeroxlogo)) ("Quartz" (quote quartz)) ("Optima" (quote optima)))))) (declare\: donteval@load donteval@compile (rpaq tedit.default.window (createw (let ((width (widthifwindow (times 80 (tedit.stringwidth "A")))) (height (heightifwindow (times 35 (fontprop defaultfont (quote height))) t))) (createregion (min 475 (- screenwidth (+ width 10))) (max 85 (- screenheight height 100)) width height)) "TEDIT window" nil t)) (rpaq tedit.default.props (bquote ((\\\,@ tedit.default.props) paralooks (tabs ((\\\, (times 8 (tedit.stringwidth "A")))))))) (eval-at-greet (cl:when (getd (quote tedit)) (undosave (bquote (tedit.setsyntax (\\\, (charcode esc)) (\\\, (tedit.getsyntax (charcode esc)))))) (tedit.setsyntax (charcode esc) (quote redo)))) (|AddLoadMenuItem| (quote "WritingAids") (quote ((sysload from lispusers) "ProofReader"))) (|AddLoadMenuItem| (quote "WritingAids") (quote ((sysload from lispusers) "TMAX"))) (|AddLoadMenuItem| (quote "WritingAids") (quote ((sysload from lispusers) "DictTool"))) (|AddLoadMenuItem| (quote "WritingAids") (quote ((sysload from lispusers) "TEditDoradoKeys"))) (|AddLoadMenuItem| (quote "WritingAids") (quote ((sysload from lispusers) "EditKeys"))) (|AddLoadMenuItem| (quote "WritingAids") (quote ((sysload from lispusers) "VirtualKeyboards")) (quote (let ((keyboard-file (findfile "Code.Keyboard" t private-lispusersdirectories))) (cl:when keyboard-file (vkbd.load-keyboard-file keyboard-file))))) (|AddLoadMenuItem| (quote "WritingAids") (quote ((sysload from lispusers) "KeyboardEditor"))) (|AddLoadMenuItem| (quote "WritingAids") (quote ((sysload from lispusers) "Equations" "Sketch"))) (|AddLoadMenuItem| (quote "WritingAids") (quote ((sysload from lispusers) "NovaFont")) (quote (load-nova-fonts))) (rpaq? docobjectsmenufont menufont) (addtovar imageobjgetfns (docobj-filestamp-getfn file doc-objects) (docobj-timestamp-getfn file doc-objects) (docobj-include-getfn file doc-objects)) (|AddLoadMenuItem| (quote "WritingAids") (quote ((sysload from lispusers) "Doc-Objects"))) ) (rpaqq sketch-init-commands ((alists (imageobjgetfns skio.getfn skio.getfn.2)) (declare\: donteval@load donteval@compile (loadmenuitems "WritingAids" (((sysload from lispusers) "Sketch")))))) (addtovar imageobjgetfns (skio.getfn) (skio.getfn.2 file sketch)) (declare\: donteval@load donteval@compile (|AddLoadMenuItem| (quote "WritingAids") (quote ((sysload from lispusers) "Sketch"))) ) (rpaqq notecards-init-commands ((initvars (|NC.NoteCardsIconPosition| (createposition 891 2)) (ncinitialglobalparams (quote (|ForceFiling| nil |MarkersInFileBoxes| nil |UseDeletedLinkIconIndicators| nil))) (notecardsdirectories (bquote ((\\\,@ *cache-directories*) "{QV}1.3L>" "{NB:PARC:XEROX}1.3L>")))) (declare\: donteval@load donteval@compile (loadmenuitems "WritingAids" (((sysload from notecards) "NoteCards") (|NoteCards| |NC.NoteCardsIconPosition|)))))) (rpaq? |NC.NoteCardsIconPosition| (createposition 891 2)) (rpaq? ncinitialglobalparams (quote (|ForceFiling| nil |MarkersInFileBoxes| nil |UseDeletedLinkIconIndicators| nil))) (rpaq? notecardsdirectories (bquote ((\\\,@ *cache-directories*) "{QV}1.3L>" "{NB:PARC:XEROX}1.3L>"))) (declare\: donteval@load donteval@compile (|AddLoadMenuItem| (quote "WritingAids") (quote ((sysload from notecards) "NoteCards")) (quote (|NoteCards| |NC.NoteCardsIconPosition|))) ) (* |;;| "Communication & Info") (rpaqq mail-init-commands ((vars (*new-lafite-p* (not (cl:fboundp (quote \\lafite.getmailfolder))))) (declare\: donteval@load donteval@compile (vars (defaultmailfoldername (quote active.mail)) (lafitedefaulthost&dir (pack* |\\UserHomeDirectory| "MAIL>")) (lafitehardcopybatchflg t) (lafitemovetoconfirmflg (quote left)) (lafiteshowmodeflg (quote always)) (lafitebrowserregion (createregion 360 5 650 165)) (lafitedisplayregion (|with| region (windowprop |\\TopLevelTtyWindow| (quote region)) (createregion (max left scrollbarwidth) 175 (widthifwindow (min (quotient (times 2 screenwidth) 3) (times 85 (stringwidth "W" lafitedisplayfont)))) (difference bottom 175)))) (lafitestatuswindowposition (createposition 100 45)) (lafitemodedefault (or lafitemodedefault (quote gv)))) (vars (lafite.dont.display.headers (quote ("Return-Path" "Redistributed" "Received" "Message-Id" "Comments" "Zippy-Says" "X-Mailer" "Organization" "References" "GVGV"))) (lafite.dont.forward.headers lafite.dont.display.headers) (lafite.dont.hardcopy.headers lafite.dont.display.headers)) (loadmenuitems "MailTools" (((sysload from lispusers) "LafiteTimedDelete")) (((sysload from lispusers) "LafiteFind")) (((sysload from lispusers) "Maintain")) (((sysload from lispusers) "NSMaintain")) (((sysload from lispusers) "MailScavenge")) (((sysload from lispusers) "Undigestify")) (((from lispusers) "Lafite-Indent")) (((sysload from lispusers) "MailShare")) (((sysload from "{QV}Lisp>") "LafiteFolderIcon")) (((sysload from "{ERIS}Sources>") "AppendMail"))) (p (eval-at-greet (cl:unless (not *new-lafite-p*) (|AddLoadMenuItem| "MailTools" (quote ((sysload from lispusers) "LafiteHighlight"))) (|AddLoadMenuItem| "MailTools" (quote ((sysload from "{fs8:}Lisp>") "Short-Lafite-Header"))))))) (declare\: donteval@load donteval@compile (p (eval-at-greet (if *new-lafite-p* then (rpaq lafite.signature (or lafite.signature (concat (character (charcode eol)) (character (charcode eol)) "----- " (or (caddr (car initialslst)) "me") (character (charcode eol))))) (rpaq lafite.gv.from.field (or lafite.gv.from.field (concat (or (cadr (car initialslst)) "") " " (username nil nil t) " <" (cond ((cl:fboundp (quote fullusername)) (fullusername)) (t (username))) ">"))) else (rpaq? lafitemsgtagstring (concat (character (charcode eol)) (character (charcode eol)) "----- " (or (caddr (car initialslst)) "me") (character (charcode eol)))) (rpaq? lafitemsgheaderstring (concat "From: " (or (cadr (car initialslst)) "") " " (username nil nil t) " <" (cond ((cl:fboundp (quote fullusername)) (fullusername)) (t (username))) ">" (character (charcode eol)))) (filesload (noerror from valueof (append private-lispusersdirectories lispusersdirectories)) "Tailor-Lafite-Msg"))))) (initvars (lafitedldirectories nil)) (declare\: donteval@load donteval@compile (p (eval-at-greet (cl:unless *new-lafite-p* (|AddLoadMenuItem| "MailTools" (quote ((sysload from lispusers) "LafitePrivateDL"))))))) (p (eval-at-greet (cl:when (and (cl:fboundp (quote lafite)) (not *new-lafite-p*)) (filesload (sysload noerror from "{fs8:}Lisp>") "LafiteTitlePatch") (changename (quote la.opentempfile) (quote dsk) (quote scratch)) (lafitemode (quote gv))))) (coms (initvars (\\use-lens? nil) (user::*lens-user-parameters* (bquote ((:default-host-and-dir lafitedefaulthost&dir) (:icon-pos (createposition 98 8)) (:mailweb-pos (createposition 194 7)) (:mailweb-icon-pos (createposition 194 7)) (:mailweb-font (fontcreate (quote (helvetica 8)))) (:feedback-p nil) (:filing-rule "Filing Rules") (:room-name (quote ("Mail"))))))) (vars (user::lens-loader-dir (if (or *new-lafite-p* (eq user::lens-loader-dir :next)) then "{NB:PARC:Xerox}Next>" else "{NB:PARC:Xerox}Current>"))) (p (eval-at-greet (cond ((cl:member "Common-Lens" *modules* :test (cl:function string-equal)) (cl:funcall (cl:intern "LOAD-LENS-PATCHES" "CLENS"))) ((and \\use-lens? (not (null (cl:find-package "PCL")))) (cl:load (cl:make-pathname :name "Common-Lens" :defaults user::lens-loader-dir))) (t (|AddLoadMenuItem| "MailTools" (quote ((from valueof user::lens-loader-dir) "Common-Lens")) (quote (ignore-errors (lafite (quote off)) (cl:funcall (cl:intern "COMMON-LENS" (cl:find-package "CLENS")) :on))))))))) (initvars (\\turn-on-mailer (equal (etherhostnumber home-machine-name) (etherhostnumber)))) (p (eval-at-greet (cond ((not (getd (quote lafite))) nil) ((not \\turn-on-mailer) nil) ((and \\use-lens? (not (null (cl:find-package "CLENS")))) (cl:funcall (cl:intern "COMMON-LENS" (cl:find-package "CLENS")) :on)) (t (lafite (quote on)))))))) (rpaq *new-lafite-p* (not (cl:fboundp (quote \\lafite.getmailfolder)))) (declare\: donteval@load donteval@compile (rpaqq defaultmailfoldername active.mail) (rpaq lafitedefaulthost&dir (pack* |\\UserHomeDirectory| "MAIL>")) (rpaqq lafitehardcopybatchflg t) (rpaqq lafitemovetoconfirmflg left) (rpaqq lafiteshowmodeflg always) (rpaq lafitebrowserregion (createregion 360 5 650 165)) (rpaq lafitedisplayregion (|with| region (windowprop |\\TopLevelTtyWindow| (quote region)) (createregion (max left scrollbarwidth) 175 (widthifwindow (min (quotient (times 2 screenwidth) 3) (times 85 (stringwidth "W" lafitedisplayfont)))) (difference bottom 175)))) (rpaq lafitestatuswindowposition (createposition 100 45)) (rpaq lafitemodedefault (or lafitemodedefault (quote gv))) (rpaqq lafite.dont.display.headers ("Return-Path" "Redistributed" "Received" "Message-Id" "Comments" "Zippy-Says" "X-Mailer" "Organization" "References" "GVGV")) (rpaq lafite.dont.forward.headers lafite.dont.display.headers) (rpaq lafite.dont.hardcopy.headers lafite.dont.display.headers) (|AddLoadMenuItem| (quote "MailTools") (quote ((sysload from lispusers) "LafiteTimedDelete"))) (|AddLoadMenuItem| (quote "MailTools") (quote ((sysload from lispusers) "LafiteFind"))) (|AddLoadMenuItem| (quote "MailTools") (quote ((sysload from lispusers) "Maintain"))) (|AddLoadMenuItem| (quote "MailTools") (quote ((sysload from lispusers) "NSMaintain"))) (|AddLoadMenuItem| (quote "MailTools") (quote ((sysload from lispusers) "MailScavenge"))) (|AddLoadMenuItem| (quote "MailTools") (quote ((sysload from lispusers) "Undigestify"))) (|AddLoadMenuItem| (quote "MailTools") (quote ((from lispusers) "Lafite-Indent"))) (|AddLoadMenuItem| (quote "MailTools") (quote ((sysload from lispusers) "MailShare"))) (|AddLoadMenuItem| (quote "MailTools") (quote ((sysload from "{QV}Lisp>") "LafiteFolderIcon"))) (|AddLoadMenuItem| (quote "MailTools") (quote ((sysload from "{ERIS}Sources>") "AppendMail"))) (eval-at-greet (cl:unless (not *new-lafite-p*) (|AddLoadMenuItem| "MailTools" (quote ((sysload from lispusers) "LafiteHighlight"))) (|AddLoadMenuItem| "MailTools" (quote ((sysload from "{fs8:}Lisp>") "Short-Lafite-Header"))))) ) (declare\: donteval@load donteval@compile (eval-at-greet (if *new-lafite-p* then (rpaq lafite.signature (or lafite.signature (concat (character (charcode eol)) (character (charcode eol)) "----- " (or (caddr (car initialslst)) "me") (character (charcode eol))))) (rpaq lafite.gv.from.field (or lafite.gv.from.field (concat (or (cadr (car initialslst)) "") " " (username nil nil t) " <" (cond ((cl:fboundp (quote fullusername)) (fullusername)) (t (username))) ">"))) else (rpaq? lafitemsgtagstring (concat (character (charcode eol)) (character (charcode eol)) "----- " (or (caddr (car initialslst)) "me") (character (charcode eol)))) (rpaq? lafitemsgheaderstring (concat "From: " (or (cadr (car initialslst)) "") " " (username nil nil t) " <" (cond ((cl:fboundp (quote fullusername)) (fullusername)) (t (username))) ">" (character (charcode eol)))) (filesload (noerror from valueof (append private-lispusersdirectories lispusersdirectories)) "Tailor-Lafite-Msg"))) ) (rpaq? lafitedldirectories nil) (declare\: donteval@load donteval@compile (eval-at-greet (cl:unless *new-lafite-p* (|AddLoadMenuItem| "MailTools" (quote ((sysload from lispusers) "LafitePrivateDL"))))) ) (eval-at-greet (cl:when (and (cl:fboundp (quote lafite)) (not *new-lafite-p*)) (filesload (sysload noerror from "{fs8:}Lisp>") "LafiteTitlePatch") (changename (quote la.opentempfile) (quote dsk) (quote scratch)) (lafitemode (quote gv)))) (rpaq? \\use-lens? nil) (rpaq? user::*lens-user-parameters* (bquote ((:default-host-and-dir lafitedefaulthost&dir) (:icon-pos (createposition 98 8)) (:mailweb-pos (createposition 194 7)) (:mailweb-icon-pos (createposition 194 7)) (:mailweb-font (fontcreate (quote (helvetica 8)))) (:feedback-p nil) (:filing-rule "Filing Rules") (:room-name (quote ("Mail")))))) (rpaq user::lens-loader-dir (if (or *new-lafite-p* (eq user::lens-loader-dir :next)) then "{NB:PARC:Xerox}Next>" else "{NB:PARC:Xerox}Current>")) (eval-at-greet (cond ((cl:member "Common-Lens" *modules* :test (cl:function string-equal)) (cl:funcall (cl:intern "LOAD-LENS-PATCHES" "CLENS"))) ((and \\use-lens? (not (null (cl:find-package "PCL")))) (cl:load (cl:make-pathname :name "Common-Lens" :defaults user::lens-loader-dir))) (t (|AddLoadMenuItem| "MailTools" (quote ((from valueof user::lens-loader-dir) "Common-Lens")) (quote (ignore-errors (lafite (quote off)) (cl:funcall (cl:intern "COMMON-LENS" (cl:find-package "CLENS")) :on))))))) (rpaq? \\turn-on-mailer (equal (etherhostnumber home-machine-name) (etherhostnumber))) (eval-at-greet (cond ((not (getd (quote lafite))) nil) ((not \\turn-on-mailer) nil) ((and \\use-lens? (not (null (cl:find-package "CLENS")))) (cl:funcall (cl:intern "COMMON-LENS" (cl:find-package "CLENS")) :on)) (t (lafite (quote on))))) (rpaqq chat-init-commands ((declare\: donteval@load donteval@compile (alists (networkloginfo lily symbolics)) (vars (chat.allhosts (sort (cl:remove-duplicates (bquote ((\\\,@ chat.allhosts) |IBID FS:PARC:XEROX| |PARC CHS:PARC:XEROX| erinyes eris phylum qv (\\\,@ (|for| host |in| defaultprintinghost |when| (eq (printertype host) (quote interpress)) |collect| host)))) :test (cl:function string-equal)))) (closechatwindowflg t) (chat.window.size (let ((n-chars-wide 80) (n-chars-high 24)) (cons (min (quotient (times screenwidth 2) 3) (widthifwindow (times n-chars-wide (stringwidth "A" chat.font)))) (min (quotient (times screenheight 2) 3) (heightifwindow (times n-chars-high (fontprop chat.font (quote height))) t))))) (defaultchathost (filenamefield loginhost/dir (quote host)))) (loadmenuitems nil (((sysload from lispusers) "TCPChat")))))) (declare\: donteval@load donteval@compile (addtovar networkloginfo (lily (login "l" username cr password cr)) (symbolics (login))) (rpaq chat.allhosts (sort (cl:remove-duplicates (bquote ((\\\,@ chat.allhosts) |IBID FS:PARC:XEROX| |PARC CHS:PARC:XEROX| erinyes eris phylum qv (\\\,@ (|for| host |in| defaultprintinghost |when| (eq (printertype host) (quote interpress)) |collect| host)))) :test (cl:function string-equal)))) (rpaqq closechatwindowflg t) (rpaq chat.window.size (let ((n-chars-wide 80) (n-chars-high 24)) (cons (min (quotient (times screenwidth 2) 3) (widthifwindow (times n-chars-wide (stringwidth "A" chat.font)))) (min (quotient (times screenheight 2) 3) (heightifwindow (times n-chars-high (fontprop chat.font (quote height))) t))))) (rpaq defaultchathost (filenamefield loginhost/dir (quote host))) (|AddLoadMenuItem| (quote nil) (quote ((sysload from lispusers) "TCPChat"))) ) (rpaqq talk-init-commands ((initvars (talk.default.region (createregion 575 0 500 500))) (declare\: donteval@load donteval@compile (loadmenuitems nil (((sysload from lispusers) "Talk")))) (declare\: donteval@load donteval@compile (loadmenuitems nil (((sysload compiled from lispusers) "Finger"))) (* |;;| "(loadmenuitems nil (((sysload compiled from \"{PHYLUM}Lisp>\") \"Fing\") (fingw)))")))) (rpaq? talk.default.region (createregion 575 0 500 500)) (declare\: donteval@load donteval@compile (|AddLoadMenuItem| (quote nil) (quote ((sysload from lispusers) "Talk"))) ) (declare\: donteval@load donteval@compile (|AddLoadMenuItem| (quote nil) (quote ((sysload compiled from lispusers) "Finger"))) ) (rpaqq calendar-init-commands ((initvars (caldaydefaultregion (createregion 32 200 375 100)) (caldefaultalertdelta -10) (caldefaulthost&dir (concat |\\UserHomeDirectory| "CALENDAR>")) (calfont (fontcreate (quote (helvetica 18)))) (calupdateonshrinkflg t) (calkeepexpiredrems t)) (declare\: donteval@load donteval@compile (loadmenuitems nil (((sysload from lispusers) "Calendar") (progn (calloadfile "CalReminders") (let ((file (findfile "Calmanac88" t lispusersdirectories))) (cl:when file (calloadfile file))) (calendar (quote thisyear)))))))) (rpaq? caldaydefaultregion (createregion 32 200 375 100)) (rpaq? caldefaultalertdelta -10) (rpaq? caldefaulthost&dir (concat |\\UserHomeDirectory| "CALENDAR>")) (rpaq? calfont (fontcreate (quote (helvetica 18)))) (rpaq? calupdateonshrinkflg t) (rpaq? calkeepexpiredrems t) (declare\: donteval@load donteval@compile (|AddLoadMenuItem| (quote nil) (quote ((sysload from lispusers) "Calendar")) (quote (progn (calloadfile "CalReminders") (let ((file (findfile "Calmanac88" t lispusersdirectories))) (cl:when file (calloadfile file))) (calendar (quote thisyear))))) ) (rpaqq printer-init-commands ((initvars (printermenu.position (createposition (difference screenwidth 125) 5))) (loadmenuitems nil (((sysload from lispusers) "PrinterMenu") (printermenu))) (loadmenuitems nil (((sysload from lispusers) "HGraph"))) (loadmenuitems nil (((sysload from lispusers) "Hardcopy-Tab-Patch"))))) (rpaq? printermenu.position (createposition (difference screenwidth 125) 5)) (|AddLoadMenuItem| (quote nil) (quote ((sysload from lispusers) "PrinterMenu")) (quote (printermenu))) (|AddLoadMenuItem| (quote nil) (quote ((sysload from lispusers) "HGraph"))) (|AddLoadMenuItem| (quote nil) (quote ((sysload from lispusers) "Hardcopy-Tab-Patch"))) (rpaqq db-init-commands ((initvars (|*Address-Book-Pos*| (createposition 19 181)) (|*Phone-Directory-Pos*| (createposition 19 181))) (addvars (phonelistfiles "{PIGLET/N}KSA>ROLODEX.TEDIT")) (loadmenuitems nil (((from lispusers) "Phone-Directory")) (((from lispusers) "AddressBook"))) (loadmenuitems "WritingAids" (((from lispusers) "Find-Citation"))) (p (if (and (eq (machinetype) (quote maiko)) (null (cl:find-package "RPC2"))) then (|AddLoadMenuItem| nil (quote ((from "{hulk:}lisp>") "System33" "RPC"))))))) (rpaq? |*Address-Book-Pos*| (createposition 19 181)) (rpaq? |*Phone-Directory-Pos*| (createposition 19 181)) (addtovar phonelistfiles "{PIGLET/N}KSA>ROLODEX.TEDIT") (|AddLoadMenuItem| (quote nil) (quote ((from lispusers) "Phone-Directory"))) (|AddLoadMenuItem| (quote nil) (quote ((from lispusers) "AddressBook"))) (|AddLoadMenuItem| (quote "WritingAids") (quote ((from lispusers) "Find-Citation"))) (if (and (eq (machinetype) (quote maiko)) (null (cl:find-package "RPC2"))) then (|AddLoadMenuItem| nil (quote ((from "{hulk:}lisp>") "System33" "RPC")))) (rpaqq nfs-init-commands ((loadmenuitems "FileAids" (((sysload from "{NB:PARC:XEROX}") "PARC-NFS"))) (p (eval-at-greet (cl:push (quote ("Reset NFS" (quote (cl:funcall (cl:intern "RESET-NFS-CACHE-VARS" (cl:find-package "RPC2")))) "Clear all NFS cache variables")) |BackgroundMenuCommands|))))) (|AddLoadMenuItem| (quote "FileAids") (quote ((sysload from "{NB:PARC:XEROX}") "PARC-NFS"))) (eval-at-greet (cl:push (quote ("Reset NFS" (quote (cl:funcall (cl:intern "RESET-NFS-CACHE-VARS" (cl:find-package "RPC2")))) "Clear all NFS cache variables")) |BackgroundMenuCommands|)) (* |;;| "Files") (rpaqq file-watch-init-commands ((declare\: donteval@load donteval@compile (initvars (|FW-Properties| (bquote (font (gacha 8) all-files? nil position (\\\, (createposition screenwidth (cl:if (and (boundp (quote *who-line*)) (windowp *who-line*)) (difference screenheight (|fetch| (region height) |of| (windowprop *who-line* (quote region)))) screenheight))) anchor top-right shade (\\\, grayshade) interval 1000 filters ("{IE:PARC:XEROX}MEDLEY>SYSTEM.HASH" "{DSK1}SYSDIR" "{CORE}<*>ROLODEX.*" "{CORE}<*>*PHONE*.TXT"))))) (loadmenuitems "FileAids" (((sysload from lispusers) "FileWatch") (filewatch)))))) (declare\: donteval@load donteval@compile (rpaq? |FW-Properties| (bquote (font (gacha 8) all-files? nil position (\\\, (createposition screenwidth (cl:if (and (boundp (quote *who-line*)) (windowp *who-line*)) (difference screenheight (|fetch| (region height) |of| (windowprop *who-line* (quote region)))) screenheight))) anchor top-right shade (\\\, grayshade) interval 1000 filters ("{IE:PARC:XEROX}MEDLEY>SYSTEM.HASH" "{DSK1}SYSDIR" "{CORE}<*>ROLODEX.*" "{CORE}<*>*PHONE*.TXT")))) (|AddLoadMenuItem| (quote "FileAids") (quote ((sysload from lispusers) "FileWatch")) (quote (filewatch))) ) (rpaqq file-server-init-commands ((loadmenuitems "FileAids" (((sysload from lispusers) "NSProtection") (nsprotection))) (loadmenuitems "FileAids" (((sysload from lispusers) "ArchiveTool")) (((sysload from lispusers) "ArchiveBrowser")) (((sysload from lispusers) "NSAllocation"))))) (|AddLoadMenuItem| (quote "FileAids") (quote ((sysload from lispusers) "NSProtection")) (quote (nsprotection))) (|AddLoadMenuItem| (quote "FileAids") (quote ((sysload from lispusers) "ArchiveTool"))) (|AddLoadMenuItem| (quote "FileAids") (quote ((sysload from lispusers) "ArchiveBrowser"))) (|AddLoadMenuItem| (quote "FileAids") (quote ((sysload from lispusers) "NSAllocation"))) (rpaqq dirgrapher-init-commands ((initvars (dg.file-info-attributes fb.default.info) (dg.default-dir |\\UserHomeDirectory|) (dg.vertical-horizontal-option (quote horizontal)) (dg.background-directories (bquote ((\\\, dg.default-dir))))) (declare\: donteval@load donteval@compile (loadmenuitems "FileAids" (((sysload from lispusers) "DirGrapher")))))) (rpaq? dg.file-info-attributes fb.default.info) (rpaq? dg.default-dir |\\UserHomeDirectory|) (rpaq? dg.vertical-horizontal-option (quote horizontal)) (rpaq? dg.background-directories (bquote ((\\\, dg.default-dir)))) (declare\: donteval@load donteval@compile (|AddLoadMenuItem| (quote "FileAids") (quote ((sysload from lispusers) "DirGrapher"))) ) (rpaqq fb-init-commands ((declare\: donteval@load donteval@compile (vars (fb.default.info (quote (size creationdate)))) (loadmenuitems "FileAids" (((sysload from lispusers) "Resize-FileBrowser")))))) (declare\: donteval@load donteval@compile (rpaqq fb.default.info (size creationdate)) (|AddLoadMenuItem| (quote "FileAids") (quote ((sysload from lispusers) "Resize-FileBrowser"))) ) (rpaqq compare-files-init-commands ((loadmenuitems "FileAids" (((sysload from lispusers) "CompareDirectories")) (((sysload from lispusers) "CompareText")) (((sysload from lispusers) "CompareSources"))))) (|AddLoadMenuItem| (quote "FileAids") (quote ((sysload from lispusers) "CompareDirectories"))) (|AddLoadMenuItem| (quote "FileAids") (quote ((sysload from lispusers) "CompareText"))) (|AddLoadMenuItem| (quote "FileAids") (quote ((sysload from lispusers) "CompareSources"))) (* |;;| "Random stuff") (rpaqq unix-init-commands ((variables *unix-dir-stack*) (functions do-cd print-directory-stack) (commands "CD" "DIRS" "LS" "POPD" "PUSHD" "PWD") (p (if (eq (machinetype) (quote maiko)) then (|AddLoadMenuItem| nil "UnixChat"))) (loadmenuitems "FileAids" (((from "{fs8:}lisp>") "Grep"))))) (defglobalvar *unix-dir-stack* nil "The directory stack used in the exec commands PUSHD and friends.") (cl:defun do-cd (directory) (if (string-equal directory "..") then (let* ((current (directoryname t)) (parent (substring current 1 (strpos ">" current -2 nil nil nil nil t)))) (cndir parent)) else (cndir directory)) (directoryname t)) (cl:defun print-directory-stack nil (cl:format t "~%~A" (directoryname t)) (for dir in *unix-dir-stack* do (cl:format t " ~A" dir)) (cl:values)) (defcommand "CD" (&optional directory) "Connect to a directory" (do-cd directory) (setq *unix-dir-stack* nil) (cl:format t "~%~A" (directoryname t)) (cl:values)) (defcommand "DIRS" nil "Print out the directory stack used by PUSHD and friends." (print-directory-stack) (cl:values)) (defcommand "LS" (&optional (dirspec "*")) "List files matching the spec" (let ((filing.enumeration.depth 1)) (directory dirspec (quote (p)))) (cl:values)) (defcommand "POPD" (directory) "Connect to the previous directory" (if (null *unix-dir-stack*) then (cl:format t "~%popd: Directory stack empty.") else (do-cd (pop *unix-dir-stack*)) (print-directory-stack)) (cl:values)) (defcommand "PUSHD" (directory) "Connect to a directory, remember the current one on the directory stack." (cl:push (directoryname t) *unix-dir-stack*) (do-cd directory) (print-directory-stack) (cl:values)) (defcommand "PWD" nil "Print out the currently connected directory." (cl:format t "~%~A" (directoryname t)) (cl:values)) (if (eq (machinetype) (quote maiko)) then (|AddLoadMenuItem| nil "UnixChat")) (|AddLoadMenuItem| (quote "FileAids") (quote ((from "{fs8:}lisp>") "Grep"))) (rpaqq demos-init-commands ((initvars (|SlideFiles| (quote ("{piglet/n}ksa>Talks>*.Tedit;")))) (declare\: donteval@load donteval@compile (loadmenuitems "Demos" (((sysload from lispusers) "SlideProjector")) (((sysload from lispusers) "Magnifier")) (((sysload from lispusers) "Big")) (((load from "{piglet/n}ksa>") "Demo")))))) (rpaq? |SlideFiles| (quote ("{piglet/n}ksa>Talks>*.Tedit;"))) (declare\: donteval@load donteval@compile (|AddLoadMenuItem| (quote "Demos") (quote ((sysload from lispusers) "SlideProjector"))) (|AddLoadMenuItem| (quote "Demos") (quote ((sysload from lispusers) "Magnifier"))) (|AddLoadMenuItem| (quote "Demos") (quote ((sysload from lispusers) "Big"))) (|AddLoadMenuItem| (quote "Demos") (quote ((load from "{piglet/n}ksa>") "Demo"))) ) (rpaqq games-init-commands ((declare\: donteval@load donteval@compile (loadmenuitems "Games" (((from "{fs8:parc:xerox}Lisp>") "BlackBox")) (((from "{FS8:PARC:XEROX}Lisp>") "Go")) (((sysload from lispusers) "Qix") (add.process (quote (qix.grow)))) (((sysload from lispusers) "FaceInvader")) (((sysload from lispusers) "Donz")) (((sysload from lispusers) "Doctor")) (((sysload from lispusers) "Hanoi")) (((sysload from lispusers) "Life")) (((sysload from lispusers) "Solitare")) (((sysload from lispusers) "EyeCon") (eyecon.open)) (((sysload from "{FS8:PARC:XEROX}Lisp>") "RandomWord")))))) (declare\: donteval@load donteval@compile (|AddLoadMenuItem| (quote "Games") (quote ((from "{fs8:parc:xerox}Lisp>") "BlackBox"))) (|AddLoadMenuItem| (quote "Games") (quote ((from "{FS8:PARC:XEROX}Lisp>") "Go"))) (|AddLoadMenuItem| (quote "Games") (quote ((sysload from lispusers) "Qix")) (quote (add.process (quote (qix.grow))))) (|AddLoadMenuItem| (quote "Games") (quote ((sysload from lispusers) "FaceInvader"))) (|AddLoadMenuItem| (quote "Games") (quote ((sysload from lispusers) "Donz"))) (|AddLoadMenuItem| (quote "Games") (quote ((sysload from lispusers) "Doctor"))) (|AddLoadMenuItem| (quote "Games") (quote ((sysload from lispusers) "Hanoi"))) (|AddLoadMenuItem| (quote "Games") (quote ((sysload from lispusers) "Life"))) (|AddLoadMenuItem| (quote "Games") (quote ((sysload from lispusers) "Solitare"))) (|AddLoadMenuItem| (quote "Games") (quote ((sysload from lispusers) "EyeCon")) (quote (eyecon.open))) (|AddLoadMenuItem| (quote "Games") (quote ((sysload from "{FS8:PARC:XEROX}Lisp>") "RandomWord"))) ) (* |;;| "Cleanup") (rpaqq background-menu-cleanup-init-commands ((functions move-background-item-under) (declare\: donteval@load donteval@compile (p (eval-at-greet (move-background-item-under "Hardcopy" "Snap") (move-background-item-under "ArchiveTool" "FileBrowser") (/nconc1 |BackgroundMenuCommands| (bquote ("LOGOUT & Power-Off" (quote (and (mouseconfirm "Really (LOGOUT)?") (|GoodNight|))) "Logout of LISP" (subitems ("LOGOUT T & Power-Off" (quote (and (mouseconfirm "Really (LOGOUT T)?") (|GoodNight| t))) "Logout without saving VMem") (\\\,@ (if (eq (machinetype) (quote maiko)) then (quote (("Suspend" (quote (suspend-lisp)) "Suspend the running lisp and return to UNIX"))))))))) (or (for item in |BackgroundMenuCommands| thereis (string-equal "System" (car item))) (/nconc1 |BackgroundMenuCommands| (list "System" nil nil (list (quote subitems))))) (for label in (quote ("SaveVM" "Idle" "AR Edit" "DumpCache" "Set Directories" "LOGOUT & Power-Off" "Reset NFS")) do (move-background-item-under label "System")))) (vars (|BackgroundMenu| nil))))) (cl:defun move-background-item-under (label-to-move parent-label) (let ((item-to-move (for item in |BackgroundMenuCommands| thereis (string-equal label-to-move (car item)))) (parent-item (for item in |BackgroundMenuCommands| thereis (string-equal parent-label (car item))))) (cond ((or (null parent-item) (null item-to-move)) nil) ((null (cdddr parent-item)) (* \; "No subitems yet") (/nconc1 parent-item (bquote (subitems (\\\, item-to-move)))) (/dremove item-to-move |BackgroundMenuCommands|)) (t (* \; "Already has subitems ") (/nconc1 (cadddr parent-item) item-to-move) (/dremove item-to-move |BackgroundMenuCommands|))))) (declare\: donteval@load donteval@compile (eval-at-greet (move-background-item-under "Hardcopy" "Snap") (move-background-item-under "ArchiveTool" "FileBrowser") (/nconc1 |BackgroundMenuCommands| (bquote ("LOGOUT & Power-Off" (quote (and (mouseconfirm "Really (LOGOUT)?") (|GoodNight|))) "Logout of LISP" (subitems ("LOGOUT T & Power-Off" (quote (and (mouseconfirm "Really (LOGOUT T)?") (|GoodNight| t))) "Logout without saving VMem") (\\\,@ (if (eq (machinetype) (quote maiko)) then (quote (("Suspend" (quote (suspend-lisp)) "Suspend the running lisp and return to UNIX"))))))))) (or (for item in |BackgroundMenuCommands| thereis (string-equal "System" (car item))) (/nconc1 |BackgroundMenuCommands| (list "System" nil nil (list (quote subitems))))) (for label in (quote ("SaveVM" "Idle" "AR Edit" "DumpCache" "Set Directories" "LOGOUT & Power-Off" "Reset NFS")) do (move-background-item-under label "System"))) (rpaqq |BackgroundMenu| nil) ) (rpaqq do-load-utilities-init-commands ((initvars *load-utility-options* nil) (p (eval-at-greet (cl:unless *vanilla-init-loaded* (cl:mapc (cl:function (cl:lambda (utility) (|PickLoadUtilityItem| utility nil t))) *load-utility-options*)))))) (rpaq? *load-utility-options* nil) (rpaq? nil nil) (eval-at-greet (cl:unless *vanilla-init-loaded* (cl:mapc (cl:function (cl:lambda (utility) (|PickLoadUtilityItem| utility nil t))) *load-utility-options*))) (* |;;| "Send the Tool Work's a message telling it about this user.") (cl:defun log-vanilla-init-user nil (let ((me "Lanning") (user (cl:if \\cc-generic-init-msg (username) ""))) (cond ((string-equal user me) nil) ((not (cl:fboundp (quote lafite.sendmessage))) nil) (t (lafite.sendmessage (cl:format nil "Subject: ~A~%To: ~A.pa~%Cc: ~A~@{~%~%~A~}" "Vanilla-Init" me user "This is to let you know that I am using Vanilla-Init (again)." "Thanks for making it available.")))))) (rpaq? \\cc-generic-init-msg t) (eval-at-greet (cl:unless *vanilla-init-loaded* (log-vanilla-init-user))) (rpaq *load-verbose* \\original-load-verbose) (rpaq prettyheader \\original-prettyheader) (rpaqq *vanilla-init-loaded* t) (* |;;| "Make the FileManager happy") (declare\: dontcopy (putprops vanilla-init makefile-environment (:package "IL" :readtable "XCL" :base 10)) ) (putprops vanilla-init copyright ("Xerox Corporation" 1988 1989)) (declare\: dontcopy (filemap (nil (41150 41759 (|DebugMode| 41160 . 41757)) (41760 42392 (selectw 41770 . 42390)) (43764 46483 (|PrintDocFile| 43774 . 46481)) (46484 46819 (|\\Pick-One-At-Random| 46494 . 46817)) (46951 47620 (|GoodNight| 46961 . 47286) (|NewLisp| 47288 . 47618)) (47621 51024 (|RememberLastPartition| 47631 . 49007) (|RememberLispState| 49009 . 51022))))) stop