Function: cperl-unwind-to-safe

cperl-unwind-to-safe is a byte-compiled function defined in cperl-mode.el.gz.

Signature

(cperl-unwind-to-safe BEFORE &optional END)

Documentation

Move point back to a safe place, back up one extra line if BEFORE.

A place is "safe" if it is not within POD, a here-document, a format, a quote-like expression, a subroutine attribute list or a multiline declaration. These places all have special syntactical rules and need to be parsed as a whole. If END, return the position of the end of the unsafe construct.

Source Code

;; Defined in /usr/src/emacs/lisp/progmodes/cperl-mode.el.gz
;; Here is how the global structures (those which cannot be
;; recognized locally) are marked:
;;	a) PODs:
;;		Start-to-end is marked `in-pod' ==> t
;;		Each non-literal part is marked `syntax-type' ==> `pod'
;;		Each literal part is marked `syntax-type' ==> `in-pod'
;;	b) HEREs:
;;              The point before start is marked `here-doc-start'
;;		Start-to-end is marked `here-doc-group' ==> t
;;		The body is marked `syntax-type' ==> `here-doc'
;;                and is also marked as style 2 comment
;;		The delimiter is marked `syntax-type' ==> `here-doc-delim'
;;	c) FORMATs:
;;		First line (to =) marked `first-format-line' ==> t
;;		After-this--to-end is marked `syntax-type' ==> `format'
;;	d) 'Q'uoted string:
;;		part between markers inclusive is marked `syntax-type' ==> `string'
;;		part between `q' and the first marker is marked `syntax-type' ==> `prestring'
;;		second part of s///e is marked `syntax-type' ==> `multiline'
;;	e) Attributes of subroutines: `attrib-group' ==> t
;;		(or 0 if declaration); up to `{' or ';': `syntax-type' => `sub-decl'.
;;      f) Multiline my/our declaration lists etc: `syntax-type' => `multiline'

;; In addition, some parts of RExes may be marked as `REx-interpolated'
;; (value: 0 in //o, 1 if "interpolated variable" is whole-REx, t otherwise).

(defun cperl-unwind-to-safe (before &optional end)
  "Move point back to a safe place, back up one extra line if BEFORE.
A place is \"safe\" if it is not within POD, a here-document, a
format, a quote-like expression, a subroutine attribute list or a
multiline declaration.  These places all have special syntactical
rules and need to be parsed as a whole.  If END, return the
position of the end of the unsafe construct."
  (let ((pos (point))
        (state (syntax-ppss)))
    ;; Check edge cases for here-documents first
    (when before                        ; we need a safe start for parsing
      (cond
       ((or (equal (get-text-property (cperl-1- (point)) 'syntax-type)
                   'here-doc-start)
            (equal (syntax-after (cperl-1- (point)))
                   (string-to-syntax "> c")))
        ;; point is either immediately after the start of a here-doc
        ;; (which may consist of nothing but one newline) or
        ;; immediately after the now-outdated end marker of the
        ;; here-doc. In both cases we need to back up to the line
        ;; where the here-doc delimiters are defined.
        (forward-char -1)
        (cperl-backward-to-noncomment (point-min))
        (beginning-of-line))
       ((eq 2 (nth 7 state))
        ;; point is somewhere in a here-document.  Back up to the line
        ;; where the here-doc delimiters are defined.
        (goto-char (nth 8 state))      ; beginning of this here-doc
        (cperl-backward-to-noncomment  ; skip back over more
         (point-min))                  ;     here-documents (if any)
        (beginning-of-line))           ; skip back over here-doc starters
       ((nth 4 state)                  ; in a comment (or POD)
        (goto-char (nth 8 state)))))   ; ...so go to its beginning
    (while (and pos (progn
		      (beginning-of-line)
		      (get-text-property (setq pos (point)) 'syntax-type)))
      (setq pos (cperl-beginning-of-property pos 'syntax-type))
      (if (eq pos (point-min))
	  (setq pos nil))
      (if pos
	  (if before
	      (progn
		(goto-char (cperl-1- pos))
		(beginning-of-line)
		(setq pos (point)))
	    (goto-char (setq pos (cperl-1- pos))))
	;; Up to the start
	(goto-char (point-min))))
    ;; Skip empty lines
    (and (looking-at "\n*=")
	 (/= 0 (skip-chars-backward "\n"))
	 (forward-char))
    (setq pos (point))
    (if end
	;; Do the same for end, going small steps
	(save-excursion
	  (while (and end (< end (point-max))
		      (get-text-property end 'syntax-type))
	    (setq pos end
		  end (next-single-property-change end 'syntax-type nil (point-max)))
	    (if end (progn (goto-char end)
			   (or (bolp) (forward-line 1))
			   (setq end (point)))))
	  (or end pos)))))