Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

fontify most method signatures:

  * Add faces to Type $varname
  * Delete faces if signature does not parse
  * Support Type|Unions
  * Support "does coerce"
  * Support "does <foo>" and "is <foo>" (unused currently)
  * Support "Type $foo where { BLOCK }"
  * Support "Type $foo = EXPR"
  * Support multiple does/where/= clauses (not all make sense, but oh well)

Still broken are signatures with parens inside them.  Will fix later,
but docs to this effect are now here.

(Note also that there is some syntax-highlighting magic that hides
some bad effects of parens in the signature.  This is a side-effect of
syntax-highlighting the sub name as though it were a "use Foo"
declaration.  Not sure why I did this in the first place, but it is a
happy coincidence that it solves our problem.)
  • Loading branch information...
commit add7f63964e394ef7e5521e23947c2c42bcfebb0 1 parent ee93df9
@jrockway authored
Showing with 59 additions and 2 deletions.
  1. +59 −2 cperl-mode.el
View
61 cperl-mode.el
@@ -3320,6 +3320,63 @@ Returns true if comment is found. In POD will not move the point."
(put-text-property bb e 'face (if string 'font-lock-string-face
'font-lock-comment-face)))))
+(defun cperl-fontify-method-signature (bb e)
+ "Fontifiy subroutine/method prototype.
+
+BB is the starting position of the signature, including the (, E
+is the end of the signature, including the final ).
+
+This method can parse and highlight traditional prototypes (&@)
+as well as (many) MooseX::Method::Signatures method signatures.
+
+There are a few limitations; this method will not be called by
+the syntax scanner if the method signature is not on a single
+line, or if the signature contains extra parens. So declare your
+types and coercions in advance, with MooseX::Types."
+
+ (save-excursion
+ (goto-char bb)
+ (save-match-data
+ (when (looking-at "(.*)")
+ (save-restriction
+ (narrow-to-region (1+ (match-beginning 0)) (1- (match-end 0)))
+ (goto-char (1+ (match-beginning 0)))
+ (remove-text-properties (point) (point-max) '(font-lock-face))
+
+ ;; traditional prototype (not signature)
+ (when (looking-at "^[\\_$@*;&]+$")
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'font-lock-face 'font-lock-builtin-face)
+ (goto-char (match-end 0)))
+
+ ;; MX::Method::Signatures signature
+ (while (looking-at (concat
+ ;; type name
+ "[[:space:]]*\\(?:\\([A-Za-z:_|]+\\)[[:space:]]+\\)?"
+ ;; variable name (named) (required/optional)
+ "[:]?\\([$@%*;][A-Za-z:_]+\\)[!?]?[[:space:]]*"
+ "\\(\\(?:[[:space:]]*\\(?:"
+ "\\(?:does\\|is\\) +[A-Za-z:_]+\\|"
+ "where *{[^}]*}\\|"
+ " *= *[A-Za-z:_0-9]+"
+ "\\)\\)*\\)[[:space:]]*"
+ ;; end with invocant separator, comma, or end of string
+ "\\([,:]\\|$\\)"))
+ (when (match-string 1)
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'font-lock-face 'font-lock-type-face))
+ (put-text-property (match-beginning 2) (match-end 2)
+ 'font-lock-face 'font-lock-variable-name-face)
+ (when (match-string 3)
+ (put-text-property (match-beginning 3) (match-end 3)
+ 'font-lock-face 'font-lock-keyword-face))
+ ;; This doesn't work right, it kills the other faces :(
+ ;; (if (equal (match-string 4) ":")
+ ;; (put-text-property (match-beginning 0) (match-end 0)
+ ;; 'font-lock-face '(:underline t)))
+ (goto-char (match-end 0)))))))
+ t)
+
(defvar cperl-starters '(( ?\( . ?\) )
( ?\[ . ?\] )
( ?\{ . ?\} )
@@ -4693,8 +4750,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(goto-char b)
(if (eq (char-after (match-beginning 17)) ?\( )
(progn
- (cperl-commentify ; Prototypes; mark as string
- (match-beginning 17) (match-end 17) t)
+ (cperl-fontify-method-signature
+ (match-beginning 17) (match-end 17))
(goto-char (match-end 0))
;; Now look for attributes after prototype:
(forward-comment (buffer-size))
Please sign in to comment.
Something went wrong with that request. Please try again.