Changeset 15872


Ignore:
Timestamp:
Aug 3, 2013, 2:49:06 AM (6 years ago)
Author:
gz
Message:

Implement M-x List Definitions

Location:
trunk/source/cocoa-ide
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/cocoa-editor.lisp

    r15536 r15872  
    36483648      (front-view-for-buffer (hemlock-buffer doc)))))
    36493649
     3650;; Execute in cocoa thread in a dynamic context that allows hemlock buffer functions to work.
     3651;; The function should not modify the buffer, since display will not be updated, for that go
     3652;; through hi::handle-hemlock-event instead.
     3653(defun execute-in-buffer (buffer thunk)
     3654  (check-type buffer hi:buffer)
     3655  (let ((emsg nil))
     3656    (multiple-value-prog1
     3657        (execute-in-gui (lambda ()
     3658                         (block exit
     3659                           (handler-bind ((error (lambda (cc)
     3660                                                   (setq emsg
     3661                                                         (with-standard-io-syntax
     3662                                                             (or (ignore-errors (princ-to-string cc))
     3663                                                                 "#<error printing error message>")))
     3664                                                   (return-from exit))))
     3665                             (let ((hi::*current-buffer* buffer))
     3666                               (funcall thunk))))))
     3667      (when emsg (error "~a" emsg)))))
     3668
     3669
     3670
    36503671(defun hemlock-ext:execute-in-file-view (pathname thunk)
    36513672  (execute-in-gui #'(lambda ()
     
    36593680                                                     "#<error printing error message>")
    36603681                                        :default-button "Ok"))))))
     3682
     3683;; Bring view to front.
     3684(defun hemlock-ext:select-view (view)
     3685  (execute-in-gui (lambda ()
     3686                    (#/makeKeyAndOrderFront: (#/window (hi::hemlock-view-pane view)) (%null-ptr)))))
    36613687
    36623688(defun hemlock-ext:open-sequence-dialog (&key title sequence action (printer #'prin1))
  • trunk/source/cocoa-ide/hemlock/src/package.lisp

    r15536 r15872  
    388388   #:open-sequence-dialog
    389389   #:execute-in-file-view
     390   #:select-view
    390391   #:change-active-pane
    391392   #:send-string-to-listener
  • trunk/source/cocoa-ide/hemlock/src/searchcoms.lisp

    r11674 r15872  
    458458            (character-offset mark won))))
    459459      occurrences)))
     460
     461
     462;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     463
     464(defparameter *def-search-string* (coerce '(#\newline #\() 'string))
     465
     466(defcommand "List Definitions" (p)
     467  "List definitions in the buffer, or in the current region if there is one"
     468  (declare (ignore p))
     469  (let* ((view (current-view))
     470         (region (if (region-active-p)
     471                  (current-region)
     472                  (buffer-region (current-buffer))))
     473         (definitions (collect-definition-lines region)))
     474    (flet ((defn-action (defn)
     475             (gui::execute-in-gui (lambda ()
     476                                    (hemlock-ext:select-view view)
     477                                    (hi::handle-hemlock-event view
     478                                      (lambda ()
     479                                        ;; TODO: only leave mark if we're far away, or maybe if last command
     480                                        ;; was not list-definitions...
     481                                        (destructuring-bind (line-text posn) defn
     482                                          (or (move-to-definition posn line-text t)
     483                                              (loud-message "Could find definition"))))))))
     484           (defn-printer (defn stream)
     485             (write-string (car defn) stream)))
     486      (hemlock-ext:open-sequence-dialog
     487       :title (format nil "Definitions in ~s" (buffer-name (current-buffer)))
     488       :sequence definitions
     489       :action #'defn-action
     490       :printer #'defn-printer))))
     491
     492(defun collect-definition-lines (&optional (region (buffer-region (current-buffer))))
     493  (let* ((pattern (new-search-pattern :string-sensitive :forward *def-search-string*))
     494         (end (region-end region)))
     495    (with-mark ((mark (region-start region)))
     496      ;; TODO: doesn't find the definition on very first line.  LTRAB.
     497      (loop
     498        until (or (null (find-pattern mark pattern)) (mark> mark end))
     499        as line = (mark-line (mark-after mark))
     500        collect (list (line-string line) (hi::get-line-origin line))
     501        while (let ((next (line-next line)))
     502                (when next
     503                  (setf (mark-line mark) next)
     504                  (setf (mark-charpos mark) 0)))))))
     505
     506(defun move-to-definition (posn line-text &optional (leave-mark t))
     507  (flet ((ssearch (mark string direction)
     508           (find-pattern mark (new-search-pattern :string-insensitive
     509                                                  direction
     510                                                  string))))
     511    (declare (inline ssearch))
     512    (with-mark ((mark (current-point)))
     513      (or (move-to-absolute-position mark posn) (buffer-end mark))
     514      (when (or (ssearch mark line-text :forward)
     515                (ssearch mark line-text :backward))
     516        (if leave-mark
     517          (move-point-leaving-mark mark)
     518          (move-mark (current-point-collapsing-selection) mark))))))
     519
     520
     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.
     524(defun definitions-in-document (ns-doc)
     525  (gui::execute-in-buffer (gui::hemlock-buffer ns-doc) #'collect-definition-lines))
Note: See TracChangeset for help on using the changeset viewer.