LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032945. :SYSTEM-TYPE :LOGICAL :VERSION 3. :TYPE "LISP" :NAME "BDIRED" :DIRECTORY ("REL3-PUBLIC" "PUBLIC" "ZMACS") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-PUBLIC\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2753277725. :AUTHOR "REL3" :LENGTH-IN-BYTES 15311. :LENGTH-IN-BLOCKS 15. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         ;;;  -*- Mode:Common-Lisp; Package:ZWEI; Base:8 -*-;;; Copyright (C) 1986, Texas Instruments Incorporated. All rights reserved.;;;                           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, Texas Instruments Incorporated. All rights reserved.;;;;;;  The commands in this file are not supported by TI.  They do work,;;;  at least sometimes.  We are likely to release and support these commands;;;  in the future.; Copyright (C) 1980, Massachusetts Institute of Technology; Copyright (C) 1984, Texas Instruments Incorporated. All rights reserved.;;;; BDIRED Lines(DEFSUBST BDIRED-CURRENT-LINE (STREAM)  (BP-LINE (SEND STREAM :READ-BP))) (DEFSUBST BDIRED-PREVIOUS-LINE (STREAM)  (LINE-PREVIOUS (BDIRED-CURRENT-LINE STREAM))) (DEFSUBST BDIRED-NEXT-LINE (STREAM)  (LINE-NEXT (BDIRED-CURRENT-LINE STREAM))) (DEFSUBST PUT-LINE (LINE ITEM KEY)  (SETF (GETF (LINE-PLIST LINE) KEY) ITEM)) (DEFSUBST GET-LINE (LINE KEY)  (GETF (LINE-PLIST LINE) KEY)) (DEFUN BDIRED-DELETE-LINE (FIRST-LINE &OPTIONAL LAST-LINE)  (IF (NULL LAST-LINE)      (SETQ LAST-LINE FIRST-LINE))  (WITH-READ-ONLY-SUPPRESSED (*INTERVAL*)    (DELETE-INTERVAL (BEG-LINE (CREATE-BP FIRST-LINE 0) 0)     (BEG-LINE (CREATE-BP LAST-LINE 0) 1)     T))) ;;; Line CFILE.(DEFUN BDIRED-LIST-CFILE (CFILE STREAM)  (FUNCALL *DIRECTORY-SINGLE-FILE-LISTER* CFILE STREAM)  (LET ((LINE (BDIRED-PREVIOUS-LINE STREAM)))    (SETF (LINE-PLIST LINE) (CONS :PATHNAME CFILE))    LINE)) (DEFSUBST BDIRED-LINE-CFILE (LINE)  (CDR (GETL (LOCF (LINE-PLIST LINE)) '(:PATHNAME)))) ;;;; BDIRED Buffers;(DEFSUBST BDIRED-ALTERNATE-PATHNAME (BUFFER);  (FOURTH (BUFFER-FILE-ID BUFFER)))(DEFSUBST BDIRED-ALTERNATE-PATHNAME (BUFFER)  (GETF (NODE-PROPERTY-LIST BUFFER) :ALTERNATE-PATHNAME)) (DEFSUBST UPDATE-BDIRED-BUFFER-PATHNAMES (BUFFER PATHNAME1 PATHNAME2)  (SETF (BUFFER-PATHNAME BUFFER) PATHNAME1)  (SETF (BDIRED-ALTERNATE-PATHNAME BUFFER) PATHNAME2)) (DEFUN FIND-OR-CREATE-BDIRED-BUFFER (PATHNAME1 PATHNAME2)  (LET ((BUFFER (SEND SELF :FIND-SPECIAL-BUFFER :BDIRED T "BDired")))    (IF (NULL BUFFER)(ERROR "Cannot find BDIRED buffer"))    (UPDATE-BDIRED-BUFFER-PATHNAMES BUFFER PATHNAME1 PATHNAME2)    BUFFER)) ;;;; Pathname Stuff(DEFUN BDIRED-READ-DIRECTORY-STRING (PROMPT PATHNAME)  (LET ((*READING-PATHNAME-DEFAULTS* PATHNAME)(*READING-PATHNAME-SPECIAL-TYPE* (PATHNAME-TYPE PATHNAME))(*READING-PATHNAME-SPECIAL-VERSION* (PATHNAME-VERSION PATHNAME))(*READING-PATHNAME-DIRECTION* :READ))    (MULTIPLE-VALUE-BIND (NIL NIL INTERVAL)(EDIT-IN-MINI-BUFFER *PATHNAME-READING-COMTAB* NIL NIL     (LIST (FORMAT NIL "~A (Default is ~A)" PROMPT PATHNAME)   '(:RIGHT-FLUSH " (Completion)")))      (STRING-INTERVAL INTERVAL)))) (DEFUN BDIRED-READ-DIRECTORY-NAME (PROMPT PATHNAME)  (LET ((INTERVAL (BDIRED-READ-DIRECTORY-STRING PROMPT PATHNAME)))    (COND ((EQUAL INTERVAL "")   PATHNAME)  (T   (FS:MERGE-PATHNAME-DEFAULTS INTERVAL PATHNAME NIL NIL))))) ;;;; Top Level(DEFVAR *BDIRED-PATHNAME1-NAME* :UNBOUND "Pathname of active BDIRED buffer") (DEFVAR *BDIRED-PATHNAME2-NAME* :UNBOUND "Alternate pathname of active BDIRED buffer") (DEFMAJOR COM-BDIRED-MODE BDIRED-MODE "BDired" "Setup for editing directory differences" ()  (PROGN;Due to ZWEI inversion lossage.    (IF (TYPEP *INTERVAL* 'FILE-BUFFER)(LET ((PATHNAME1 (BUFFER-PATHNAME *INTERVAL*))      (PATHNAME2 (BDIRED-ALTERNATE-PATHNAME *INTERVAL*)))  (IF (NOT (NULL PATHNAME1))      (SETQ *BDIRED-PATHNAME1-NAME* (STRING PATHNAME1)))  (IF (NOT (NULL PATHNAME2))      (SETQ *BDIRED-PATHNAME2-NAME* (STRING PATHNAME2))))))  (SET-COMTAB *MODE-COMTAB*      '(#\SPACE COM-DOWN-REAL-LINE#\= COM-DIRED-SRCCOM#\? COM-BDIRED-DOCUMENTATION#\HELP COM-BDIRED-DOCUMENTATION#\C COM-DIRED-COPY#\c (0 #\C)#\I COM-BDIRED-RESOLVE-INCONSISTENCY#\i (0 #\I)#\Q COM-BDIRED-EXIT#\q (0 #\Q)#\R COM-DIRED-RENAME#\r (0 #\R)#\T COM-BDIRED-TRANSFER#\t (0 #\T)#\U COM-BDIRED-UNDELETE#\u (0 #\U)#\V COM-DIRED-VIEW-FILE#\v (0 #\V)#\RUBOUT COM-DIRED-REVERSE-UNDELETE#\ABORT COM-BDIRED-ABORT#\END COM-BDIRED-EXIT)      '())  (SETQ *MODE-LINE-LIST*(APPEND *MODE-LINE-LIST*'("  " *BDIRED-PATHNAME1-NAME*  "  " *BDIRED-PATHNAME2-NAME*  "  (Q to exit)")))) (DEFUN (:PROPERTY BDIRED-MODE PATHNAME-DEFAULTING-FUNCTION) (IGNORE BUFFER)  (AND (EQ BUFFER *INTERVAL*)       (DONT-OPTIMIZE (DIRED-LINE-PATHNAME (BP-LINE (POINT)))))) (DEFCOM COM-BDIRED "Edit the differences between two directories.This command is not currently supported by TI, but it works in most situations." ()  (KILL-NEW-BUFFER-ON-ABORT (*INTERVAL*)    (LET* ((DEFAULT (SEND (DEFAULT-PATHNAME) :NEW-PATHNAME  :NAME NIL  :TYPE NIL  :VERSION NIL))   (PATHNAME1 (BDIRED-READ-DIRECTORY-NAME "Balance directory" DEFAULT)))      (BDIRECTORY-EDIT PATHNAME1       (BDIRED-READ-DIRECTORY-NAME (FORMAT NIL "Balance directory ~A with directory" PATHNAME1) PATHNAME1))))) (DEFUN BDIRECTORY-EDIT (PATHNAME1 PATHNAME2)  "Enter the balance directories editor on directories PATHNAME1 and PATHNAME2.In ZMACS, this creates a BDIRED buffer and reads the differences into it,making it the current buffer."  (LET ((*INTERVAL* (FIND-OR-CREATE-BDIRED-BUFFER PATHNAME1 PATHNAME2)))    (MAKE-BUFFER-READ-ONLY *INTERVAL*)    (COM-BDIRED-MODE)    (BDIRED-INITIALIZE-BUFFER *INTERVAL* PATHNAME1 PATHNAME2)    DIS-TEXT)) ;;;; BDIRED Buffer Initialization(DEFPROP BDIRED-MODE BDIRECTORY-EDIT-REVERT MAJOR-MODE-REVERT-FUNCTION) (DEFUN BDIRECTORY-EDIT-REVERT (BUFFER PATHNAME &OPTIONAL IGNORE SELECT-FLAG)  "Revert a BDIRED buffer."  (BDIRED-INITIALIZE-BUFFER BUFFER    PATHNAME    (BDIRED-ALTERNATE-PATHNAME BUFFER)    SELECT-FLAG)) (DEFUN BDIRED-INITIALIZE-BUFFER (BUFFER PATHNAME1 PATHNAME2 &OPTIONAL SELECT-FLAG)  "Initialize a BDIRED buffer."  (WITH-READ-ONLY-SUPPRESSED (BUFFER)    (LET ((*BATCH-UNDO-SAVE* T)  (SELECTED-P (EQ BUFFER *INTERVAL*))  (*INTERVAL* BUFFER)  (DIR1 (FS::CREATE-CDIRECTORY PATHNAME1 '() T))  (DIR2 (FS::CREATE-CDIRECTORY PATHNAME2 '() T)))      ;; What directories did we ultimately read?  Maybe the user corrected an error.      (SETQ PATHNAME1 (FS::CDIRECTORY-PATHNAME DIR1))      (SETQ PATHNAME2 (FS::CDIRECTORY-PATHNAME DIR2))      (UPDATE-BDIRED-BUFFER-PATHNAMES BUFFER PATHNAME1 PATHNAME2)      (FS::COMPARE-CDIRECTORIES DIR1 DIR2)      (DELETE-INTERVAL BUFFER)      (DISCARD-UNDO-INFORMATION BUFFER)      (IF SELECTED-P  (SETQ *BDIRED-PATHNAME1-NAME* (SEND PATHNAME1 :STRING-FOR-PRINTING)*BDIRED-PATHNAME2-NAME* (SEND PATHNAME2 :STRING-FOR-PRINTING)))      (LET ((STREAM (INTERVAL-STREAM-INTO-BP (INTERVAL-FIRST-BP BUFFER))))(BDIRED-INSERT-DIRECTORY DIR1 STREAM DIR2)(WRITE-CHAR #\NEWLINE STREAM)(BDIRED-INSERT-DIRECTORY DIR2 STREAM DIR1))      (LET ((FIRST-LINE (BP-LINE (INTERVAL-FIRST-BP BUFFER))))(PUT-LINE FIRST-LINE DIR1 'CDIRECTORY1)(PUT-LINE FIRST-LINE DIR2 'CDIRECTORY2)))    (BDIRED-MARK-INITIAL-TRANSFERS))  (IF SELECT-FLAG      (MAKE-BUFFER-CURRENT BUFFER))) (DEFUN BDIRED-INSERT-DIRECTORY (DIRECTORY STREAM ALTERNATE-DIRECTORY)  (LET ((DIRLIST (FS::CDIRECTORY-LIST DIRECTORY))(PATHNAME (FS::CDIRECTORY-PATHNAME DIRECTORY)))    (DOLIST (CFILE (CDR DIRLIST))      (SETF (GET (FS::CFILE-PLIST CFILE) 'ALTERNATE-DIRECTORY) ALTERNATE-DIRECTORY))    (SEND STREAM :STRING-OUT (SEND PATHNAME :STRING-FOR-PRINTING))    (SEND STREAM :LINE-PUT :DIRECTORY PATHNAME)    (SEND STREAM :TYO #\NEWLINE)    (SEND *DIRECTORY-SINGLE-FILE-LISTER* (CAR DIRLIST) STREAM)    (DIRED-INSERT-DIRECTORY DIRLIST STREAM 0))) ;;;; Commands(DEFCOM COM-BDIRED-EXIT "Exit from BDIRED, performing transfers that you have selected.This command is not currently supported by TI, but it works in most situations." ()  (IF (BDIRED-PROCESS-FILES)      (SEND SELF :EXIT-SPECIAL-BUFFER T *INTERVAL*))  DIS-BPS) (DEFCOM COM-BDIRED-ABORT "Exit BDIRED, not transferring any files.This command is not currently supported by TI, but it works in most situations." ()  (SEND SELF :EXIT-SPECIAL-BUFFER T *INTERVAL*)  DIS-BPS) (DEFUN BDIRED-MAP-OVER-ALL-LINES (FUN)  (DO ((LINE (BP-LINE (INTERVAL-FIRST-BP *INTERVAL*)) (LINE-NEXT LINE))       (LAST-LINE (BP-LINE (INTERVAL-LAST-BP *INTERVAL*))))      ((EQ LINE LAST-LINE))    (FUNCALL FUN LINE))) (DEFUN BDIRED-MARK-INITIAL-TRANSFERS ()  (BDIRED-MAP-OVER-ALL-LINES (FUNCTION BDIRED-MARK-INITIAL-TRANSFER))) (DEFUN BDIRED-MARK-INITIAL-TRANSFER (LINE)  (COND ((NOT (NULL (FS::CFILE-TRANSFER-DESTINATIONS (BDIRED-LINE-CFILE LINE)))) (MUNG-LINE LINE) (SETF (AREF LINE 0) #\T)))) (DEFUN BDIRED-MARK-TRANSFER (CFILE)  (FS::MARK-CFILE-FOR-TRANSFER    CFILE    (GET (FS::CFILE-PLIST CFILE) 'ALTERNATE-DIRECTORY))) (DEFUN BDIRED-UNMARK-TRANSFER (CFILE)  (IF (NOT (NULL (FS::CFILE-TRANSFER-DESTINATIONS CFILE)))      (SETF (FS::CFILE-TRANSFER-DESTINATIONS CFILE) '()))) (DEFUN BDIRED-PROCESS-FILES ()  (LET* ((*TERMINAL-IO* *TYPEIN-WINDOW*) (FIRST-LINE (BP-LINE (INTERVAL-FIRST-BP *INTERVAL*))) (DIR1 (GET-LINE FIRST-LINE 'CDIRECTORY1)) (DIR2 (GET-LINE FIRST-LINE 'CDIRECTORY2)))    (FS::SETUP-CDIRECTORY-TRANSFER-MODE DIR1)    (FS::SETUP-CDIRECTORY-TRANSFER-MODE DIR2)    (FS::CDIRECTORY-TRANSFER DIR1)    (FS::CDIRECTORY-TRANSFER DIR2))  T) (DEFCOM COM-BDIRED-TRANSFER "Mark file(s) for transfer.This command is not currently supported by TI, but it works in most situations." ()  (DIRED-MAP-OVER-LINES *NUMERIC-ARG*#'(LAMBDA (LINE)    (MUNG-LINE LINE)    (SETF (AREF LINE 0) #\T)    (BDIRED-MARK-TRANSFER (BDIRED-LINE-CFILE LINE))))) (DEFCOM COM-BDIRED-UNDELETE "Un-mark file(s) for transfer.Also cancels any other operation requested on the file.This command is not currently supported by TI, but it works in most situations." ()  (DIRED-MAP-OVER-LINES    (IF (AND (NOT *NUMERIC-ARG-P*)     (OR (NOT (DIRED-LINE-PATHNAME (BP-LINE (POINT)))) (CHAR-EQUAL (BP-CHAR (BEG-LINE (POINT))) #\SPACE)))-1*NUMERIC-ARG*)    #'(LAMBDA (LINE)(MUNG-LINE LINE)(SETF (AREF LINE 0) #\SPACE)(BDIRED-UNMARK-TRANSFER (BDIRED-LINE-CFILE LINE))))) (COMMENT;may want some of this later. ;;; An Inconsistency consists of two Cfiles and ;;; a group of consecutive Lines in a Buffer. (DEFSTRUCT (INCONSISTENCY      (:TYPE :NAMED-ARRAY)      :CONC-NAME)   CFILE1   CFILE2   FIRST-LINE   LAST-LINE)  (DEFUN BDIRED-INSERT-INCONSISTENCY (CFILE1 CFILE2 STREAM)   (LET* ((LINE1 (BDIRED-LIST-CFILE CFILE1 STREAM))  (LINE2 (BDIRED-LIST-CFILE CFILE2 STREAM))  (LINE3 (PROGN (WRITE-CHAR #\NEWLINE STREAM)(BDIRED-PREVIOUS-LINE STREAM)))  (INCONSISTENCY (MAKE-INCONSISTENCY FIRST-LINE LINE1     LAST-LINE LINE3     CFILE1 CFILE1     CFILE2 CFILE2)))     (PUT-LINE LINE1 INCONSISTENCY 'BDIRED-INCONSISTENCY)     (PUT-LINE LINE2 INCONSISTENCY 'BDIRED-INCONSISTENCY)     (PUT-LINE LINE3 INCONSISTENCY 'BDIRED-INCONSISTENCY)     LINE1))  (DEFSUBST BDIRED-DELETE-INCONSISTENCY (INCONSISTENCY)   (BDIRED-DELETE-LINE (INCONSISTENCY-FIRST-LINE INCONSISTENCY)       (INCONSISTENCY-LAST-LINE INCONSISTENCY)))  (DEFSUBST RELATED-INCONSISTENCY (LINE)   (GET-LINE LINE 'BDIRED-INCONSISTENCY))  (DEFUN INCONSISTENCY-RELATED-CFILE (INCONSISTENCY CFILE)   (COND ((EQ CFILE (INCONSISTENCY-CFILE1 INCONSISTENCY))  (INCONSISTENCY-CFILE2 INCONSISTENCY)) ((EQ CFILE (INCONSISTENCY-CFILE2 INCONSISTENCY))  (INCONSISTENCY-CFILE1 INCONSISTENCY)) (T  (ERROR "Cfile not element of Inconsistency" (LIST CFILE INCONSISTENCY)))))  (DEFCOM COM-BDIRED-RESOLVE-INCONSISTENCY "Alter the other file's version/creation date.When pointing at one file of an inconsistency, alters the version/creation-dateinformation of the other file to match this file.This command is not currently supported by TI, but it works in most situations." ()   (LET* ((LINE (BP-LINE (POINT)))  (CORRECT-CFILE (BDIRED-LINE-CFILE LINE))  (INCONSISTENCY (OR (RELATED-INCONSISTENCY LINE)     (BARF "Not an inconsistency")))  (INCORRECT-CFILE (INCONSISTENCY-RELATED-CFILE INCONSISTENCY CORRECT-CFILE))  (V1 (FS::CFILE-VERSION CORRECT-CFILE))  (V2 (FS::CFILE-VERSION INCORRECT-CFILE))  (CD1 (FS::CFILE-CREATION-DATE CORRECT-CFILE))  (CD2 (FS::CFILE-CREATION-DATE INCORRECT-CFILE))  (TRUENAME (FS::CFILE-TRUENAME INCORRECT-CFILE)))     (COND ((AND (= V1 V2) (/= CD1 CD2))    (BDIRED-CHANGE-CREATION-DATE TRUENAME CD1))   ((= CD1 CD2)    (BDIRED-CHANGE-VERSION TRUENAME V1))   ((/= CD1 CD2)    (BDIRED-CHANGE-VERSION-AND-CREATION-DATE TRUENAME V1 CD1)))     (BDIRED-DELETE-INCONSISTENCY INCONSISTENCY))   DIS-TEXT)  (DEFUN BDIRED-CHANGE-CREATION-DATE (TRUENAME DATE)   (WITH-OPEN-FILE (STREAM TRUENAME :DIRECTION :INPUT)     (SEND STREAM :CHANGE-PROPERTIES NIL :CREATION-DATE DATE))   (FORMAT *QUERY-IO*   "~&Creation date of ~A changed to ~A"   TRUENAME   (TIME:PRINT-UNIVERSAL-TIME DATE NIL)))  (DEFUN BDIRED-CHANGE-VERSION (TRUENAME VERSION)   (LET ((NEWNAME (SEND TRUENAME :NEW-VERSION VERSION)))     (WITH-OPEN-FILE (STREAM TRUENAME :DIRECTION :INPUT)       (SEND STREAM ':RENAME NEWNAME))     (FORMAT *QUERY-IO* "~&~A renamed to ~A" TRUENAME NEWNAME)))  (DEFUN BDIRED-CHANGE-VERSION-AND-CREATION-DATE (TRUENAME VERSION DATE)   (LET ((NEWNAME (SEND TRUENAME :NEW-VERSION VERSION)))     (WITH-OPEN-FILE (STREAM TRUENAME :DIRECTION :INPUT)       (SEND STREAM :RENAME NEWNAME)       (SEND STREAM :CHANGE-PROPERTIES NIL :CREATION-DATE DATE))     (FORMAT *QUERY-IO*     "~&~A renamed to ~A;~%creation date changed to ~A"     TRUENAME     NEWNAME     (TIME:PRINT-UNIVERSAL-TIME DATE NIL))))) ;;;; Documentation(DEFCOM COM-BDIRED-DOCUMENTATION "Print various sorts of editor documentation.This command is not currently supported by TI, but it works in most situations." ()  (LET ((*COM-DOCUMENTATION-ALIST* (CONS '(#\M COM-BDIRED-HELP) *COM-DOCUMENTATION-ALIST*)))    (COM-DOCUMENTATION))) (DEFCOM COM-BDIRED-HELP "Explain use of BDIRED commands.This command is not currently supported by TI, but it works in most situations." ()  (FORMAT T  "You are in the balance directories editor.  The commands are:TMark the current file to be transferred.PPrint the current file on the standard hardcopy device.UUndelete the current file, or else the file just above the cursor.Also used to cancel a Print request.RRename this file.  You type the new filename in a mini buffer.CCopy this file.  You type the new filename in a mini buffer.RuboutUndelete file above the cursor.SpaceMove to the next line.  Above commands repeat with a numeric argument,  backwards if the argument is negative.  Q (or END)  Exit.  The remaining files in the transfer lists will be moved.ABORTExit without performing any transfers.=SRCCOM this file with the > version.")  DIS-NONE) efprint sharp-dot  (si:pprint-handler pp-objify-s