Changeset 15880


Ignore:
Timestamp:
Aug 15, 2013, 8:48:56 PM (6 years ago)
Author:
gz
Message:

Make DEFINITIONS-IN-DOCUMENT also return the type of each definition

Location:
trunk/source/cocoa-ide/hemlock/src
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/hemlock/src/edit-defs.lisp

    r15315 r15880  
    3131(declaim (simple-string *last-go-to-def-string*))
    3232 
    33 (defun symbol-at-point (buffer point)
     33(defun symbol-at-point (buffer)
    3434  "Returns symbol at point, or contents of selection if there is one"
    35   (with-mark ((mark1 point)
    36               (mark2 point))
    37     (if (hi::%buffer-current-region-p buffer)
    38         (let* ((mark (hi::buffer-%mark buffer)))
    39           (if (mark< mark point)
    40               (move-mark mark1 mark)
    41               (move-mark mark2 mark)))
    42         ;; This doesn't handle embedded #'s or escaped chars in names.
    43         ;; So let them report it as a bug...
    44         (progn
    45           (when (test-char (previous-character point) :lisp-syntax :constituent)
    46             (or (rev-scan-char mark1 :lisp-syntax (not :constituent))
    47                 (buffer-start mark1))
    48             (scan-char mark1 :lisp-syntax :constituent))
    49           (when (test-char (next-character point) :lisp-syntax :constituent)
    50             (or (scan-char mark2 :lisp-syntax (not :constituent))
    51                 (buffer-end mark2)))
    52           (when (mark= mark1 mark2)
    53             ;; Try to get whole form
    54             (pre-command-parse-check point)
    55             (move-mark mark1 point)
    56             (form-offset mark1 -1)
    57             (move-mark mark2 mark1)
    58             (form-offset mark2 1))))
     35  (let ((point (buffer-point buffer))
     36        (mark (buffer-mark buffer)))
     37    (if (and (hi::%buffer-current-region-p buffer)
     38             (not (mark= mark point)))
     39      (string-trim '(#\space #\tab)
     40                   (region-to-string (if (mark< mark point)
     41                                       (region mark point)
     42                                       (region point mark))))
     43      (symbol-at-mark buffer point))))
     44
     45(defun symbol-at-mark (buffer mark)
     46  (with-mark ((mark1 mark)
     47              (mark2 mark))
     48    ;; This doesn't handle embedded #'s or escaped chars in names.
     49    ;; So let them report it as a bug...
     50    (when (test-char (previous-character mark) :lisp-syntax :constituent)
     51      (or (rev-scan-char mark1 :lisp-syntax (not :constituent))
     52          (buffer-start mark1))
     53      (scan-char mark1 :lisp-syntax :constituent))
     54    (when (test-char (next-character mark) :lisp-syntax :constituent)
     55      (or (scan-char mark2 :lisp-syntax (not :constituent))
     56          (buffer-end mark2)))
     57    (when (mark= mark1 mark2)
     58      ;; Try to get whole form
     59      (pre-command-parse-check mark)
     60      (move-mark mark1 mark)
     61      (form-offset mark1 -1)
     62      (move-mark mark2 mark1)
     63      (form-offset mark2 1))
    5964    (loop until (or (mark= mark1 mark2) (not (eql (previous-character mark2) #\:)))
    60           do (mark-before mark2))
     65      do (mark-before mark2))
     66    (when (and (eql (previous-character mark1) #\#) (eql (next-character mark1) #\<))
     67      (mark-after mark1))
    6168    (unless (mark= mark1 mark2)
    6269      (region-to-string (region mark1 mark2)))))
     
    6673  (if p
    6774      (edit-definition-command nil)
    68       (let* ((point (current-point))
    69              (buffer (current-buffer))
    70              (fun-name (symbol-at-point buffer point)))
     75      (let* ((buffer (current-buffer))
     76             (fun-name (symbol-at-point buffer)))
    7177        (if fun-name
    7278            (get-def-info-and-go-to-it fun-name (or
    73                                                  (buffer-package (current-buffer))
     79                                                 (buffer-package buffer)
    7480                                                 *package*))
    7581            (beep)))))
  • trunk/source/cocoa-ide/hemlock/src/searchcoms.lisp

    r15872 r15880  
    498498        until (or (null (find-pattern mark pattern)) (mark> mark end))
    499499        as line = (mark-line (mark-after mark))
    500         collect (list (line-string line) (hi::get-line-origin line))
     500        collect (list (line-string line) (hi::get-line-origin line) (get-definition-type mark))
    501501        while (let ((next (line-next line)))
    502502                (when next
    503503                  (setf (mark-line mark) next)
    504504                  (setf (mark-charpos mark) 0)))))))
     505
     506(defun get-definition-type (mark)
     507  (let ((buffer (mark-buffer mark)))
     508    (mark-after mark)
     509    (let ((str (symbol-at-mark buffer mark)))
     510      (when str
     511        (multiple-value-bind (sym error)
     512                             (let* ((*package* (ccl:require-type (or (buffer-package buffer) *package*) 'package)))
     513                               (ignore-errors (values (read-from-string str))))
     514          (if error
     515            (intern (string-upcase str) *package*)
     516            sym))))))
    505517
    506518(defun move-to-definition (posn line-text &optional (leave-mark t))
     
    519531
    520532
    521 ;; Interface for getting this functionality outside of the editor
    522 ;; returns a list of (string number) where string is the first line of the definition and number is the
    523 ;; absolute position in the buffer of the start of the line.
     533;; Interface for getting this functionality outside of the editor.
     534;; Returns a list of (string number symbol) where string is the first line of the definition,
     535;; number is the absolute position in the buffer of the start of the line, and symbol is the
     536;; definition type (eg. DEFUN, DEFVAR, HI:DEFCOMMAND, etc).
    524537(defun definitions-in-document (ns-doc)
    525538  (gui::execute-in-buffer (gui::hemlock-buffer ns-doc) #'collect-definition-lines))
Note: See TracChangeset for help on using the changeset viewer.