[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Bug and fix to mouse-copy.lisp (menu-of-defs-dialog's give-text)

Following two changes are from my fixed version of mouse-copy.lisp.


#### From Change log ####
;; 07/29/92 mc  Fixed menu-of-defs-dialog's give-text to handle null
;;               packages. (mc = Matt Cornell, cornell@cs.umass.edu)

#### Replacement method ####
(defmethod give-text ((w menu-of-defs-dialog))
  (let* ((v (do-subviews (sv w 'sequence-dialog-item) (return sv)))
         (cell (point-to-cell v (view-mouse-position w)))
         ;; Below package was bound to (window-package (slot-value w 'my-window))
         ;;  which caused an error in read-from-string when package was
         ;;  nil. (Window-package is nil, for example, in "New" FRED
         ;;  windows).
         (package (or (window-package (slot-value w 'my-window)) *package*))
         (contents (let ((*package* package))
                     (read-from-string (car (cell-contents v cell))))))
    (when cell
      (let ((function (if (consp contents) (car contents) contents)))
        (when (fboundp function)
          (setq function (symbol-function function))
          (setq * function)
          (if (consp contents)
            (let ((method (ignore-errors
                            1 (%trace-function-spec-p
                               (cons :method contents))))))
              (when method (setq * method)))))))
    (when (consp contents) (setq contents (car contents)))
    (when cell
      (format nil "~a" contents))))