;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*- ;;; Patch file for System version 124.111 ;;; Reason: ;;; More tag table housekeeping and fixes. ;;; ;;; Make ZWEI:TAGS-SEARCH-SYSTEM-POSSIBILITY a good citizen with other ;;; tag table launchers. Tag table names in *ZMACS-TAG-TABLE-ALIST* ;;; really, truly have to be strings. I taught various functions to respect ;;; this. Now, agreeing to search through the microcode for a function source ;;; won't kill off other tag table utilities. ;;; Written 26-Jun-88 11:24:12 by keith (Keith Corbett) at site Gigamos Cambridge ;;; while running on Breaking Glass from band 2 ;;; with Experimental System 124.110, Experimental Local-File 74.3, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.1, Experimental Tape 23.6, Experimental Lambda-Diag 16.2, Tiger 28.0, microcode 1761, SDU Boot Tape 3.14, SDU ROM 103, Beta 3 plus patches. ; From modified file DJ: L.ZWEI; POSS.LISP#104 at 26-Jun-88 11:25:08 #10R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; POSS  " (DEFUN TAGS-SEARCH-SYSTEM-POSSIBILITY (BP SYSTEM &REST OBJECTS &aux system-name) (DECLARE (IGNORE BP)) (setq system-name (etypecase system (si:system (si:system-name system)) ((or string symbol) (string system)))) (SELECT-FILE-LIST-AS-TAG-TABLE (SI::SYSTEM-SOURCE-FILES SYSTEM) system-name) (APPLY #'TAGS-SEARCH-ALTERNATIVE-STRINGS OBJECTS)) )) ; From modified file DJ: L.ZWEI; SECTIO.LISP#305 at 26-Jun-88 11:25:17 #8R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; SECTIO  " (DEFUN SELECT-FILE-LIST-AS-TAG-TABLE (FILE-LIST NAME) "Select a tag table named NAME consisting of the files in FILE-LIST. This can be used to control commands such as Tags Search." (setq name (string name)) (let ((elt (cdr (ass #'string-equal name *zmacs-tag-table-alist*)))) (unless elt (setq elt (MAKE-INSTANCE 'TAG-TABLE-DUMMY-FILE :NAME NAME) ) (PUSH (CONS NAME elt) *ZMACS-TAG-TABLE-ALIST*)) (SEND elt :PUTPROP (MAPCAR (LAMBDA (X) (FS:MERGE-PATHNAMES X *PATHNAME-DEFAULTS*)) FILE-LIST) 'ZMACS-TAG-TABLE-FILE-SYMBOLS) (make-tag-table-current elt))) )) ; From modified file DJ: L.ZWEI; SECTIO.LISP#305 at 26-Jun-88 11:25:23 #8R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; SECTIO  " (defun forget-tag-table() (when *zmacs-current-tag-table* (setq *zmacs-tag-table-alist* (lisp:remove *zmacs-current-tag-table* *zmacs-tag-table-alist* :key #'cdr)) (setq *zmacs-current-tag-table* nil)) (when (setq *zmacs-current-tag-table* (zmacs-current-tag-table)) (make-tag-table-current *zmacs-current-tag-table*)) *zmacs-current-tag-table*) )) ; From modified file DJ: L.ZWEI; POSS.LISP#104 at 26-Jun-88 11:54:06 #10R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; POSS  " (DEFUN LAST-RESORT-POSSIBILITY (BP OBJECT &REST IGNORE &AUX DWIMIFIED-OBJECT processor-special) (MOVE-BP BP (BEG-OF-LINE (BP-LINE BP))) (INSERT-POSSIBILITY-BEFORE-AND-GO BP (COND ((AND (SETQ DWIMIFIED-OBJECT (SYS:DWIMIFY-PACKAGE-0 OBJECT 'ZMACS-DEFINEDP)) (NOT (EQUAL OBJECT DWIMIFIED-OBJECT))) `(EDIT-DEFINITION-POSSIBILITY ,DWIMIFIED-OBJECT)) ((AND (FDEFINEDP OBJECT) (LET ((DEF (FDEFINITION OBJECT))) (COND ;;if the objects definition is found in a file that is written in a ;;corresponding package ((and (symbolp object) (get (symbol-package object) :prefix) (not (get object 'zmacs-buffers))) (pkg-goto (symbol-package object)) (resectionize-buffer (find-file (send (cadar (get object :source-file-name)) :new-pathname :type "LISP" :version :Newest))) `(edit-definition-possibility ,object)) ;; If the object's definition is a symbol, offer that symbol's definition. ((AND (SYMBOLP DEF) (FQUERY NIL "The definition of ~S is ~S. Visit ~1@*~S? " OBJECT DEF)) `(EDIT-DEFINITION-POSSIBILITY ,DEF)) ;; If the definition has a different name, offer that name. ((AND (ATOM DEF) (NOT (FUNCTIONP DEF))) (BARF "The definition of is ~S is weird: ~S" OBJECT DEF)) ((AND (NOT (EQUAL (FUNCTION-NAME DEF) OBJECT)) (FQUERY NIL "The definition of ~S has the name ~S. Visit ~1@*~S? " OBJECT (FUNCTION-NAME DEF))) `(EDIT-DEFINITION-POSSIBILITY ,(FUNCTION-NAME DEF))) ;; If object has an expr definition, offer to grind it into a new buffer. ((AND (OR (CONSP DEF) (SI:FUNCTION-SPEC-GET OBJECT ':PREVIOUS-EXPR-DEFINITION)) (FQUERY NIL "Grind the definition of ~S into a new buffer? " OBJECT)) (MAKE-BUFFER-CURRENT (CREATE-ONE-BUFFER-TO-GO (FORMAT NIL "~S" OBJECT))) (RETURN-FROM LAST-RESORT-POSSIBILITY (SI:GRIND-1 OBJECT 90. (INTERVAL-STREAM-INTO-BP (INTERVAL-LAST-BP *INTERVAL*))))) ;;First attempt to clean this up a bit for target processors -Keith ((setq processor-special (SELECT-PROCESSOR (:CADR (and (typep def 'microcode-function) 'UCODE)) (:LAMBDA (and (typep def 'microcode-function) 'LAMBDA-UCODE)) (:EXPLORER (and (typep def 'microcode-function) 'LAMBDA-UCODE)) (:FALCON))) (FQUERY NIL "~S is a processor-special function. Search through ~A? " OBJECT processor-special) `(TAGS-SEARCH-SYSTEM-POSSIBILITY ,processor-special ,(FORMAT NIL "(misc-inst-entry ~A)" OBJECT))) (T NIL))))) (T (OR *MINI-BUFFER-COMMAND* (SETQ *MINI-BUFFER-COMMAND* `((COM-EDIT-DEFINITION NIL 1) ,(FORMAT NIL "~S" OBJECT)))) (LET ((FILE (READ-DEFAULTED-PATHNAME (FORMAT NIL "Read ~S from what file:" (STRING-FROM-SPEC OBJECT)) (PATHNAME-DEFAULTS)))) ;; Now that we know the filename, insert a fetch-source-file possibility ;; for it BEFORE the last-resort-possibility, and then do it. ;; So the last-resort-possibility remains the last thing. `(FETCH-SOURCE-FILE-POSSIBILITY ,OBJECT ,FILE)))))) ))