[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)
- To: info-mcl@cambridge.apple.com, bug-mcl@cambridge.apple.com
- Subject: Bug and fix to mouse-copy.lisp (menu-of-defs-dialog's give-text)
- From: cornell@freya.cs.umass.edu
- Date: Wed, 29 Jul 92 07:54:33 -0400
Following two changes are from my fixed version of mouse-copy.lisp.
matt
#### 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
(nth-value
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))))