(forward-line)) ; no infinite loop with, e.g., "#//"
)))))
- (c-literal-type end-limits)))
+(defun c-unescaped-nls-in-string-p (&optional quote-pos)
+ ;; Return whether unescaped newlines can be inside strings.
+ ;;
+ ;; QUOTE-POS, if present, is the position of the opening quote of a string.
+ ;; Depending on the language, there might be a special character before it
+ ;; signifying the validity of such NLs.
+ (cond
+ ((null c-multiline-string-start-char) nil)
+ ((c-characterp c-multiline-string-start-char)
+ (and quote-pos
+ (eq (char-before quote-pos) c-multiline-string-start-char)))
+ (t t)))
+
+(defun c-multiline-string-start-is-being-detached (end)
+ ;; If (e.g.), the # character in Pike is being detached from the string
+ ;; opener it applies to, return t. Else return nil. END is the argument
+ ;; supplied to every before-change function.
+ (and (memq (char-after end) c-string-delims)
+ (c-characterp c-multiline-string-start-char)
+ (eq (char-before end) c-multiline-string-start-char)))
+
+(defun c-pps-to-string-delim (end)
+ ;; parse-partial-sexp forward to the next string quote, which is deemed to
+ ;; be a closing quote. Return nil.
+ ;;
+ ;; We remove string-fence syntax-table text properties from characters we
+ ;; pass over.
+ (let* ((start (point))
+ (no-st-s `(0 nil nil ?\" nil nil 0 nil ,start nil nil))
+ (st-s `(0 nil nil t nil nil 0 nil ,start nil nil))
+ no-st-pos st-pos
+ )
+ (parse-partial-sexp start end nil nil no-st-s 'syntax-table)
+ (setq no-st-pos (point))
+ (goto-char start)
+ (while (progn
+ (parse-partial-sexp (point) end nil nil st-s 'syntax-table)
+ (unless (bobp)
+ (c-clear-char-property (1- (point)) 'syntax-table))
+ (setq st-pos (point))
+ (and (< (point) end)
+ (not (eq (char-before) ?\")))))
+ (goto-char (min no-st-pos st-pos))
+ nil))
+
+(defun c-multiline-string-check-final-quote ()
+ ;; Check that the final quote in the buffer is correctly marked or not with
+ ;; a string-fence syntax-table text propery. The return value has no
+ ;; significance.
+ (let (pos-ll pos-lt)
+ (save-excursion
+ (goto-char (point-max))
+ (skip-chars-backward "^\"")
+ (while
+ (and
+ (not (bobp))
+ (cond
+ ((progn
+ (setq pos-ll (c-literal-limits)
+ pos-lt (c-literal-type pos-ll))
+ (memq pos-lt '(c c++)))
+ ;; In a comment.
+ (goto-char (car pos-ll)))
+ ((save-excursion
+ (backward-char) ; over "
+ (eq (logand (skip-chars-backward "\\\\") 1) 1))
+ ;; At an escaped string.
+ (backward-char)
+ t)
+ (t
+ ;; At a significant "
+ (c-clear-char-property (1- (point)) 'syntax-table)
+ (setq pos-ll (c-literal-limits)
+ pos-lt (c-literal-type pos-ll))
+ nil)))
+ (skip-chars-backward "^\""))
+ (cond
+ ((bobp))
+ ((eq pos-lt 'string)
+ (c-put-char-property (1- (point)) 'syntax-table '(15)))
+ (t nil)))))
+
+(defvar c-bc-changed-stringiness nil)
+;; Non-nil when, in a before-change function, the deletion of a range of text
+;; will change the "stringiness" of the subsequent text. Only used when
+;; `c-multiline-sting-start-char' is a non-nil value which isn't a character.
+
+(defun c-before-change-check-unbalanced-strings (beg end)
+ ;; If BEG or END is inside an unbalanced string, remove the syntax-table
+ ;; text property from respectively the start or end of the string. Also
+ ;; extend the region (c-new-BEG c-new-END) as necessary to cope with the
+ ;; coming change involving the insertion or deletion of an odd number of
+ ;; quotes.
+ ;;
+ ;; POINT is undefined both at entry to and exit from this function, the
+ ;; buffer will have been widened, and match data will have been saved.
+ ;;
+ ;; This function is called exclusively as a before-change function via
+ ;; `c-get-state-before-change-functions'.
+ (c-save-buffer-state
+ ((end-limits
+ (progn
+ (goto-char (if (c-multiline-string-start-is-being-detached end)
+ (1+ end)
+ end))
+ (c-literal-limits)))
+ (end-literal-type (and end-limits
- (c-literal-type beg-limits))))
++ (c-literal-type end-limits)))
+ (beg-limits
+ (progn
+ (goto-char beg)
+ (c-literal-limits)))
+ (beg-literal-type (and beg-limits
++ (c-literal-type beg-limits))))
+
+ (when (eq end-literal-type 'string)
+ (setq c-new-END (max c-new-END (cdr end-limits))))
+ ;; It is possible the buffer change will include inserting a string quote.
+ ;; This could have the effect of flipping the meaning of any following
+ ;; quotes up until the next unescaped EOL. Also guard against the change
+ ;; being the insertion of \ before an EOL, escaping it.
+ (cond
+ ((c-characterp c-multiline-string-start-char)
+ ;; The text about to be inserted might contain a multiline string
+ ;; opener. Set c-new-END after anything which might be affected.
+ ;; Go to the end of the putative multiline string.
+ (goto-char end)
+ (c-pps-to-string-delim (point-max))
+ (when (< (point) (point-max))
+ (while
+ (and
+ (progn
+ (while
+ (and
+ (c-syntactic-re-search-forward
+ "\"\\|\\s|" (point-max) t t)
+ (progn
+ (c-clear-char-property (1- (point)) 'syntax-table)
+ (not (eq (char-before) ?\")))))
+ (eq (char-before) ?\"))
+ (progn
+ (c-pps-to-string-delim (point-max))
+ (< (point) (point-max))))))
+ (setq c-new-END (max (point) c-new-END)))
+
+ (c-multiline-string-start-char
+ (setq c-bc-changed-stringiness
+ (not (eq (eq end-literal-type 'string)
+ (eq beg-literal-type 'string))))
+ ;; Deal with deletion of backslashes before "s.
+ (goto-char end)
+ (if (and (looking-at "\\\\*\"")
+ (eq (logand (skip-chars-backward "\\\\" beg) 1) 1))
+ (setq c-bc-changed-stringiness (not c-bc-changed-stringiness)))
+ (if (eq beg-literal-type 'string)
+ (setq c-new-BEG (min (car beg-limits) c-new-BEG))))
+
+ ((< c-new-END (point-max))
+ (goto-char (1+ c-new-END)) ; might be a newline.
+ ;; In the following regexp, the initial \n caters for a newline getting
+ ;; joined to a preceding \ by the removal of what comes between.
+ (re-search-forward "[\n\r]?\\(\\\\\\(.\\|\n\\|\r\\)\\|[^\\\n\r]\\)*"
+ nil t)
+ ;; We're at an EOLL or point-max.
+ (setq c-new-END (min (1+ (point)) (point-max)))
+ (goto-char c-new-END)
+ (if (equal (c-get-char-property (1- (point)) 'syntax-table) '(15))
+ (if (memq (char-before) '(?\n ?\r))
+ ;; Normally terminated invalid string.
+ (progn
+ (backward-sexp)
+ (c-clear-char-property (1- c-new-END) 'syntax-table)
+ (c-clear-char-property (point) 'syntax-table))
+ ;; Opening " at EOB.
+ (c-clear-char-property (1- (point)) 'syntax-table))
+ (if (c-search-backward-char-property 'syntax-table '(15) c-new-BEG)
+ ;; Opening " on last line of text (without EOL).
+ (c-clear-char-property (point) 'syntax-table))))
+
+ (t (goto-char c-new-END)
+ (if (c-search-backward-char-property 'syntax-table '(15) c-new-BEG)
+ (c-clear-char-property (point) 'syntax-table))))
+
+ (unless (and c-multiline-string-start-char
+ (not (c-characterp c-multiline-string-start-char)))
+ (when (eq end-literal-type 'string)
+ (c-clear-char-property (1- (cdr end-limits)) 'syntax-table))
+
+ (when (eq beg-literal-type 'string)
+ (setq c-new-BEG (min c-new-BEG (car beg-limits)))
+ (c-clear-char-property (car beg-limits) 'syntax-table)))))
+
+(defun c-after-change-re-mark-unbalanced-strings (beg end _old-len)
+ ;; Mark any unbalanced strings in the region (c-new-BEG c-new-END) with
+ ;; string fence syntax-table text properties.
+ ;;
+ ;; POINT is undefined both at entry to and exit from this function, the
+ ;; buffer will have been widened, and match data will have been saved.
+ ;;
+ ;; This function is called exclusively as an after-change function via
+ ;; `c-before-font-lock-functions'.
+ (if (and c-multiline-string-start-char
+ (not (c-characterp c-multiline-string-start-char)))
+ ;; Only the last " might need to be marked.
+ (c-save-buffer-state
+ ((beg-literal-limits
+ (progn (goto-char beg) (c-literal-limits)))
+ (beg-literal-type (c-literal-type beg-literal-limits))
+ end-literal-limits end-literal-type)
+ (when (and (eq beg-literal-type 'string)
+ (c-get-char-property (car beg-literal-limits) 'syntax-table))
+ (c-clear-char-property (car beg-literal-limits) 'syntax-table)
+ (setq c-bc-changed-stringiness (not c-bc-changed-stringiness)))
+ (setq end-literal-limits (progn (goto-char end) (c-literal-limits))
+ end-literal-type (c-literal-type end-literal-limits))
+ ;; Deal with the insertion of backslashes before a ".
+ (goto-char end)
+ (if (and (looking-at "\\\\*\"")
+ (eq (logand (skip-chars-backward "\\\\" beg) 1) 1))
+ (setq c-bc-changed-stringiness (not c-bc-changed-stringiness)))
+ (when (eq (eq (eq beg-literal-type 'string)
+ (eq end-literal-type 'string))
+ c-bc-changed-stringiness)
+ (c-multiline-string-check-final-quote)))
+ ;; There could be several "s needing marking.
+ (c-save-buffer-state
+ ((cll (progn (goto-char c-new-BEG)
+ (c-literal-limits)))
+ (beg-literal-type (and cll (c-literal-type cll)))
+ (beg-limits
+ (cond
+ ((and (eq beg-literal-type 'string)
+ (c-unescaped-nls-in-string-p (car cll)))
+ (cons
+ (car cll)
+ (progn
+ (goto-char (1+ (car cll)))
+ (search-forward-regexp
+ (cdr (assq (char-after (car cll)) c-string-innards-re-alist))
+ nil t)
+ (min (1+ (point)) (point-max)))))
+ ((and (null beg-literal-type)
+ (goto-char beg)
+ (eq (char-before) c-multiline-string-start-char)
+ (memq (char-after) c-string-delims))
+ (cons (point)
+ (progn
+ (forward-char)
+ (search-forward-regexp
+ (cdr (assq (char-before) c-string-innards-re-alist)) nil t)
+ (1+ (point)))))
+ (cll)))
+ s)
+ (goto-char
+ (cond ((null beg-literal-type)
+ c-new-BEG)
+ ((eq beg-literal-type 'string)
+ (car beg-limits))
+ (t ; comment
+ (cdr beg-limits))))
+ (while
+ (and
+ (< (point) c-new-END)
+ (progn
+ ;; Skip over any comments before the next string.
+ (while (progn
+ (setq s (parse-partial-sexp (point) c-new-END nil
+ nil s 'syntax-table))
+ (and (not (nth 3 s))
+ (< (point) c-new-END)
+ (not (memq (char-before) c-string-delims)))))
+ ;; We're at the start of a string.
+ (memq (char-before) c-string-delims)))
+ (if (c-unescaped-nls-in-string-p (1- (point)))
+ (looking-at "\\(\\\\\\(.\\|\n|\\\r\\)\\|[^\"]\\)*")
+ (looking-at (cdr (assq (char-before) c-string-innards-re-alist))))
+ (cond
+ ((memq (char-after (match-end 0)) '(?\n ?\r))
+ (c-put-char-property (1- (point)) 'syntax-table '(15))
+ (c-put-char-property (match-end 0) 'syntax-table '(15)))
+ ((or (eq (match-end 0) (point-max))
+ (eq (char-after (match-end 0)) ?\\)) ; \ at EOB
+ (c-put-char-property (1- (point)) 'syntax-table '(15))))
+ (goto-char (min (1+ (match-end 0)) (point-max)))
+ (setq s nil)))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Parsing of quotes.
;;
(if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t)
(match-string-no-properties 1)))))
- (make-local-variable 'paragraph-start)
- (setq paragraph-start (concat "^$\\|" page-delimiter))
- (make-local-variable 'paragraph-separate)
- (setq paragraph-separate paragraph-start)
- (make-local-variable 'paragraph-ignore-fill-prefix)
- (setq paragraph-ignore-fill-prefix t)
+ (set (make-local-variable 'paragraph-start) (concat "^$\\|" page-delimiter))
+ (set (make-local-variable 'paragraph-separate) paragraph-start)
+ (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
(if (featurep 'xemacs)
- (progn
- (make-local-variable 'paren-backwards-message)
- (set 'paren-backwards-message t)))
- (make-local-variable 'indent-line-function)
- (setq indent-line-function 'cperl-indent-line)
- (make-local-variable 'require-final-newline)
- (setq require-final-newline mode-require-final-newline)
- (make-local-variable 'comment-start)
- (setq comment-start "# ")
- (make-local-variable 'comment-end)
- (setq comment-end "")
- (make-local-variable 'comment-column)
- (setq comment-column cperl-comment-column)
- (make-local-variable 'comment-start-skip)
- (setq comment-start-skip "#+ *")
- (make-local-variable 'defun-prompt-regexp)
-;;; "[ \t]*sub"
-;;; (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start
-;;; cperl-maybe-white-and-comment-rex ; 15=pre-block
- (setq defun-prompt-regexp
- (concat "^[ \t]*\\(sub"
- (cperl-after-sub-regexp 'named 'attr-groups)
- "\\|" ; per toke.c
- "\\(BEGIN\\|CHECK\\|INIT\\|END\\|AUTOLOAD\\|DESTROY\\)"
- "\\)"
- cperl-maybe-white-and-comment-rex))
- (make-local-variable 'comment-indent-function)
- (setq comment-indent-function 'cperl-comment-indent)
+ (set (make-local-variable 'paren-backwards-message) t))
+ (set (make-local-variable 'indent-line-function) #'cperl-indent-line)
+ (set (make-local-variable 'require-final-newline) mode-require-final-newline)
+ (set (make-local-variable 'comment-start) "# ")
+ (set (make-local-variable 'comment-end) "")
+ (set (make-local-variable 'comment-column) cperl-comment-column)
+ (set (make-local-variable 'comment-start-skip) "#+ *")
-
++
+;; "[ \t]*sub"
+;; (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start
+;; cperl-maybe-white-and-comment-rex ; 15=pre-block
+ (set (make-local-variable 'defun-prompt-regexp)
+ (concat "^[ \t]*\\("
+ cperl-sub-regexp
+ (cperl-after-sub-regexp 'named 'attr-groups)
+ "\\|" ; per toke.c
+ "\\(BEGIN\\|UNITCHECK\\|CHECK\\|INIT\\|END\\|AUTOLOAD\\|DESTROY\\)"
+ "\\)"
+ cperl-maybe-white-and-comment-rex))
+ (set (make-local-variable 'comment-indent-function) #'cperl-comment-indent)
(and (boundp 'fill-paragraph-function)
- (progn
- (make-local-variable 'fill-paragraph-function)
- (set 'fill-paragraph-function 'cperl-fill-paragraph)))
- (make-local-variable 'parse-sexp-ignore-comments)
- (setq parse-sexp-ignore-comments t)
- (make-local-variable 'indent-region-function)
- (setq indent-region-function 'cperl-indent-region)
- ;;(setq auto-fill-function 'cperl-do-auto-fill) ; Need to switch on and off!
- (make-local-variable 'imenu-create-index-function)
- (setq imenu-create-index-function
- (function cperl-imenu--create-perl-index))
- (make-local-variable 'imenu-sort-function)
- (setq imenu-sort-function nil)
- (make-local-variable 'vc-rcs-header)
- (set 'vc-rcs-header cperl-vc-rcs-header)
- (make-local-variable 'vc-sccs-header)
- (set 'vc-sccs-header cperl-vc-sccs-header)
+ (set (make-local-variable 'fill-paragraph-function)
+ #'cperl-fill-paragraph))
+ (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (set (make-local-variable 'indent-region-function) #'cperl-indent-region)
+ ;;(setq auto-fill-function #'cperl-do-auto-fill) ; Need to switch on and off!
+ (set (make-local-variable 'imenu-create-index-function)
+ #'cperl-imenu--create-perl-index)
+ (set (make-local-variable 'imenu-sort-function) nil)
+ (set (make-local-variable 'vc-rcs-header) cperl-vc-rcs-header)
+ (set (make-local-variable 'vc-sccs-header) cperl-vc-sccs-header)
(when (featurep 'xemacs)
;; This one is obsolete...
- (make-local-variable 'vc-header-alist)
- (set 'vc-header-alist (or cperl-vc-header-alist ; Avoid warning
- `((SCCS ,(car cperl-vc-sccs-header))
- (RCS ,(car cperl-vc-rcs-header))))))
+ (set (make-local-variable 'vc-header-alist)
+ `((SCCS ,(car cperl-vc-sccs-header))
+ (RCS ,(car cperl-vc-rcs-header)))))
(cond ((boundp 'compilation-error-regexp-alist-alist);; xemacs 20.x
- (make-local-variable 'compilation-error-regexp-alist-alist)
- (set 'compilation-error-regexp-alist-alist
+ (set (make-local-variable 'compilation-error-regexp-alist-alist)
(cons (cons 'cperl (car cperl-compilation-error-regexp-alist))
- (symbol-value 'compilation-error-regexp-alist-alist)))
+ compilation-error-regexp-alist-alist))
(if (fboundp 'compilation-build-compilation-error-regexp-alist)
(let ((f 'compilation-build-compilation-error-regexp-alist))
(funcall f))
projects / emacs.git / commitdiff