;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-

;;; Reason: Fix a bug in DWIMIFY-PACKAGE for non-symbol function specs.

;;;                           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.

;;; Written 04/24/89 11:36:08 by GRAY,
;;; while running on Kelvin from band LOD2
;;; With Experimental REL6G 6.0, Experimental SYSTEM 6.0, Experimental VIRTUAL-MEMORY 6.0,
;;;  Experimental EH 6.0, Experimental MAKE-SYSTEM 6.0, Experimental MICRONET 6.0,
;;;  Experimental LOCAL-FILE 6.0, Experimental BASIC-PATHNAME 6.0, Experimental NETWORK-SUPPORT-COLD 6.0,
;;;  Experimental BASIC-NAMESPACE 6.0, Experimental NETWORK-NAMESPACE 6.0, Experimental DISK-IO 6.0,
;;;  Experimental DISK-LABEL 6.0, Experimental BASIC-FILE 6.0, Experimental MAC-PATHNAME 6.0,
;;;  Experimental NETWORK-PATHNAME 6.0, Experimental COMPILER 6.0, Experimental TV 6.0,
;;;  Experimental DATALINK 6.0, Experimental CHAOSNET 6.0, Experimental GC 6.0, Experimental MEMORY-AUX 6.0,
;;;  Experimental NVRAM 6.0, Experimental SYSLOG 6.0, Experimental STREAMER-TAPE 6.0,
;;;  Experimental CLEH 1.0, Experimental UCL 6.0, Experimental INPUT-EDITOR 6.0, Experimental METER 6.0,
;;;  Experimental ZWEI 6.0, Experimental DEBUG-TOOLS 6.0, Experimental NETWORK-SUPPORT 6.0,
;;;  Experimental NETWORK-SERVICE 6.0, DATALINK-DISPLAYS 6.0, Experimental FONT-EDITOR 6.0,
;;;  Experimental SERIAL 6.0, Experimental PRINTER 6.0, Experimental MAC-PRINTER-TYPES 6.0,
;;;  Experimental PRINTER-TYPES 6.0, Experimental IMAGEN 6.0, Experimental SUGGESTIONS 6.0,
;;;  Experimental MAIL-DAEMON 6.0, Experimental MAIL-READER 6.0, Experimental TELNET 6.0,
;;;  Experimental VT100 6.0, Experimental NAMESPACE-EDITOR 6.0, Experimental PROFILE 6.0,
;;;  VISIDOC 6.0, Experimental TI-CLOS 16.5, Experimental CLX 4.0, Experimental X11M 2.0,
;;;  Experimental CLUE 19.0, Experimental RPC 6.0, NFS 3.5, Experimental BUG 11.4,
;;;  IP 3.42, Experimental DOCUMENTER 617.0,  microcode 424, Band Name: REL6G,Scribe,
;;; &c u424 4/20

#!C
; From file DWIMIFY.LISP#> KERNEL; MR-X:
#10R SYSTEM#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "SYSTEM"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* *COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: KERNEL; DWIMIFY.#"



;; consider one suggested dwimification, new-spec, of the original-spec.
;; if the user accepts it, throw it to dwimify-package.
;; dwimify-info should be something like 
;;  (validate-function-spec fdefinedp fdefinition-location "definition" function-spec-dwimify)
;; if the third element is nil, the option of linking the symbols is not offered.
(defun dwimify-package-2 (new-spec pack original-spec  dwimify-info
			  &optional no-recursion &aux ans
			  (validator (first dwimify-info))
			  (predicate (or (sixth dwimify-info) (second dwimify-info)))
			  (locator (third dwimify-info))
			  (pretty-name (fourth dwimify-info))
			  (aux-dwimifier (fifth dwimify-info))
			  (new-pack (and (symbolp new-spec) (symbol-package new-spec))))
  "subroutine of dwimify-package: ask user about one candidate.
this can be used by handlers of types of function specs,
for handling the :dwimify operation.
new-spec is the candidate.  original-spec is what was supplied to dwimify-package.
dwimify-info is data on the type of definition being looked for, and what to tell the user.
original-spec and dwimify-info are provided with the :dwimify operation.
no-recursion means do not use this candidate to generate other candidates."
  (and (not (equal new-spec original-spec))
       (funcall validator new-spec)
       (catch 'quit
	 (or (cond ((and (funcall predicate new-spec)
			 (progn
			   (or dwimify-package-0-topic-printed
			       (format *query-io* "~&~s does not have a ~a.~%"
				       original-spec pretty-name
				       (setq dwimify-package-0-topic-printed t)))
			   (setq ans
				 (if new-pack
				      (fquery `(:choices
						 (((t "Yes.") #\Y #\T #\sp #\up-arrow)
						  ((nil "No.") #\N #\rubout #\c-z #\down-arrow)
						  ,@(and (symbolp new-spec)
							 locator
							 '(((p "Permanently link ") #\P)))
						  ((g "Go to package ") #\G))
						 :help-function dwimify-package-2-help)
					      "Use the ~a of ~a:~a ~:[(Home package ~a)~]? "
					      pretty-name pack new-spec (eq pack new-pack)
					      new-pack)
				    (fquery `(:choices
					       (((t "Yes.") #\Y #\T #\sp #\up-arrow)
						((nil "No.") #\N #\rubout #\c-z #\down-arrow))
					       :help-function dwimify-package-2-help)
					    "Use the ~a of ~s ? "
					    pretty-name new-spec)))))
		    (cond ((eq ans 'p)
			   (format *query-io* "~s to ~s." original-spec new-spec)
			   (let ((loc2 (funcall locator original-spec))
				 (loc1 (funcall locator new-spec)))
			     (setf (cdr loc2) loc1)
			     (%p-store-data-type loc2 dtp-one-q-forward)))
			  ((Eq ans 'g)
			   (let ((pkg (symbol-package
					(if (symbolp new-spec) new-spec
					  (cadr new-spec)))))
			     (format *query-io* "~a." (PACKAGE-NAME pkg))
			     (pkg-goto pkg))))
		    (THROW 'dwimify-package new-spec)))
	     ;; if this one isn't defined of isn't wanted,
	     ;; try any others suggested by this kind of function spec's handler.
	     ;; for :method, this should try inherited methods.
	     ;; with each suggestion, the dwimifier should call this function again,
	     ;; perhaps setting no-recursion.
	     (and (not no-recursion)
		  (let ((value
			  (funcall aux-dwimifier new-spec original-spec dwimify-info)))
		    (and value (throw 'dwimify-package value))))))))

))