Update of /project/cells/cvsroot/cell-cultures/clyde/visual-apropos In directory common-lisp.net:/tmp/cvs-serv705/clyde/visual-apropos
Modified Files: visual-apropos.lisp Log Message:
Date: Wed Jul 21 04:49:40 2004 Author: ktilton
Index: cell-cultures/clyde/visual-apropos/visual-apropos.lisp diff -u cell-cultures/clyde/visual-apropos/visual-apropos.lisp:1.4 cell-cultures/clyde/visual-apropos/visual-apropos.lisp:1.5 --- cell-cultures/clyde/visual-apropos/visual-apropos.lisp:1.4 Thu Jul 8 20:53:05 2004 +++ cell-cultures/clyde/visual-apropos/visual-apropos.lisp Wed Jul 21 04:49:39 2004 @@ -24,44 +24,42 @@ ;; ------------------- ;; to run, enter following in repl: ;; -;; (tk-test 'vis-apropos) +;; (tk-test 'visual-apropos) ;;
-(defun vis-apropos () - (make-be 'visual-apropos - :sub-symbol (c-in 'padding))) - -(defmodel visual-apropos (frame-stack) +(defmodel visual-apropos (window) ((symbols :initarg :symbols :initform nil :accessor symbols) - (sub-symbol :initarg :sub-symbol :initform nil :accessor sub-symbol)) + (sub-symbol :initarg :sub-symbol :initform 'thread :accessor sub-symbol)) (:default-initargs :symbols (c-in nil) - :pady 2 - :padx 4 - :layout (pack-layout? "-side left -fill both -expand 1 -anchor nw") :kids (c? (list - (search-for-symbol) - (mk-frame-row - :padx 8 - :layout (pack-layout? "-side left -fill x") + (mk-frame-stack + :pady 2 + :padx 4 + :layout (pack-layout? "-side left -fill both -expand 1 -anchor nw") :kids (c? (list - (mk-frame-stack + (search-for-symbol) + (mk-frame-row + :padx 8 :kids (c? (list - (mk-checkbutton :md-name :exported-only - :text "Exported Only" - :underline 1 - :md-value (c-in nil) - :command (lambda (self) - (setf (^md-value) (not (^md-value))))) - (show-which-symbols)))) - (package-filtering)))) - (symbol-list))))) + (mk-frame-stack + :kids (c? (list + (mk-checkbutton :md-name :exported-only + :text "Exported Only" + :underline 1 + :md-value (c-in nil) + :command (c? (Tk-callback self 'cmd + (lambda (self key &rest args) + (declare (ignore key args)) + (setf (^md-value) (not (^md-value))))))) + (show-which-symbols)))) + (package-filtering)))) + (symbol-list))))))))
(defun search-for-symbol () (mk-frame-row :relief 'ridge :padx 8 - :layout (pack-layout? "-side left -fill x -anchor nw") :kids-layout (c? (format nil "pack ~a -side left; pack ~a -side left -expand 1 -fill x; pack ~a -side right" (path (kid1 self)) @@ -74,16 +72,18 @@ :width 64) (mk-button :text "Search" :underline 0 - :command (lambda (self) - (setf (symbols (upper self visual-apropos)) - (apropos-list (text (fm^ :search-string)))))))))) + :command (c? (Tk-callback self 'cmd + (lambda (self key &rest args) + (declare (ignore key args)) + (setf (symbols (upper self visual-apropos)) + (apropos-list (text (fm^ :search-string))))))))))))
; --- symbol package filtering -------------------------------
(defun package-filtering () (mk-labelframe-row :text "Package(s) to Search" - :layout (pack-layout? "-side left -fill x -expand 1") + ;;:layout (pack-layout? "-side left -fill x -expand 1") :kids (c? (list (mk-checkbutton :md-name :all-pkgs :text "All" @@ -125,7 +125,7 @@
(defun symbol-list () (mk-frame-stack :md-name :symbol-list - :layout (pack-layout? "-side top -expand 1 -fill both") + ;;:layout (pack-layout? "-side top -expand 1 -fill both") :width 64 :background 'red :kids (c? (list @@ -208,13 +208,15 @@ (defmodel va-sorter (sort-button) ((sort-string-fn :initform 'string :initarg :sort-string-fn :accessor sort-string-fn)) (:default-initargs - :command (lambda (self) - (let* ((ss (fm^ :sym-sort))) - (if (eq self (or (md-value ss) (kid1 ss))) - (setf (sort-button-predicate self) - (if (eq (sort-button-predicate self) 'va-string<) - 'va-string> 'va-string<)) - (setf (md-value ss) self)))) + :command (c? (Tk-callback self 'cmd + (lambda (self key &rest args) + (declare (ignore key args)) + (let* ((ss (fm^ :sym-sort))) + (if (eq self (or (md-value ss) (kid1 ss))) + (setf (sort-button-predicate self) + (if (eq (sort-button-predicate self) 'va-string<) + 'va-string> 'va-string<)) + (setf (md-value ss) self)))))) :sort-button-predicate (c-in 'va-string<) :sort-button-key (c? (lambda (si) (funcall (^sort-string-fn)