Function: cperl-process-here-doc

cperl-process-here-doc is a byte-compiled function defined in cperl-mode.el.gz.

Signature

(cperl-process-here-doc MIN MAX END OVERSHOOT STOP-POINT END-OF-HERE-DOC ERR-L INDENTED-HERE-DOC-P MATCHED-POS TODO-POS DELIM-BEGIN DELIM-END)

Documentation

Process a here-document's delimiters and body.

The parameters MIN, MAX, END, OVERSHOOT, STOP-POINT, ERR-L are used for recursive calls to cperl-find-pods-here to handle the rest of the line which contains the delimiter. MATCHED-POS and TODO-POS are initial values for this function's result. END-OF-HERE-DOC is the end of a previous here-doc in the same line, or nil if this is the first. DELIM-BEGIN and DELIM-END are the positions where the here-document's delimiter has been found. This is part of cperl-find-pods-heres (below).

Source Code

;; Defined in /usr/src/emacs/lisp/progmodes/cperl-mode.el.gz
	   (error nil)))))) ; func(<<EOF)

(defun cperl-process-here-doc (min max end overshoot stop-point
                                   end-of-here-doc err-l
                                   indented-here-doc-p
                                   matched-pos todo-pos
                                   delim-begin delim-end)
  "Process a here-document's delimiters and body.
The parameters MIN, MAX, END, OVERSHOOT, STOP-POINT, ERR-L are
used for recursive calls to `cperl-find-pods-here' to handle the
rest of the line which contains the delimiter.  MATCHED-POS and
TODO-POS are initial values for this function's result.
END-OF-HERE-DOC is the end of a previous here-doc in the same
line, or nil if this is the first.  DELIM-BEGIN and DELIM-END are
the positions where the here-document's delimiter has been found.
This is part of `cperl-find-pods-heres' (below)."
  (let* ((my-cperl-delimiters-face font-lock-constant-face)
         (delimiter (buffer-substring-no-properties delim-begin delim-end))
         (qtag (regexp-quote delimiter))
         (use-syntax-state (and cperl-syntax-state
                                (>= min (car cperl-syntax-state))))
         (state-point (if use-syntax-state
			  (car cperl-syntax-state)
                        (point-min)))
         (state (if use-syntax-state
		    (cdr cperl-syntax-state)))
         here-doc-start here-doc-end defs-eol
         warning-message)
    (when cperl-pod-here-fontify
      ;; Highlight the starting delimiter
      (cperl-postpone-fontification delim-begin delim-end
                                    'face my-cperl-delimiters-face)
      (cperl-put-do-not-fontify delim-begin delim-end t))
    (forward-line)
    (setq here-doc-start (point) ; first char of (first) here-doc
          defs-eol (1- here-doc-start)) ; end of definitions line
    (if end-of-here-doc
        ;; skip to the end of the previous here-doc
	(goto-char end-of-here-doc)
      ;; otherwise treat the first (or only) here-doc: Check for
      ;; special cases if the line containing the delimiter(s)
      ;; ends in a regular comment or a solitary ?#
      (let* ((eol-state (save-excursion (syntax-ppss defs-eol))))
        (when (nth 4 eol-state) ; EOL is in a comment
          (if (= (1- defs-eol) (nth 8 eol-state))
              ;; line ends with a naked comment starter.
              ;; We let it start the here-doc.
              (progn
                (put-text-property (1- defs-eol) defs-eol
                                   'font-lock-face
                                   'font-lock-comment-face)
                (put-text-property (1- defs-eol) defs-eol
                                   'syntax-type 'here-doc)
                (put-text-property (1- defs-eol) defs-eol
                                   'syntax-type 'here-doc)
                (put-text-property (1- defs-eol) defs-eol
                                   'syntax-table
                                   (string-to-syntax "< c"))
                )
            ;; line ends with a "regular" comment: make
            ;; the last character of the comment closing
            ;; it so that we can use the line feed to
            ;; start the here-doc
            (put-text-property (1- defs-eol) defs-eol
                               'syntax-table
                               (string-to-syntax ">"))))))
    (setq here-doc-start (point)) ; now points to current here-doc
    ;; Find the terminating delimiter.
    ;; We do not search to max, since we may be called from
    ;; some hook of fontification, and max is random
    (or (re-search-forward
	 (concat "^" (when indented-here-doc-p "[ \t]*")
		 qtag "$")
	 stop-point 'toend)
	(progn		; Pretend we matched at the end
	  (goto-char (point-max))
	  (re-search-forward "\\'")
	  (setq warning-message
                (format "End of here-document `%s' not found." delimiter))
	  (or (car err-l) (setcar err-l here-doc-start))))
    (when cperl-pod-here-fontify
      ;; Highlight the ending delimiter
      (cperl-postpone-fontification
       (match-beginning 0) (match-end 0)
       'face my-cperl-delimiters-face)
      (cperl-put-do-not-fontify here-doc-start (match-end 0) t))
    (setq here-doc-end (cperl-1+ (match-end 0))) ; eol after delim
    (put-text-property here-doc-start (match-beginning 0)
		       'syntax-type 'here-doc)
    (put-text-property (match-beginning 0) here-doc-end
		       'syntax-type 'here-doc-delim)
    (put-text-property here-doc-start here-doc-end 'here-doc-group t)
    ;; This makes insertion at the start of HERE-DOC update
    ;; the whole construct:
    (put-text-property here-doc-start (cperl-1+ here-doc-start) 'front-sticky '(syntax-type))
    (cperl-commentify (match-beginning 0) (1- here-doc-end) nil)
    (put-text-property (1- here-doc-start) here-doc-start
                       'syntax-type 'here-doc-start)
    (when (> (match-beginning 0) here-doc-start)
      ;; here-document has non-zero length
      (cperl-modify-syntax-type (1- here-doc-start) (string-to-syntax "< c"))
      (cperl-modify-syntax-type (1- (match-beginning 0))
                                (string-to-syntax "> c")))
    (cperl-put-do-not-fontify here-doc-start (match-end 0) t)
    ;; Cache the syntax info...
    (setq cperl-syntax-state (cons state-point state))
    ;; ... and process the rest of the line...
    (setq overshoot
	  (elt		; non-inter ignore-max
	   (cperl-find-pods-heres todo-pos defs-eol
                                  t end t here-doc-end)
           1))
    (if (and overshoot (> overshoot (point)))
	(goto-char overshoot)
      (setq overshoot here-doc-end))
    (list (if (> here-doc-end max) matched-pos nil)
          overshoot
          warning-message)))