Function: cperl-sniff-for-indent
cperl-sniff-for-indent is a byte-compiled function defined in
cperl-mode.el.gz.
Signature
(cperl-sniff-for-indent &optional PARSE-DATA)
Source Code
;; Defined in /usr/src/emacs/lisp/progmodes/cperl-mode.el.gz
(defun cperl-sniff-for-indent (&optional parse-data) ; was parse-start
;; the sniffer logic to understand what the current line MEANS.
(cperl-update-syntaxification (point))
(let ((res (get-text-property (point) 'syntax-type)))
(save-excursion
(cond
((and (memq res '(pod here-doc here-doc-delim format))
(not (get-text-property (point) 'indentable)))
(vector res))
;; before start of POD - whitespace found since do not have 'pod!
((looking-at "[ \t]*\n=")
(error "Spaces before POD section!"))
((and (not cperl-indent-left-aligned-comments)
(looking-at "^#"))
[comment-special:at-beginning-of-line])
((get-text-property (point) 'in-pod)
[in-pod])
(t
(beginning-of-line)
(let* ((indent-point (point))
(char-after-pos (save-excursion
(skip-chars-forward " \t")
(point)))
(char-after (char-after char-after-pos))
(pre-indent-point (point))
p prop look-prop is-block delim)
(save-excursion ; Know we are not in POD, find appropriate pos before
(cperl-backward-to-noncomment nil)
(setq p (max (point-min) (1- (point)))
prop (get-text-property p 'syntax-type)
look-prop (or (nth 1 (assoc prop cperl-look-for-prop))
'syntax-type))
(if (memq prop '(pod here-doc format here-doc-delim))
(progn
(goto-char (cperl-beginning-of-property p look-prop))
(beginning-of-line)
(setq pre-indent-point (point)))))
(goto-char pre-indent-point) ; Orig line skipping preceding pod/etc
(let* ((case-fold-search nil)
(s-s (cperl-get-state (car parse-data) (nth 1 parse-data)))
(start (or (nth 2 parse-data) ; last complete sexp terminated
(nth 0 s-s))) ; Good place to start parsing
(state (nth 1 s-s))
(containing-sexp (car (cdr state)))
old-indent)
(if (and
;;containing-sexp ;; We are buggy at toplevel :-(
parse-data)
(progn
(setcar parse-data pre-indent-point)
(setcar (cdr parse-data) state)
(or (nth 2 parse-data)
(setcar (cddr parse-data) start))
;; Before this point: end of statement
(setq old-indent (nth 3 parse-data))))
(cond ((get-text-property (point) 'indentable)
;; indent to "after" the surrounding open
;; (same offset as `cperl-beautify-regexp-piece'),
;; skip blanks if we do not close the expression.
(setq delim ; We do not close the expression
(get-text-property
(cperl-1+ char-after-pos) 'indentable)
p (1+ (cperl-beginning-of-property
(point) 'indentable))
is-block ; misused for: preceding line in REx
(save-excursion ; Find preceding line
(cperl-backward-to-noncomment p)
(beginning-of-line)
(if (<= (point) p)
(progn ; get indent from the first line
(goto-char p)
(skip-chars-forward " \t")
(if (memq (char-after (point))
(append "#\n" nil))
nil ; Can't use indentation of this line...
(point)))
(skip-chars-forward " \t")
(point)))
prop (parse-partial-sexp p char-after-pos))
(cond ((not delim) ; End the REx, ignore is-block
(vector 'indentable 'terminator p is-block))
(is-block ; Indent w.r.t. preceding line
(vector 'indentable 'cont-line char-after-pos
is-block char-after p))
(t ; No preceding line...
(vector 'indentable 'first-line p))))
((get-text-property char-after-pos 'REx-part2)
(vector 'REx-part2 (point)))
((nth 4 state)
[comment])
((nth 3 state)
[string])
;; XXXX Do we need to special-case this?
((null containing-sexp)
;; Line is at top level. May be data or function definition,
;; or may be function argument declaration.
;; Indent like the previous top level line
;; unless that ends in a closeparen without semicolon,
;; in which case this line is the first argument decl.
(skip-chars-forward " \t")
(cperl-backward-to-noncomment (or old-indent (point-min)))
(setq state
(or (bobp)
(eq (point) old-indent) ; old-indent was at comment
(eq (preceding-char) ?\;)
;; Had ?\) too
(and (eq (preceding-char) ?\})
(cperl-after-block-and-statement-beg
(point-min))) ; Was start - too close
(and char-after (char-equal char-after ?{)
(save-excursion (cperl-block-declaration-p)))
(memq char-after (append ")]}" nil))
(and (eq (preceding-char) ?\:) ; label
(progn
(forward-sexp -1)
(skip-chars-backward " \t")
(looking-at
(rx (sequence (0+ blank)
(eval cperl--label-rx))))))
(get-text-property (point) 'first-format-line)))
;; Look at previous line that's at column 0
;; to determine whether we are in top-level decls
;; or function's arg decls. Set basic-indent accordingly.
;; Now add a little if this is a continuation line.
(and state
parse-data
(not (eq char-after ?\C-j))
(setcdr (cddr parse-data)
(list pre-indent-point)))
(vector 'toplevel start char-after state (nth 2 s-s)))
((not
(or (setq is-block
(and (setq delim (= (char-after containing-sexp) ?{))
(save-excursion ; Is it a hash?
(goto-char containing-sexp)
(cperl-block-p))))
cperl-indent-parens-as-block))
;; group is an expression, not a block:
;; indent to just after the surrounding open parens,
;; skip blanks if we do not close the expression.
(goto-char (1+ containing-sexp))
(or (memq char-after
(append (if delim "}" ")]}") nil))
(looking-at "[ \t]*\\(#\\|$\\)")
(skip-chars-forward " \t"))
(setq old-indent (point)) ; delim=is-brace
(vector 'in-parens char-after (point) delim containing-sexp))
(t
;; Statement level. Is it a continuation or a new statement?
;; Find previous non-comment character.
(goto-char pre-indent-point) ; Skip one level of POD/etc
(cperl-backward-to-noncomment containing-sexp)
;; Back up over label lines, since they don't
;; affect whether our line is a continuation.
;; (Had \, too)
(while (and (eq (preceding-char) ?:)
(re-search-backward
(rx (sequence (eval cperl--label-rx) point))
nil t))
;; This is always FALSE?
(if (eq (preceding-char) ?\,)
;; Will go to beginning of line, essentially.
;; Will ignore embedded sexpr XXXX.
(cperl-backward-to-start-of-continued-exp containing-sexp))
(beginning-of-line)
(cperl-backward-to-noncomment containing-sexp))
;; Now we get non-label preceding the indent point
(if (not (or (eq (1- (point)) containing-sexp)
(and cperl-indent-parens-as-block
(not is-block))
(save-excursion (cperl-block-declaration-p))
(memq (preceding-char)
(append (if is-block " ;{" " ,;{") '(nil)))
(and (eq (preceding-char) ?\})
(cperl-after-block-and-statement-beg
containing-sexp))
(get-text-property (point) 'first-format-line)))
;; This line is continuation of preceding line's statement;
;; indent `cperl-continued-statement-offset' more than the
;; previous line of the statement.
;;
;; There might be a label on this line, just
;; consider it bad style and ignore it.
(progn
(cperl-backward-to-start-of-continued-exp containing-sexp)
(vector 'continuation (point) char-after is-block delim))
;; This line starts a new statement.
;; Position following last unclosed open brace
(goto-char containing-sexp)
;; Is line first statement after an open-brace?
(or
;; If no, find that first statement and indent like
;; it. If the first statement begins with label, do
;; not believe when the indentation of the label is too
;; small.
(save-excursion
(forward-char 1)
(let ((colon-line-end 0))
(while
(progn
(skip-chars-forward " \t\n")
;; s: foo : bar :x is NOT label
(and (looking-at
(rx
(or "#"
(sequence (eval cperl--label-rx)
(not (in ":")))
(sequence "=" (in "a-zA-Z")))))
(not (looking-at
(rx (eval cperl--false-label-rx))))))
;; Skip over comments and labels following openbrace.
(cond ((= (following-char) ?\#)
(forward-line 1))
((= (following-char) ?\=)
(goto-char
(or (next-single-property-change (point) 'in-pod)
(point-max)))) ; do not loop if no syntaxification
;; label:
(t
(setq colon-line-end (line-end-position))
(search-forward ":"))))
;; We are at beginning of code (NOT label or comment)
;; First, the following code counts
;; if it is before the line we want to indent.
(and (< (point) indent-point)
(vector 'have-prev-sibling (point) colon-line-end
containing-sexp))))
(progn
;; If no previous statement,
;; indent it relative to line brace is on.
;; For open-braces not the first thing in a line,
;; add in cperl-brace-imaginary-offset.
;; If first thing on a line: ?????
;; Move back over whitespace before the openbrace.
(setq ; brace first thing on a line
old-indent (progn (skip-chars-backward " \t") (bolp)))
;; Should we indent w.r.t. earlier than start?
;; Move to start of control group, possibly on a different line
(or cperl-indent-wrt-brace
(cperl-backward-to-noncomment (point-min)))
;; If the openbrace is preceded by a parenthesized exp,
;; move to the beginning of that;
(if (eq (preceding-char) ?\))
(progn
(forward-sexp -1)
(cperl-backward-to-noncomment (point-min))))
;; In the case it starts a subroutine, indent with
;; respect to `sub', not with respect to the
;; first thing on the line, say in the case of
;; anonymous sub in a hash.
(if (and;; Is it a sub in group starting on this line?
cperl-indent-subs-specially
(cond ((get-text-property (point) 'attrib-group)
(goto-char (cperl-beginning-of-property
(point) 'attrib-group)))
((eq (preceding-char) ?b)
(forward-sexp -1)
(looking-at (concat cperl-sub-regexp "\\>"))))
(setq p (nth 1 ; start of innermost containing list
(parse-partial-sexp
(line-beginning-position)
(point)))))
(progn
(goto-char (1+ p)) ; enclosing block on the same line
(skip-chars-forward " \t")
(vector 'code-start-in-block containing-sexp char-after
(and delim (not is-block)) ; is a HASH
old-indent ; brace first thing on a line
t (point) ; have something before...
)
;;(current-column)
)
;; Get initial indentation of the line we are on.
;; If line starts with label, calculate label indentation
(vector 'code-start-in-block containing-sexp char-after
(and delim (not is-block)) ; is a HASH
old-indent ; brace first thing on a line
nil (point))))))))))))))) ; nothing interesting before