Changeset 7643


Ignore:
Timestamp:
Nov 15, 2007, 2:33:51 AM (12 years ago)
Author:
rme
Message:

Enhance apropos window.

Location:
trunk/ccl/cocoa-ide
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/cocoa-ide/apropos-window.lisp

    r7596 r7643  
    11(in-package "CCL")
     2
     3(defclass package-combo-box (ns:ns-combo-box)
     4  ((packages :initform nil))
     5  (:metaclass ns:+ns-object))
     6
     7;;; This is a premature optimization.  Instead of calling LIST-ALL-PACKAGES
     8;;; so frequently, just get a fresh copy when the user clicks in the
     9;;; combo box.
     10(objc:defmethod (#/becomeFirstResponder :<BOOL>) ((self package-combo-box))
     11  (with-slots (packages) self
     12    (setf packages (coerce (list-all-packages) 'vector))
     13    (setf packages (sort packages #'string-lessp :key #'package-name)))
     14  (call-next-method))
    215
    316(defclass apropos-window-controller (ns:ns-window-controller)
     
    619                  :documentation "Bound to NSArrayController in nib file")
    720   (array-controller :foreign-type :id :accessor array-controller)
     21   (combo-box :foreign-type :id :accessor combo-box)
    822   (table-view :foreign-type :id :accessor table-view)
     23   (text-view :foreign-type :id :accessor text-view)
     24   (external-symbols-checkbox :foreign-type :id
     25                              :accessor external-symbols-checkbox)
     26   (shows-external-symbols :initform nil)
     27   (symbol-list :initform nil)
     28   (package :initform nil)
     29   (input :initform nil)
    930   (previous-input :initform nil :accessor previous-input
    1031                   :documentation "Last string entered"))
     
    2243(objc:defmethod (#/automaticallyNotifiesObserversForKey: :<BOOL>) ((self +apropos-window-controller)
    2344                                                                  key)
     45  (declare (ignore key))
    2446  nil)
    2547
    2648(objc:defmethod (#/awakeFromNib :void) ((self apropos-window-controller))
    27   (#/setDoubleAction: (slot-value self 'table-view) (@selector #/inspectSelectedSymbol:)))
     49  (with-slots (table-view text-view) self
     50    (#/setString: text-view #@"")
     51    (#/setDelegate: table-view self)
     52    (#/setDoubleAction: table-view (@selector #/inspectSelectedSymbol:))))
    2853
    2954(objc:defmethod #/init ((self apropos-window-controller))
     
    3863  (call-next-method))
    3964
     65(objc:defmethod (#/toggleShowsExternalSymbols: :void)
     66    ((self apropos-window-controller) sender)
     67  (declare (ignore sender))
     68  (with-slots (shows-external-symbols) self
     69    (setf shows-external-symbols (not shows-external-symbols))
     70    (update-symbol-list self)
     71    (update-apropos-array self)))
     72
     73(objc:defmethod (#/setPackage: :void) ((self apropos-window-controller)
     74                                       sender)
     75  (with-slots (combo-box package) self
     76    (assert (eql sender combo-box))
     77    (with-slots (packages) sender
     78      (let ((index (#/indexOfSelectedItem sender)))
     79        (if (minusp index)
     80          (setf package nil)            ;search all packages
     81          (setf package (svref packages index))))))
     82  (update-symbol-list self)
     83  (update-apropos-array self))
     84
     85(defmethod update-symbol-list ((self apropos-window-controller))
     86  (with-slots (input package shows-external-symbols symbol-list) self
     87    (when (plusp (length input))
     88      (setf symbol-list nil)
     89      (if package
     90        (if shows-external-symbols
     91          (do-external-symbols (sym package)
     92            (when (%apropos-substring-p input (symbol-name sym))
     93              (push sym symbol-list)))
     94          (do-symbols (sym package)
     95            (when (%apropos-substring-p input (symbol-name sym))
     96              (push sym symbol-list))))
     97        (if shows-external-symbols
     98          (dolist (p (list-all-packages))
     99            (do-external-symbols (sym p)
     100              (when (%apropos-substring-p input (symbol-name sym))
     101                (push sym symbol-list))))
     102          (do-all-symbols (sym)
     103            (when (%apropos-substring-p input (symbol-name sym))
     104              (push sym symbol-list)))))
     105      (setf symbol-list (sort symbol-list #'string-lessp)))))
     106
     107(defmethod update-apropos-array ((self apropos-window-controller))
     108  (with-slots (input apropos-array symbol-list package) self
     109    (when (plusp (length input))
     110      (let ((new-array (#/array ns:ns-mutable-array))
     111            (*package* (or package (find-package "COMMON-LISP-USER")))
     112            (n 0))
     113        (dolist (s symbol-list)
     114          (#/addObject: new-array (#/dictionaryWithObjectsAndKeys:
     115                                   ns:ns-dictionary
     116                                   (#/autorelease
     117                                    (%make-nsstring
     118                                     (prin1-to-string s)))
     119                                   #@"symbol"
     120                                   (#/numberWithInt: ns:ns-number n)
     121                                   #@"index"
     122                                   (#/autorelease
     123                                    (%make-nsstring
     124                                     (inspector::symbol-type-line s)))
     125                                   #@"kind"
     126                                   +null-ptr+))
     127          (incf n))
     128        (#/willChangeValueForKey: self #@"aproposArray")
     129        (setf apropos-array new-array)
     130        (#/didChangeValueForKey: self #@"aproposArray")))))
     131
    40132(objc:defmethod (#/apropos: :void) ((self apropos-window-controller) sender)
    41   (let* ((input (lisp-string-from-nsstring (#/stringValue sender)))
    42          (array (#/array ns:ns-mutable-array)))
     133  (let* ((input (lisp-string-from-nsstring (#/stringValue sender))))
    43134    (when (and (plusp (length input))
    44135               (not (string-equal input (previous-input self))))
     136      (setf (slot-value self 'input) input)
    45137      (setf (previous-input self) input)
    46       (flet ((%make-nsstring-with-highlighted-range (s start len)
    47                (let* ((attrs (#/dictionaryWithObject:forKey: ns:ns-dictionary
    48                               (#/systemFontOfSize:
    49                                ns:ns-font
    50                                (#/systemFontSizeForControlSize:
    51                                 ns:ns-font
    52                                 #$NSSmallControlSize))
    53                               #&NSFontAttributeName))
    54                       (output (make-instance 'ns:ns-mutable-attributed-string
    55                                 :with-string (#/autorelease
    56                                               (%make-nsstring s))
    57                                 :attributes attrs))
    58                       (range (ns:make-ns-range start len)))
    59                  (#/applyFontTraits:range: output #$NSBoldFontMask range)
    60                  output)))
    61         (mapc #'(lambda (x)
    62                   (let* ((pkg-name (package-name (symbol-package x)))
    63                          (sym-name (symbol-name x))
    64                          (pos (search input sym-name :test #'string-equal)))
    65                     (#/addObject: array (#/dictionaryWithObjectsAndKeys:
    66                                          ns:ns-dictionary
    67                                          (#/autorelease
    68                                           (%make-nsstring pkg-name))
    69                                          #@"package"
    70                                          (if (numberp pos)
    71                                              (#/autorelease
    72                                               (%make-nsstring-with-highlighted-range
    73                                                sym-name pos (length input)))
    74                                              (#/autorelease
    75                                               (%make-nsstring sym-name)))
    76                                          #@"symbol"
    77                                          +null-ptr+))))
    78               (apropos-list input)))
    79       (#/willChangeValueForKey: self #@"aproposArray")
    80       (setf (apropos-array self) array)
    81       (#/didChangeValueForKey: self #@"aproposArray"))))
     138      (update-symbol-list self)
     139      (update-apropos-array self))))
    82140
    83141(objc:defmethod (#/inspectSelectedSymbol: :void) ((self apropos-window-controller) sender)
    84142  (let* ((row (#/clickedRow sender)))
    85143    (unless (minusp row)
    86       (with-slots (array-controller) self
    87         (let* ((pkg-name (lisp-string-from-nsstring
    88                           (#/valueForKeyPath: array-controller
    89                                               #@"selection.package")))
    90                (sym-name (lisp-string-from-nsstring
    91                           (#/string (#/valueForKeyPath: array-controller
    92                                                         #@"selection.symbol"))))
    93                (symbol (find-symbol sym-name pkg-name)))
    94           (cinspect symbol))))))
     144      (with-slots (array-controller symbol-list) self
     145        (let* ((number (#/valueForKeyPath: array-controller #@"selection.index"))
     146               (i (#/intValue number))
     147               (sym (elt symbol-list i)))
     148          (cinspect sym))))))
     149
     150;;; Data source methods for package combo box
     151
     152(objc:defmethod (#/numberOfItemsInComboBox: :<NSI>nteger) ((self apropos-window-controller)
     153                                                   combo-box)
     154  (declare (ignore combo-box))
     155  (length (list-all-packages)))
     156
     157(objc:defmethod #/comboBox:objectValueForItemAtIndex: ((self apropos-window-controller)
     158                                                       combo-box
     159                                                       (index :<NSI>nteger))
     160  (with-slots (packages) combo-box
     161    (let* ((pkg-name (package-name (svref packages index))))
     162      (if pkg-name
     163        (#/autorelease (%make-nsstring pkg-name))
     164        +null-ptr+))))
     165
     166(objc:defmethod #/comboBox:completedString: ((self apropos-window-controller)
     167                                             combo-box
     168                                             partial-string)
     169  (flet ((string-prefix-p (s1 s2)
     170           "Is s1 a prefix of s2?"
     171           (string-equal s1 s2 :end2 (min (length s1) (length s2)))))
     172    (with-slots (packages) combo-box
     173      (let* ((s (lisp-string-from-nsstring partial-string)))
     174        (dotimes (i (length packages) +null-ptr+)
     175          (let ((name (package-name (svref packages i))))
     176            (when (string-prefix-p s name)
     177              (return (#/autorelease (%make-nsstring name))))))))))
     178
     179(objc:defmethod (#/comboBox:indexOfItemWithStringValue: :<NSUI>nteger)
     180    ((self apropos-window-controller)
     181     combo-box
     182     string)
     183  (with-slots (packages) combo-box
     184    (let* ((s (lisp-string-from-nsstring string)))
     185      (or (position s packages :test #'(lambda (str pkg)
     186                                         (string-equal str (package-name pkg))))
     187          #$NSNotFound))))
     188
     189
     190;;; Table view delegate methods
     191
     192(objc:defmethod (#/tableViewSelectionDidChange: :void) ((self apropos-window-controller)
     193                                                        notification)
     194  (with-slots (array-controller symbol-list text-view) self
     195    (let* ((tv (#/object notification))
     196           (row (#/selectedRow tv)))
     197      (unless (minusp row)
     198        (let* ((number (#/valueForKeyPath:
     199                        array-controller #@"selection.index"))
     200               (i (#/intValue number))
     201               (sym (elt symbol-list i))
     202               (info (make-array '(0) :element-type 'base-char
     203                                 :fill-pointer 0 :adjustable t)))
     204          (with-output-to-string (s info)
     205            (dolist (doctype '(compiler-macro function method-combination
     206                               setf structure t type variable))
     207              (let ((docstring (documentation sym doctype)))
     208                (when docstring
     209                  (format s "~&~a" docstring))
     210                (when (eq doctype 'function)
     211                  (format s "~&arglist: ~s" (arglist sym))))))
     212          (if (plusp (length info))
     213            (#/setString: text-view (#/autorelease (%make-nsstring info)))
     214            (#/setString: text-view #@"")))))))
     215
     216
  • trunk/ccl/cocoa-ide/ide-contents/Resources/English.lproj/apropos.nib/classes.nib

    r7588 r7643  
    1212                                <key>inspectSelectedSymbol</key>
    1313                                <string>id</string>
     14                                <key>setPackage</key>
     15                                <string>id</string>
     16                                <key>toggleShowsExternalSymbols</key>
     17                                <string>id</string>
    1418                        </dict>
    1519                        <key>CLASS</key>
     
    2125                                <key>arrayController</key>
    2226                                <string>id</string>
     27                                <key>comboBox</key>
     28                                <string>id</string>
     29                                <key>externalSymbolsCheckbox</key>
     30                                <string>id</string>
    2331                                <key>tableView</key>
     32                                <string>id</string>
     33                                <key>textView</key>
    2434                                <string>id</string>
    2535                        </dict>
    2636                        <key>SUPERCLASS</key>
    2737                        <string>NSWindowController</string>
     38                </dict>
     39                <dict>
     40                        <key>CLASS</key>
     41                        <string>PackageComboBox</string>
     42                        <key>LANGUAGE</key>
     43                        <string>ObjC</string>
     44                        <key>OUTLETS</key>
     45                        <dict>
     46                                <key>dataSource</key>
     47                                <string>id</string>
     48                        </dict>
    2849                </dict>
    2950        </array>
  • trunk/ccl/cocoa-ide/ide-contents/Resources/English.lproj/apropos.nib/info.nib

    r7588 r7643  
    66        <string>629</string>
    77        <key>IBOldestOS</key>
    8         <integer>4</integer>
     8        <integer>5</integer>
    99        <key>IBOpenObjects</key>
    10         <array/>
     10        <array>
     11                <integer>127</integer>
     12        </array>
    1113        <key>IBSystem Version</key>
    1214        <string>9A581</string>
Note: See TracChangeset for help on using the changeset viewer.