| 1 | ;;;-*-Mode: LISP; Package: LIST-DEFINITIONS -*- |
|---|
| 2 | |
|---|
| 3 | ;;; ---------------------------------------------------------------------------- |
|---|
| 4 | ;;; |
|---|
| 5 | ;;; list-definitions.lisp |
|---|
| 6 | ;;; |
|---|
| 7 | ;;; copyright © 2009 Glen Foy |
|---|
| 8 | ;;; (Permission is granted to Clozure Associates to distribute this file.) |
|---|
| 9 | ;;; |
|---|
| 10 | ;;; This code adds a dynamic contextual popup menu to Hemlock. |
|---|
| 11 | ;;; |
|---|
| 12 | ;;; Right-Click produces an alphabetized listing of the file's definitions. |
|---|
| 13 | ;;; Command-Right-Click produces a positional listing. |
|---|
| 14 | ;;; |
|---|
| 15 | ;;; This software is offered "as is", without warranty of any kind. |
|---|
| 16 | ;;; |
|---|
| 17 | ;;; Mod History, most recent first: |
|---|
| 18 | ;;; 8/17/9 version 0.2b1 |
|---|
| 19 | ;;; Added position history list and file history list. |
|---|
| 20 | ;;; 8/12/9 version 0.1b3 |
|---|
| 21 | ;;; Numerous interface suggestions, Alexander Repenning. |
|---|
| 22 | ;;; 8/10/9 version 0.1b1 |
|---|
| 23 | ;;; First cut. |
|---|
| 24 | ;;; |
|---|
| 25 | ;;; ---------------------------------------------------------------------------- |
|---|
| 26 | |
|---|
| 27 | (defpackage "LIST-DEFINITIONS" (:nicknames "LDEFS") (:use :cl :ccl)) |
|---|
| 28 | (in-package "LIST-DEFINITIONS") |
|---|
| 29 | |
|---|
| 30 | (defParameter *objc-defmethod-search-pattern* (hi::new-search-pattern :string-insensitive :forward "(objc:defmethod")) |
|---|
| 31 | (defParameter *def-search-pattern* (hi::new-search-pattern :string-insensitive :forward "(def")) |
|---|
| 32 | (defParameter *left-paren-search-pattern* (hi::new-search-pattern :character :forward #\()) |
|---|
| 33 | (defParameter *colon-search-pattern* (hi::new-search-pattern :character :forward #\:)) |
|---|
| 34 | (defParameter *slash-search-pattern* (hi::new-search-pattern :character :forward #\/)) |
|---|
| 35 | |
|---|
| 36 | (defVar *position-history-list* nil "The position-history-list instance.") |
|---|
| 37 | (defVar *file-history-list* nil "The file-history-list instance.") |
|---|
| 38 | |
|---|
| 39 | (defmacro clone (mark) `(hi::copy-mark ,mark :temporary)) |
|---|
| 40 | |
|---|
| 41 | (defun active-hemlock-window () |
|---|
| 42 | "Return the active hemlock-frame." |
|---|
| 43 | (gui::first-window-satisfying-predicate |
|---|
| 44 | #'(lambda (w) |
|---|
| 45 | (and (typep w 'gui::hemlock-frame) |
|---|
| 46 | (not (typep w 'gui::hemlock-listener-frame)) |
|---|
| 47 | (#/isKeyWindow w))))) |
|---|
| 48 | |
|---|
| 49 | (defun window-path (w) |
|---|
| 50 | "Return the window's path." |
|---|
| 51 | (let* ((pane (slot-value w 'gui::pane)) |
|---|
| 52 | (hemlock-view (when pane (gui::text-pane-hemlock-view pane))) |
|---|
| 53 | (buffer (when hemlock-view (hi::hemlock-view-buffer hemlock-view)))) |
|---|
| 54 | (when buffer (hi::buffer-pathname buffer)))) |
|---|
| 55 | |
|---|
| 56 | ;;; ---------------------------------------------------------------------------- |
|---|
| 57 | ;;; |
|---|
| 58 | (defclass list-definitions-menu (ns:ns-menu) |
|---|
| 59 | ((text-view :initarg :menu-text-view :reader menu-text-view) |
|---|
| 60 | (path :initarg :menu-path :reader menu-path)) |
|---|
| 61 | (:documentation "The definitions popup menu.") |
|---|
| 62 | (:metaclass ns:+ns-object)) |
|---|
| 63 | |
|---|
| 64 | (objc:defmethod (#/listDefinitionsAction: :void) ((m list-definitions-menu) (sender :id)) |
|---|
| 65 | (display-position (menu-text-view m) (item-mark sender)) |
|---|
| 66 | (maybe-add-history-entry *position-history-list* (item-info sender) (menu-path m))) |
|---|
| 67 | |
|---|
| 68 | (defun display-position (text-view mark) |
|---|
| 69 | "Display the position of MARK in TEXT-VIEW." |
|---|
| 70 | (let* ((def-pos (hi::mark-absolute-position mark)) |
|---|
| 71 | (def-end-pos (let ((temp-mark (clone mark))) |
|---|
| 72 | (when (hemlock::form-offset temp-mark 1) |
|---|
| 73 | (hi::mark-absolute-position temp-mark))))) |
|---|
| 74 | (unless def-end-pos (when def-pos (setq def-end-pos (1+ def-pos)))) |
|---|
| 75 | (when (and def-pos def-end-pos) |
|---|
| 76 | (ns:with-ns-range (range def-pos (- def-end-pos def-pos)) |
|---|
| 77 | (#/scrollRangeToVisible: text-view range)) |
|---|
| 78 | (hi::move-mark (hi::buffer-point (gui::hemlock-buffer text-view)) mark) |
|---|
| 79 | (gui::update-paren-highlight text-view)))) |
|---|
| 80 | |
|---|
| 81 | ;;; ---------------------------------------------------------------------------- |
|---|
| 82 | ;;; |
|---|
| 83 | (defclass list-definitions-menu-item (ns:ns-menu-item) |
|---|
| 84 | ((mark :accessor item-mark) |
|---|
| 85 | (path :accessor item-path) |
|---|
| 86 | (info :accessor item-info)) |
|---|
| 87 | (:documentation "Support for the definitions list menu.") |
|---|
| 88 | (:metaclass ns:+ns-object)) |
|---|
| 89 | |
|---|
| 90 | (defparameter *dark-blue-color* (#/colorWithCalibratedRed:green:blue:alpha: ns:ns-color 0.2 0.2 0.5 1.0)) |
|---|
| 91 | (defparameter *dark-green-color* (#/colorWithCalibratedRed:green:blue:alpha: ns:ns-color 0.0 0.3 0.1 1.0)) |
|---|
| 92 | (defparameter *dark-gray-color* (#/colorWithCalibratedRed:green:blue:alpha: ns:ns-color 0.1 0.1 0.1 1.0)) |
|---|
| 93 | (defparameter *dark-brown-color* (#/colorWithCalibratedRed:green:blue:alpha: ns:ns-color 0.3 0.05 0.0 1.0)) |
|---|
| 94 | (defparameter *dark-turquoise-color* (#/colorWithCalibratedRed:green:blue:alpha: ns:ns-color 0.0 0.2 0.3 1.0)) |
|---|
| 95 | (defparameter *wine-red-color* (#/colorWithCalibratedRed:green:blue:alpha: ns:ns-color 0.4 0.1 0.2 1.0)) |
|---|
| 96 | |
|---|
| 97 | (defparameter *generic-dictionary* (make-instance 'ns:ns-mutable-dictionary :with-capacity 2)) |
|---|
| 98 | (#/setObject:forKey: *generic-dictionary* (#/systemFontOfSize: ns:ns-font (#/smallSystemFontSize ns:ns-font)) #&NSFontAttributeName) |
|---|
| 99 | (#/setObject:forKey: *generic-dictionary* *dark-gray-color* #&NSForegroundColorAttributeName) |
|---|
| 100 | |
|---|
| 101 | (defparameter *file-history-dictionary* (make-instance 'ns:ns-mutable-dictionary :with-capacity 2)) |
|---|
| 102 | (#/setObject:forKey: *file-history-dictionary* (#/systemFontOfSize: ns:ns-font (#/smallSystemFontSize ns:ns-font)) #&NSFontAttributeName) |
|---|
| 103 | (#/setObject:forKey: *file-history-dictionary* *dark-blue-color* #&NSForegroundColorAttributeName) |
|---|
| 104 | |
|---|
| 105 | (defparameter *defclass-dictionary* (make-instance 'ns:ns-mutable-dictionary :with-capacity 3)) |
|---|
| 106 | (#/setObject:forKey: *defclass-dictionary* (#/systemFontOfSize: ns:ns-font (#/smallSystemFontSize ns:ns-font)) #&NSFontAttributeName) |
|---|
| 107 | (#/setObject:forKey: *defclass-dictionary* *wine-red-color* #&NSForegroundColorAttributeName) |
|---|
| 108 | (#/setObject:forKey: *defclass-dictionary* (#/numberWithInt: ns:ns-number 1) #&NSUnderlineStyleAttributeName) |
|---|
| 109 | |
|---|
| 110 | (defparameter *defstruct-dictionary* (make-instance 'ns:ns-mutable-dictionary :with-capacity 3)) |
|---|
| 111 | (#/setObject:forKey: *defstruct-dictionary* (#/systemFontOfSize: ns:ns-font (#/smallSystemFontSize ns:ns-font)) #&NSFontAttributeName) |
|---|
| 112 | (#/setObject:forKey: *defstruct-dictionary* *dark-turquoise-color* #&NSForegroundColorAttributeName) |
|---|
| 113 | (#/setObject:forKey: *defstruct-dictionary* (#/numberWithInt: ns:ns-number 1) #&NSUnderlineStyleAttributeName) |
|---|
| 114 | |
|---|
| 115 | (defparameter *defmethod-dictionary* (make-instance 'ns:ns-mutable-dictionary :with-capacity 2)) |
|---|
| 116 | (#/setObject:forKey: *defmethod-dictionary* (#/systemFontOfSize: ns:ns-font (#/smallSystemFontSize ns:ns-font)) #&NSFontAttributeName) |
|---|
| 117 | (#/setObject:forKey: *defmethod-dictionary* *dark-blue-color* #&NSForegroundColorAttributeName) |
|---|
| 118 | |
|---|
| 119 | (defparameter *defun-dictionary* (make-instance 'ns:ns-mutable-dictionary :with-capacity 2)) |
|---|
| 120 | (#/setObject:forKey: *defun-dictionary* (#/systemFontOfSize: ns:ns-font (#/smallSystemFontSize ns:ns-font)) #&NSFontAttributeName) |
|---|
| 121 | (#/setObject:forKey: *defun-dictionary* *dark-green-color* #&NSForegroundColorAttributeName) |
|---|
| 122 | |
|---|
| 123 | (defparameter *defmacro-dictionary* (make-instance 'ns:ns-mutable-dictionary :with-capacity 2)) |
|---|
| 124 | (#/setObject:forKey: *defmacro-dictionary* (#/systemFontOfSize: ns:ns-font (#/smallSystemFontSize ns:ns-font)) #&NSFontAttributeName) |
|---|
| 125 | (#/setObject:forKey: *defmacro-dictionary* *dark-brown-color* #&NSForegroundColorAttributeName) |
|---|
| 126 | |
|---|
| 127 | (defparameter *objc-dictionary* (make-instance 'ns:ns-mutable-dictionary :with-capacity 2)) |
|---|
| 128 | (#/setObject:forKey: *objc-dictionary* (#/systemFontOfSize: ns:ns-font (#/smallSystemFontSize ns:ns-font)) #&NSFontAttributeName) |
|---|
| 129 | (#/setObject:forKey: *objc-dictionary* *dark-blue-color* #&NSForegroundColorAttributeName) |
|---|
| 130 | |
|---|
| 131 | ;;; This is not retained -- assumming autorelease. |
|---|
| 132 | (defun list-definitions-context-menu (text-view &optional alpha-p) |
|---|
| 133 | "Construct the list-definitions popup menu." |
|---|
| 134 | (let* ((menu (make-instance 'list-definitions-menu |
|---|
| 135 | :menu-text-view text-view |
|---|
| 136 | :menu-path (window-path (#/window text-view)))) |
|---|
| 137 | (window (active-hemlock-window)) |
|---|
| 138 | (alist (when window (list-definitions window alpha-p))) |
|---|
| 139 | (class-icon (#/iconForFileType: (#/sharedWorkspace ns:ns-workspace) (ccl::%make-nsstring "lisp"))) |
|---|
| 140 | current-class menu-item) |
|---|
| 141 | (ns:with-ns-size (icon-size 16 16) |
|---|
| 142 | (#/setSize: class-icon icon-size)) |
|---|
| 143 | (dolist (entry alist) |
|---|
| 144 | (let* ((def-info (car entry)) |
|---|
| 145 | (def-type (first def-info)) |
|---|
| 146 | (name (second def-info)) |
|---|
| 147 | (signature (third def-info)) |
|---|
| 148 | (specializer (fourth def-info)) |
|---|
| 149 | (dictionary (case def-type |
|---|
| 150 | (:defclass *defclass-dictionary*) |
|---|
| 151 | (:defstruct *defstruct-dictionary*) |
|---|
| 152 | (:defmethod *defmethod-dictionary*) |
|---|
| 153 | (:defun *defun-dictionary*) |
|---|
| 154 | (:defmacro *defmacro-dictionary*) |
|---|
| 155 | (:objc *objc-dictionary*) |
|---|
| 156 | (t *generic-dictionary*))) |
|---|
| 157 | (attributed-string (#/initWithString:attributes: |
|---|
| 158 | (#/alloc ns:ns-attributed-string) |
|---|
| 159 | ;; indent methods if directly under specializing class or struct: |
|---|
| 160 | (if (or (eq def-type :defmethod) |
|---|
| 161 | (eq def-type :objc)) |
|---|
| 162 | (if (and (not alpha-p) |
|---|
| 163 | current-class specializer |
|---|
| 164 | (string-equal specializer current-class)) |
|---|
| 165 | (ccl::%make-nsstring (format nil " ~A" signature)) |
|---|
| 166 | (ccl::%make-nsstring (format nil "~A" signature))) |
|---|
| 167 | (ccl::%make-nsstring name)) |
|---|
| 168 | dictionary))) |
|---|
| 169 | (when (or (eq def-type :defclass) (eq def-type :defstruct)) (setq current-class name)) |
|---|
| 170 | (setq menu-item (make-instance 'list-definitions-menu-item)) |
|---|
| 171 | (setf (item-mark menu-item) (cdr entry)) |
|---|
| 172 | (setf (item-info menu-item) def-info) |
|---|
| 173 | (#/setAttributedTitle: menu-item attributed-string) |
|---|
| 174 | ;; Prepend CCL icon to class names: |
|---|
| 175 | (when (eq def-type :defclass) (#/setImage: menu-item class-icon)) |
|---|
| 176 | (#/setAction: menu-item (ccl::@selector "listDefinitionsAction:")) |
|---|
| 177 | (#/setTarget: menu-item menu) |
|---|
| 178 | (#/addItem: menu menu-item))) |
|---|
| 179 | menu)) |
|---|
| 180 | |
|---|
| 181 | (objc:defmethod #/menuForEvent: ((view gui::hemlock-text-view) (event :id)) |
|---|
| 182 | (let ((view-window (#/window view))) |
|---|
| 183 | (#/makeKeyAndOrderFront: view-window nil) |
|---|
| 184 | (if (logtest #$NSAlternateKeyMask (#/modifierFlags event)) |
|---|
| 185 | (if (logtest #$NSCommandKeyMask (#/modifierFlags event)) |
|---|
| 186 | (files-context-menu) |
|---|
| 187 | (positions-context-menu)) |
|---|
| 188 | (if (logtest #$NSCommandKeyMask (#/modifierFlags event)) |
|---|
| 189 | (list-definitions-context-menu view nil) |
|---|
| 190 | (list-definitions-context-menu view t))))) |
|---|
| 191 | |
|---|
| 192 | ;;; This includes definitions in sharp-stroke comments. We'll claim it's a feature. |
|---|
| 193 | (defun list-definitions (hemlock &optional alpha-p) |
|---|
| 194 | "Create a list of all the top-level definitions in the file." |
|---|
| 195 | (labels ((get-name (entry) |
|---|
| 196 | (let ((def-info (car entry))) |
|---|
| 197 | (second def-info))) |
|---|
| 198 | (get-defs (mark pattern &optional objc-p) |
|---|
| 199 | (do ((def-found-p (hi::find-pattern mark pattern) |
|---|
| 200 | (hi::find-pattern mark pattern)) |
|---|
| 201 | alist) |
|---|
| 202 | ((not def-found-p) (when alist |
|---|
| 203 | (if alpha-p |
|---|
| 204 | (sort alist #'string-lessp :key #'get-name) |
|---|
| 205 | (nreverse alist)))) |
|---|
| 206 | (when (zerop (hi::mark-charpos mark)) |
|---|
| 207 | (let ((def-info (definition-info (clone mark) objc-p))) |
|---|
| 208 | (when def-info |
|---|
| 209 | (push (cons def-info (hi::line-start (clone mark))) alist)))) |
|---|
| 210 | (hi::line-end mark)))) |
|---|
| 211 | (let* ((pane (slot-value hemlock 'gui::pane)) |
|---|
| 212 | (text-view (gui::text-pane-text-view pane)) |
|---|
| 213 | (buffer (gui::hemlock-buffer text-view)) |
|---|
| 214 | (def-mark (clone (hi::buffer-start-mark buffer))) |
|---|
| 215 | (objc-mark (clone (hi::buffer-start-mark buffer))) |
|---|
| 216 | (def-alist (get-defs def-mark *def-search-pattern*)) |
|---|
| 217 | (objc-alist (get-defs objc-mark *objc-defmethod-search-pattern* t))) |
|---|
| 218 | (when objc-alist |
|---|
| 219 | (setq def-alist |
|---|
| 220 | (if alpha-p |
|---|
| 221 | (merge 'list def-alist objc-alist #'string-lessp :key #'get-name) |
|---|
| 222 | (merge 'list def-alist objc-alist #'hi::mark< :key #'cdr)))) |
|---|
| 223 | def-alist))) |
|---|
| 224 | |
|---|
| 225 | (defun definition-info (mark &optional objc-p) |
|---|
| 226 | "Returns (type name) or (type name signature specializer) for methods." |
|---|
| 227 | (flet ((substring-equal (string len) |
|---|
| 228 | (string-equal string |
|---|
| 229 | (hi::region-to-string |
|---|
| 230 | (hi::region mark (hi::character-offset (clone mark) len)))))) |
|---|
| 231 | (let* ((def-type (cond (objc-p :objc) |
|---|
| 232 | ((substring-equal "(defmethod" 10) :defmethod) |
|---|
| 233 | ((substring-equal "(defun" 6) :defun) |
|---|
| 234 | ((substring-equal "(defmacro" 9) :defmacro) |
|---|
| 235 | ((substring-equal "(defclass" 9) :defclass) |
|---|
| 236 | ((substring-equal "(defstruct" 10) :defstruct) |
|---|
| 237 | (t :other))) |
|---|
| 238 | (end (let ((temp-mark (clone mark))) |
|---|
| 239 | (when (hemlock::form-offset (hi::mark-after temp-mark) 2) |
|---|
| 240 | temp-mark))) |
|---|
| 241 | (start (when end |
|---|
| 242 | (let ((temp-mark (clone end))) |
|---|
| 243 | (when (hemlock::form-offset temp-mark -1) |
|---|
| 244 | temp-mark))))) |
|---|
| 245 | (when (and start end) |
|---|
| 246 | (let ((name (hi::region-to-string (hi::region start end))) |
|---|
| 247 | param-string specializer) |
|---|
| 248 | (when (and (stringp name) (string-not-equal name "")) |
|---|
| 249 | (case def-type |
|---|
| 250 | (:defmethod |
|---|
| 251 | (let ((qualifier-start-mark (clone end)) |
|---|
| 252 | (left-paren-mark (clone end)) |
|---|
| 253 | right-paren-mark qualifier-end-mark qualifier-string) |
|---|
| 254 | (when (hi::find-pattern left-paren-mark *left-paren-search-pattern*) |
|---|
| 255 | (setq right-paren-mark (clone left-paren-mark)) |
|---|
| 256 | (when (hemlock::form-offset right-paren-mark 1) |
|---|
| 257 | (multiple-value-setq (param-string specializer) |
|---|
| 258 | (parse-parameters (clone left-paren-mark) right-paren-mark)))) |
|---|
| 259 | (when (hi::find-pattern qualifier-start-mark *colon-search-pattern* left-paren-mark) |
|---|
| 260 | (setq qualifier-end-mark (clone qualifier-start-mark)) |
|---|
| 261 | (when (hemlock::form-offset qualifier-end-mark 1) |
|---|
| 262 | (setq qualifier-string |
|---|
| 263 | (hi::region-to-string (hi::region qualifier-start-mark qualifier-end-mark))))) |
|---|
| 264 | (if qualifier-string |
|---|
| 265 | ;; name is used to simplify the alpha sort: |
|---|
| 266 | (list def-type name (format nil "(~A ~A ~A)" name qualifier-string param-string) specializer) |
|---|
| 267 | (list def-type name (format nil "(~A ~A)" name param-string) specializer)))) |
|---|
| 268 | (:objc |
|---|
| 269 | (let* ((name-start-mark (let ((temp-mark (clone start))) |
|---|
| 270 | (when (hi::find-pattern temp-mark *slash-search-pattern*) |
|---|
| 271 | (hi::mark-after temp-mark)))) |
|---|
| 272 | (name-end-mark (when name-start-mark |
|---|
| 273 | (let ((temp-mark (clone name-start-mark))) |
|---|
| 274 | (when (hemlock::form-offset temp-mark 1) |
|---|
| 275 | temp-mark)))) |
|---|
| 276 | (objc-name (when (and name-start-mark name-end-mark) |
|---|
| 277 | (hi::region-to-string (hi::region name-start-mark name-end-mark)))) |
|---|
| 278 | (left-paren-mark (let ((temp-mark (clone end))) |
|---|
| 279 | (when (hi::find-pattern temp-mark *left-paren-search-pattern*) |
|---|
| 280 | temp-mark))) |
|---|
| 281 | (right-paren-mark (when left-paren-mark |
|---|
| 282 | (let ((temp-mark (clone left-paren-mark))) |
|---|
| 283 | (when (hi::form-offset temp-mark 1) |
|---|
| 284 | temp-mark))))) |
|---|
| 285 | (when (and left-paren-mark right-paren-mark) |
|---|
| 286 | (multiple-value-setq (param-string specializer) |
|---|
| 287 | (parse-parameters left-paren-mark right-paren-mark t)) |
|---|
| 288 | ;; Using curly braces to distinguish objc methods from Lisp methods: |
|---|
| 289 | (list def-type objc-name (format nil "{~A ~A}" objc-name param-string) specializer)))) |
|---|
| 290 | (:defstruct |
|---|
| 291 | (cond ((char= (hi::next-character start) #\() |
|---|
| 292 | (let* ((space-position (position #\space name :test #'char=)) |
|---|
| 293 | (new-name (when space-position (subseq name 1 space-position)))) |
|---|
| 294 | (if new-name |
|---|
| 295 | (list def-type new-name) |
|---|
| 296 | (list def-type name)))) |
|---|
| 297 | (t |
|---|
| 298 | (list def-type name)))) |
|---|
| 299 | (t |
|---|
| 300 | (list def-type name))))))))) |
|---|
| 301 | |
|---|
| 302 | (defun parse-parameters (start-mark end-mark &optional objc-p) |
|---|
| 303 | "Construct the method's parameter string." |
|---|
| 304 | (let (specializers-processed-p specializer) |
|---|
| 305 | (flet ((get-param (start end) |
|---|
| 306 | (let ((next-character (hi::next-character start))) |
|---|
| 307 | (when (char= next-character #\&) (setq specializers-processed-p t)) |
|---|
| 308 | (cond ((and (char= next-character #\() (not specializers-processed-p)) |
|---|
| 309 | (let* ((specializer-end (when (hemlock::form-offset (hi::mark-after start) 2) start)) |
|---|
| 310 | (specializer-start (when specializer-end (clone specializer-end)))) |
|---|
| 311 | (when (and specializer-end specializer-start |
|---|
| 312 | (hemlock::form-offset specializer-start -1) |
|---|
| 313 | (hi::mark< specializer-end end)) |
|---|
| 314 | (when objc-p (setq specializers-processed-p t)) |
|---|
| 315 | (hi::region-to-string (hi::region specializer-start specializer-end))))) |
|---|
| 316 | (t |
|---|
| 317 | (unless (char= next-character #\&) |
|---|
| 318 | (format nil "t"))))))) |
|---|
| 319 | (do* ((sexp-end (let ((temp-mark (hi::mark-after (clone start-mark)))) |
|---|
| 320 | (when (hemlock::form-offset temp-mark 1) temp-mark)) |
|---|
| 321 | (when (hemlock::form-offset (hi::mark-after sexp-end) 1) sexp-end)) |
|---|
| 322 | (sexp-start (when sexp-end |
|---|
| 323 | (let ((temp-mark (clone sexp-end))) |
|---|
| 324 | (when (hemlock::form-offset temp-mark -1) temp-mark))) |
|---|
| 325 | (when sexp-end |
|---|
| 326 | (let ((temp-mark (clone sexp-end))) |
|---|
| 327 | (when (hemlock::form-offset temp-mark -1) temp-mark)))) |
|---|
| 328 | (param-string (when (and sexp-start sexp-end) (get-param (clone sexp-start) |
|---|
| 329 | (clone sexp-end))) |
|---|
| 330 | (when (and sexp-start sexp-end) (get-param (clone sexp-start) |
|---|
| 331 | (clone sexp-end)))) |
|---|
| 332 | (first-param-p t) |
|---|
| 333 | parameters) |
|---|
| 334 | ((or (null sexp-start) (null sexp-end) |
|---|
| 335 | (hi::mark> sexp-start end-mark) |
|---|
| 336 | ;; Empty body case: |
|---|
| 337 | (hi::mark< sexp-start start-mark)) |
|---|
| 338 | (values (concatenate 'string parameters ")") specializer)) |
|---|
| 339 | (when param-string |
|---|
| 340 | (cond (first-param-p |
|---|
| 341 | (setq parameters (concatenate 'string "(" param-string)) |
|---|
| 342 | (setq specializer param-string) |
|---|
| 343 | (setq first-param-p nil)) |
|---|
| 344 | (t |
|---|
| 345 | (setq parameters (concatenate 'string parameters " " param-string))))))))) |
|---|
| 346 | |
|---|
| 347 | |
|---|
| 348 | |
|---|
