A small fragment to help with the namespace editor.

[Jerry Bakin <Jerry@marlowe.inference.dialnet.symbolics.com>]

Comparing two host namespace entries can be difficult, here's a hook to
sort out the host property list service values:

(I know there is some Symbolics code here, ...  Hey Symbolics, why not
rewrite the namespace editor to take advantage of those tricked out 7.1
features: you can introduce some new bugs, and make the code
proprietary! :)



;;; Place this in NETI:.

;;; Yeah, I know how ugly this is.  I don't care, it took a minute
;;; to type it into the listener; two seconds more to yank it into this
;;; message.

;;; The results look nice for a minute of effort.

(defun service< (triplet triplet-2)
   ;; Trick of the day -- this is faster than a (let ((s (car )) (m (cadr ) .... ???
   (multiple-value-bind (service-1 medium-1 protocol-1) (values-list triplet)
      (multiple-value-bind (service-2 medium-2 protocol-2) (values-list triplet-2)
         (if (string< service-1 service-2) triplet
             (if (string> service-1 service-2) nil
                 (if (string< medium-1 medium-2) triplet
                     (if (string> medium-1 medium-2) nil
                         (if (string< protocol-1 protocol-2) triplet 
                             (if (string< protocol-1 protocol-2) nil triplet)))))))))

;;; Some slightly modified code... Look near the lines of ******
;;; Symbolics code stolen from the namespace editor

(DEFMETHOD (:EDIT-OBJECT NAMESPACE-EDITOR-FRAME) (OBJECT-CLASS OBJECT-NAME MODE
							       &OPTIONAL COPY-P PROPERTY-LIST)
  (SETQ CLEAR-INTERACTOR NIL)
  ;; Decache information about this object, but do it carefully, so that if we cannot
  ;; connect to a server we don't leave something itching to be validated.
  (UNLESS NAMESPACE-EDIT-LOCALLY
    (CONDITION-CASE (OBJECT)
	(IF (TYPEP OBJECT-NAME 'NET:OBJECT)
	    OBJECT-NAME
	    ;; Don't contact server twice.
	    (LET ((NETI:*INHIBIT-VALIDITY-CHECKING* T))
	      (NET:FIND-OBJECT-NAMED OBJECT-CLASS OBJECT-NAME)))
      (NET:OBJECT-NOT-FOUND
	;; Not found, decache name
	(NETI:DECACHE-OBJECT-NAMED OBJECT-CLASS OBJECT-NAME))
      (:NO-ERROR
       (SEND OBJECT :CHECK-VALIDITY NIL T))))
  (WHEN (CONDITION-CASE (OBJECT)
	    (IF (TYPEP OBJECT-NAME 'NET:OBJECT)
		OBJECT-NAME
		(NET:FIND-OBJECT-NAMED OBJECT-CLASS OBJECT-NAME))
	  (NET:OBJECT-NOT-FOUND
	    (COND ((EQ MODE ':CREATING)
		   (SETQ NAMESPACE-NAME
			 (NETI:PARSE-NAME OBJECT-NAME
					  (NETI:CLASS-GLOBALLY-NAMED-P OBJECT-CLASS)))
		   T)
		  (T
		   (FORMAT INTERACTOR-PANE "~&~A~%" OBJECT)
		   NIL)))
	  (:NO-ERROR
	   (COND ((EQ MODE ':CREATING)
		  (FORMAT INTERACTOR-PANE "A ~@(~A~) with the name ~A already exists.~%"
			  OBJECT-CLASS OBJECT-NAME)
		  NIL)
		 (T (LET ((NAMESPACE (NAMESPACE-EDITOR-CHOOSE-NAMESPACE OBJECT)))
		      (WHEN NAMESPACE
			(SETQ NAMESPACE-OBJECT OBJECT)
			(MULTIPLE-VALUE (NAMESPACE-NAME PROPERTY-LIST)
			  (SEND OBJECT :NAMESPACE-VIEW NAMESPACE))
			T))))))
    (SETQ CLEAR-INTERACTOR T
	  NAMESPACE-CLASS OBJECT-CLASS
	  NAMESPACE-MODE MODE
	  NAMESPACE-MODIFIED NIL)
    (SEND NAME-PANE ':REFRESH)
    (SEND CHOICE-PANE ':SET-SENSITIVE-ITEM-TYPES (NEQ MODE ':VIEWING))
    ;;--- COPY-P should manage to get rid of any NAMING-PROPERTIES, since it's a disaster
    ;;if they are copied.
    (UNLESS COPY-P
      ;; ********************
      ;; ********************
      ;; ********************
      1;; Sort the services
0      (cl:setf (cl:getf property-list :service)
	    (sort (cl:getf property-list :service) #'service<))
      ;; ******************************************************
      ;; ******************************************************
      ;; ******************************************************
      (SEND CHOICE-PANE ':SET-ITEMS (CONSTRUCT-ITEMS-FROM-PROPERTY-LIST
				      NAMESPACE-CLASS PROPERTY-LIST)))))