;;; -*- Mode: Common-Lisp; Package: Zwei; Base: 10.; Patch-File: T -*- ;;; Reason: Modified PRELOAD-MAIL-FILE to used the directory component of zwei:*user-default-mail-file* to ;;; determine the user-id and local bind this user-id to load mail file. If zwei:*user-default-mail-file* is ;;; nil and MAIL:*PRELOAD-MAIL-FILE-P* is T the user will be forced to login before proceeding. [9797] ;;; RESTRICTED RIGHTS LEGEND ;;; ;;; Use, duplication, or disclosure by the Government is subject to ;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in ;;; Technical Data and Computer Software clause at 52.227-7013. ;;; ;;; TEXAS INSTRUMENTS INCORPORATED ;;; P.O. BOX 2909, M/S 2151 ;;; AUSTIN, TEXAS 78769 ;;; ;;; Copyright (C) 1989 Texas Instruments Incorporated. ;;; All rights reserved. ;;; Patch file for MAIL-READER version 6.5 ;;; Written 10/04/89 14:50:29 by BERGER, ;;; while running on ARIES from band LODX ;;; With SYSTEM 6.17, VIRTUAL-MEMORY 6.2, EH 6.5, MAKE-SYSTEM 6.1, MICRONET 6.0, LOCAL-FILE 6.1, ;;; BASIC-PATHNAME 6.1, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.2, NETWORK-NAMESPACE 6.0, ;;; DISK-IO 6.1, DISK-LABEL 6.0, BASIC-FILE 6.3, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0, ;;; COMPILER 6.12, TV 6.15, DATALINK 6.0, CHAOSNET 6.1, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.1, ;;; SYSLOG 6.1, STREAMER-TAPE 6.4, UCL 6.0, INPUT-EDITOR 6.0, METER 6.1, ZWEI 6.5, ;;; DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.1, DATALINK-DISPLAYS 6.0, ;;; FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.3, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.1, ;;; IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.2, TELNET 6.0, VT100 6.0, ;;; NAMESPACE-EDITOR 6.0, PROFILE 6.1, VISIDOC 6.4, TI-CLOS 6.24, CLEH 6.5, IP 3.50, ;;; Experimental CLX 6.3, CLUE 6.17, X11M 6.14, Experimental BUG 11.15, VISIDOC-SERVER 6.1, ;;; microcode 429, Band Name: Rel 6.0 + SLE 8/30 #!C ; From file definitions.LISP#> MAIL-READER; Hotel: #10R ZWEI#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "ZWEI")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: MAIL-READER; definitions.#" (defun preload-mail-file (&optional mail-files) "In background load mail files into a buffer for use by the mail reader" (process-run-function '(:name "Preload mail file" :priority -20) #'(lambda () (let ((*mail-background-p* t)) ;;DAB 10-05-89 Use the first directory component of default pathname unless NIL. (let-if (and (OR (NULL USER-ID) (STRING-EQUAL USER-ID "")) zwei:*user-default-mail-file*) ((user-id (car (send (pathname zwei:*user-default-mail-file*) :directory)))) ;;DAB 10-05-89 If default is NIL and user has not login, get him to now. (process-wait "Waiting for Login" #'(lambda (timeout) (let ((timeout2 (time-increment (time) timeout))) (or (and user-id (not (string-equal user-id "")) (not (string-equal user-id "File Server")) (not (string-equal user-id "system"))) (TIME-lessp timeout2 (time))))) (* 60 60 5)) (fs:force-user-to-login) ;; Setup default. (unless mail-files (setf mail-files (default-mail-file))) ;; Force it into a list (if (not (listp mail-files)) (setf mail-files (list mail-files))) (dolist (mail-file mail-files) (load-mail-file mail-file t))))))) )) #!C ; From file file.LISP#> MAIL-READER; sys: #10R ZWEI#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "ZWEI")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: MAIL-READER; file.#" (defun REVERT-MAIL-FILE-BUFFER (buffer &optional (pathname (buffer-pathname buffer)) (connect-p (buffer-file-id buffer)) select-p quietly-p) "Read mail file file PATHNAME, or BUFFER's visited file into BUFFER. BUFFER must be a flavor of type MAIL-FILE-BUFFER. CONNECT-P non-NIL means mark BUFFER as visiting the file. This may change the buffer's name. It defaults non-NIL if BUFFER is visiting a file now. SELECT-P is ignored at this time (i.e. *find-file-early-select* is yet supported) QUIETLY-P means do not print a message about reading a file." (declare (ignore select-p)) (let ((seq (message-sequence-of buffer))) (when (and (not (mail-file-buffer-p seq)) (get seq :filters-used)) (return-from revert-mail-file-buffer (revert-filter-buffer buffer)))) (setq buffer (mail-file-buffer-of buffer)) (unless (or (buffer-file-id buffer) pathname) (barf "The buffer ~A is not associated with a file and no pathname provided." (buffer-name buffer))) (let* ((*mail-prev-line* nil) (*undo-save-small-changes* nil) (new-buffer-p (null (buffer-file-id buffer))) (kill-buffer-on-error-p new-buffer-p) success pathname-string format) (declare (special *mail-prev-line*)) (unwind-protect (block reading-file (with-buffer-lock (buffer) (with-read-only-suppressed (buffer) (multiple-value-setq (pathname pathname-string) (editor-file-name pathname)) (cond (connect-p (setf (buffer-name buffer) pathname-string) (setf (buffer-pathname buffer) pathname) (setf (buffer-generic-pathname buffer) (send pathname :generic-pathname)))) ;; Open mail file (with-open-file-case (stream pathname) (fs:file-not-found ;; If old buffer, the associated mail file has disappeared! (when (not new-buffer-p) (utter nil "~&~A no longer exists!~%Suggest you save this buffer immediately." pathname) (return-from reading-file)) (cond ((y-or-n-p "~&Mail file ~a not found, create it?" pathname) (setup-new-mail-file buffer pathname) (not-modified buffer)) (t (return-from reading-file)))) ;; Open succeeded -- determine format and read it in. (:no-error (setq format (get-mail-file-format-from-stream stream)) (cond ((eq format :empty) (utter nil "~A is an empty file" (send pathname :truename))) (t (setf (buffer-mail-file-format buffer) format) (or quietly-p *mail-background-p* (format *query-io* "~&Reading mail in ~A~%" (send pathname :truename))) ;; if error occurs now, don't leave trashed or partial buffers around. (setf kill-buffer-on-error-p t) ;;? if not new buffer, should preserve point (clear-mail-file-buffer buffer) (when (mail-summary-of buffer) (send (mail-summary-of buffer) :kill)) (send buffer :read-mail-file (buffer-mail-file-format buffer) stream))) (setf (buffer-tick buffer) (tick)) (setf (buffer-file-read-tick buffer) *tick*) (when connect-p (set-buffer-file-id buffer (send stream :info))) (not-modified buffer))) ;; Buffer is now in a reasonably sane state, don't kill on error (setf success t) (setf kill-buffer-on-error-p nil) ;; Add probes to find new mail for this mail file. (when mail:*probe-for-new-mail-p* (dolist (inbox-pathname (get-mail-option buffer :mail)) (unless (stringp inbox-pathname) (mail:add-mail-inbox-probe inbox-pathname)))))) buffer) ;; Cleanup forms for unwind-protect (cond ((and (not success) kill-buffer-on-error-p (not *debug-mail-reader*)) ;; Must be sure another buffer is selected before :kill because ZMACS now nukes buffers upon killing (let ((old-buffer (and (boundp '*interval*) (eq *interval* buffer) (previous-buffer buffer)))) (when old-buffer (send old-buffer :select)) (send buffer :kill)) nil) (t buffer))))) ))