Function: cperl-find-sub-attrs

cperl-find-sub-attrs is a byte-compiled function defined in cperl-mode.el.gz.

Signature

(cperl-find-sub-attrs &optional ST-L B-FNAME E-FNAME POS)

Documentation

Syntactically mark (and fontify) attributes of a subroutine.

Within attributes, parentheses and text between them have weird syntactical properties which are likely to mess up search-based fontification. Therefore they are fontified explicitly here. Should be called with the point before leading colon of an attribute. ST-L and POS are a cached from a previous call.

Source Code

;; Defined in /usr/src/emacs/lisp/progmodes/cperl-mode.el.gz
(defun cperl-find-sub-attrs (&optional st-l _b-fname _e-fname pos)
  "Syntactically mark (and fontify) attributes of a subroutine.
Within attributes, parentheses and text between them have weird
syntactical properties which are likely to mess up search-based
fontification.  Therefore they are fontified explicitly here.
Should be called with the point before leading colon of
an attribute.  ST-L and POS are a cached from a previous call."
  ;; Works *before* syntax recognition is done
  (or st-l (setq st-l (list nil)))	; Avoid overwriting '()
  (let (st p reset-st after-first (start (point)) start1 end1)
    (condition-case b
	(while (looking-at
		(concat
		 "\\("			; 1=optional? colon
		   ":" cperl-maybe-white-and-comment-rex ; 2=whitespace/comment?
		 "\\)"
		 (if after-first "?" "")
		 ;; No space between name and paren allowed...
		 (rx (group (eval cperl--basic-identifier-rx)))	; 3=name
		 "\\((\\)?"))		; 4=optional paren
	  (and (match-beginning 1)
	       (cperl-postpone-fontification
		(match-beginning 0) (cperl-1+ (match-beginning 0))
                'face 'font-lock-constant-face))
	  (setq start1 (match-beginning 3) end1 (match-end 3))
	  (cperl-postpone-fontification start1 end1
                                        'face 'font-lock-constant-face)
	  (goto-char end1)		; end or before `('
	  (if (match-end 4)		; Have attribute arguments...
	      (progn
		(if st nil
		  (setq st (cperl-cached-syntax-table st-l))
		  (modify-syntax-entry ?\( "()" st)
		  (modify-syntax-entry ?\) ")(" st))
		(setq reset-st (syntax-table) p (point))
		(set-syntax-table st)
		(forward-sexp 1)
		(set-syntax-table reset-st)
		(setq reset-st nil)
		(cperl-commentify p (point) t))) ; mark as string
	  (forward-comment (buffer-size))
	  (setq after-first t))
      (error (message
	      "L%d: attribute `%s': %s"
	      (count-lines (point-min) (point))
	      (and start1 end1 (buffer-substring start1 end1)) b)
	     ; (setq start nil) I'd like to keep trying -- haj 2023-06-26
             ))
    (cond
     ;; Allow for a complete signature and trailing spaces here
     ((search-forward-regexp (rx (sequence point
                                           (eval cperl--ws*-rx)
                                           (eval cperl--signature-rx)
                                           (eval cperl--ws*-rx)))
                             nil
                             t)) ; NOERROR
     ((looking-at (rx "("))
      ;; We might be in the process of typing a prototype or
      ;; signature.  These start with a left paren, so we want this to
      ;; be included into the area marked as sub-decl.
      nil)
     ;; Else, we are in no mans land.  Just keep trying.
     (t
      ))
    (when (looking-at (rx (in ";{")))
      ;; A semicolon ends the declaration, an opening brace begins the
      ;; BLOCK.  Neither is part of the declaration.
      (backward-char))
    (when start
      (put-text-property start (point)
                         'attrib-group (if (looking-at "{") t 0))
        (and pos
             (progn
               ;; Apparently, we do not need `multiline': faces added now
               (put-text-property (+ 3 pos) (cperl-1+ (point))
                                  'syntax-type 'sub-decl))))
    ;; now restore the initial state
    (if st
	(progn
	  (modify-syntax-entry ?\( "." st)
	  (modify-syntax-entry ?\) "." st)))
    (if reset-st
	(set-syntax-table reset-st))))