Commit 34939e2c authored by Stefan Monnier's avatar Stefan Monnier
Browse files

(sh-mode-map): Remove bindings for

sh-electric-rparen, sh-electric-less and sh-electric-hash.
(sh-st-punc, sh-here-doc-syntax): Use string-to-syntax.
(sh-font-lock-heredoc, sh-font-lock-paren): New funs.
(sh-font-lock-syntactic-keywords): Use them.
(sh-heredoc-face, sh-st-face, sh-special-syntax): Remove.
(sh-mkword-regexp, sh-electric-rparen-needed-here): Remove.
(sh-mode): Don't override font-lock-unfontify-region-function.
Use a copy of sh-font-lock-syntactic-keywords.
(sh-set-shell): Don't set sh-electric-rparen-needed-here.
Don't call sh-scan-buffer since font-lock does it on the fly.
(sh-get-indent-info): Use `face' rather than `syntax-table'
text-property to detect here-documents.
Replace sh-special-syntax with sh-st-punc.
(sh-prev-line): Use `face' rather than `syntax-table'
text-property to skip over here-documents.
(sh-font-lock-unfontify-region-function, sh-check-paren-in-case)
(sh-set-char-syntax, sh-electric-rparen, sh-electric-hash)
(sh-electric-less, sh-set-here-doc-region)
(sh-remove-our-text-properties, sh-search-word, sh-scan-case)
(sh-scan-buffer, sh-rescan-buffer): Remove.
parent f1eed8ff
2000-10-21 Stefan Monnier <monnier@cs.yale.edu>
* progmodes/sh-script.el (sh-mode-map): Remove bindings for
sh-electric-rparen, sh-electric-less and sh-electric-hash.
(sh-st-punc, sh-here-doc-syntax): Use string-to-syntax.
(sh-font-lock-heredoc, sh-font-lock-paren): New funs.
(sh-font-lock-syntactic-keywords): Use them.
(sh-heredoc-face, sh-st-face, sh-special-syntax): Remove.
(sh-mkword-regexp, sh-electric-rparen-needed-here): Remove.
(sh-mode): Don't override font-lock-unfontify-region-function.
Use a copy of sh-font-lock-syntactic-keywords.
(sh-set-shell): Don't set sh-electric-rparen-needed-here.
Don't call sh-scan-buffer since font-lock does it on the fly.
(sh-get-indent-info): Use `face' rather than `syntax-table'
text-property to detect here-documents.
Replace sh-special-syntax with sh-st-punc.
(sh-prev-line): Use `face' rather than `syntax-table'
text-property to skip over here-documents.
(sh-font-lock-unfontify-region-function, sh-check-paren-in-case)
(sh-set-char-syntax, sh-electric-rparen, sh-electric-hash)
(sh-electric-less, sh-set-here-doc-region)
(sh-remove-our-text-properties, sh-search-word, sh-scan-case)
(sh-scan-buffer, sh-rescan-buffer): Remove.
2000-10-21 Andrew Innes <andrewi@gnu.org> 2000-10-21 Andrew Innes <andrewi@gnu.org>
* w32-fns.el (make-auto-save-file-name): Don't apply conversion to * w32-fns.el (make-auto-save-file-name): Don't apply conversion to
......
...@@ -177,22 +177,6 @@ ...@@ -177,22 +177,6 @@
;; ;;
;; Bugs ;; Bugs
;; ---- ;; ----
;; - Here-documents are marked with text properties face and syntax
;; table. This serves 2 purposes: stopping indentation while inside
;; them, and moving over them when finding the previous line to
;; indent to. However, if font-lock mode is active when there is
;; any change inside the here-document font-lock clears that
;; property. This causes several problems: lines after the here-doc
;; will not be re-indented properly, words in the here-doc region
;; may be fontified, and indentation may occur within the
;; here-document.
;; I'm not sure how to fix this, perhaps using the point-entered
;; property. Anyway, if you use font lock and change a
;; here-document, I recommend using M-x sh-rescan-buffer after the
;; changes are made. Similarly, when using highlight-changes-mode,
;; changes inside a here-document may confuse shell indenting, but again
;; using `sh-rescan-buffer' should fix them.
;;
;; - Indenting many lines is slow. It currently does each line ;; - Indenting many lines is slow. It currently does each line
;; independently, rather than saving state information. ;; independently, rather than saving state information.
;; ;;
...@@ -455,9 +439,6 @@ the car and cdr are the same symbol.") ...@@ -455,9 +439,6 @@ the car and cdr are the same symbol.")
(define-key map "'" 'skeleton-pair-insert-maybe) (define-key map "'" 'skeleton-pair-insert-maybe)
(define-key map "`" 'skeleton-pair-insert-maybe) (define-key map "`" 'skeleton-pair-insert-maybe)
(define-key map "\"" 'skeleton-pair-insert-maybe) (define-key map "\"" 'skeleton-pair-insert-maybe)
(define-key map ")" 'sh-electric-rparen)
(define-key map "<" 'sh-electric-less)
(define-key map "#" 'sh-electric-hash)
(substitute-key-definition 'complete-tag 'comint-dynamic-complete (substitute-key-definition 'complete-tag 'comint-dynamic-complete
map (current-global-map)) map (current-global-map))
...@@ -815,6 +796,61 @@ See `sh-feature'.") ...@@ -815,6 +796,61 @@ See `sh-feature'.")
(defvar sh-font-lock-keywords-2 () (defvar sh-font-lock-keywords-2 ()
"Gaudy level highlighting for Shell Script modes.") "Gaudy level highlighting for Shell Script modes.")
;; These are used for the syntax table stuff (derived from cperl-mode).
;; Note: parse-sexp-lookup-properties must be set to t for it to work.
(defconst sh-st-punc (string-to-syntax "."))
(defconst sh-here-doc-syntax (string-to-syntax "|")) ;; generic string
(defun sh-font-lock-heredoc (start string quoted)
"Determine the syntax of the \\n after a <<HEREDOC."
(unless (sh-in-comment-or-string start)
;; We're looking at <<STRING, so we add "^STRING$" to the syntactic
;; font-lock keywords to detect the end of this here document.
(let ((ere (concat
"^" (if quoted "[ \t]*")
(regexp-quote (replace-regexp-in-string "['\"]" "" string))
"\\(\n\\)")))
(unless (assoc ere font-lock-syntactic-keywords)
(let* ( ;; A rough regexp that should find us back.
(sre (concat "<<\\(-\\)?\\s-*['\"]?"
(regexp-quote string) "['\"]?[ \t\n]"))
(code `(cond
((save-excursion (re-search-backward ,sre nil t))
;; This ^STRING$ is indeed following a <<STRING
sh-here-doc-syntax)
((not (save-excursion (re-search-forward ,sre nil t)))
;; There's no <<STRING either before or after us,
;; so we should remove this now obsolete entry.
(setq font-lock-syntactic-keywords
(delq (assoc ,ere font-lock-syntactic-keywords)
font-lock-syntactic-keywords))
nil))))
;; Use destructive update so the new keyword gets used right away.
(setq font-lock-syntactic-keywords
(nconc font-lock-syntactic-keywords
(list (font-lock-compile-keyword `(,ere 1 ,code))))))))
sh-here-doc-syntax))
(defun sh-font-lock-paren (start)
(save-excursion
(goto-char start)
;; Skip through all patterns
(while
(progn
(forward-comment (- (point-max)))
;; Skip through one pattern
(while
(or (/= 0 (skip-syntax-backward "w_"))
(/= 0 (skip-chars-backward "?*/"))
(when (memq (char-before) '(?\" ?\'))
(condition-case nil (progn (backward-sexp 1) t)
(error nil)))))
(forward-comment (- (point-max)))
(when (eq (char-before) ?|)
(backward-char 1) t)))
(when (save-excursion (backward-char 2) (looking-at ";;\\|in"))
sh-st-punc)))
(defconst sh-font-lock-syntactic-keywords (defconst sh-font-lock-syntactic-keywords
;; Mark a `#' character as having punctuation syntax in a variable reference. ;; Mark a `#' character as having punctuation syntax in a variable reference.
;; Really we should do this properly. From Chet Ramey and Brian Fox: ;; Really we should do this properly. From Chet Ramey and Brian Fox:
...@@ -824,7 +860,13 @@ See `sh-feature'.") ...@@ -824,7 +860,13 @@ See `sh-feature'.")
;; But I can't be bothered to write a function to do it properly and ;; But I can't be bothered to write a function to do it properly and
;; efficiently. So we only do it properly for `#' in variable references and ;; efficiently. So we only do it properly for `#' in variable references and
;; do it efficiently by anchoring the regexp to the left. ;; do it efficiently by anchoring the regexp to the left.
'(("\\${?[^}#\n\t ]*\\(##?\\)" 1 (1 . nil)))) `(("\\${?[^}#\n\t ]*\\(##?\\)" 1 ,sh-st-punc)
;; Find HEREDOC starters and add a corresponding rule for the ender.
("[^<>]<<\\(-\\)?\\s-*\\(\\(['\"][^'\"]+['\"]\\|\\sw\\|\\s_\\)+\\).*\\(\n\\)"
4 (sh-font-lock-heredoc
(match-beginning 0) (match-string 2) (match-end 1)))
;; Distinguish the special close-paren in `case'.
(")" 0 (sh-font-lock-paren (match-beginning 0)))))
(defgroup sh-indentation nil (defgroup sh-indentation nil
"Variables controlling indentation in shell scripts. "Variables controlling indentation in shell scripts.
...@@ -1051,51 +1093,15 @@ This is for the rc shell." ...@@ -1051,51 +1093,15 @@ This is for the rc shell."
:type `(choice ,@ sh-number-or-symbol-list) :type `(choice ,@ sh-number-or-symbol-list)
:group 'sh-indentation) :group 'sh-indentation)
(defface sh-heredoc-face
'((((class color)
(background dark))
(:foreground "yellow" :bold t))
(((class color)
(background light))
(:foreground "tan" ))
(t
(:bold t)))
"Face to show a here-document"
:group 'sh-indentation)
(defface sh-st-face
'((((class color)
(background dark))
(:foreground "yellow" :bold t))
(((class color)
(background light))
(:foreground "tan" ))
(t
(:bold t)))
"Face to show characters with special syntax properties."
:group 'sh-indentation)
;; Internal use - not designed to be changed by the user: ;; Internal use - not designed to be changed by the user:
;; These are used for the syntax table stuff (derived from cperl-mode).
;; Note: parse-sexp-lookup-properties must be set to t for it to work.
(defconst sh-here-doc-syntax '(15)) ;; generic string
(defconst sh-st-punc '(1))
(defconst sh-special-syntax sh-st-punc)
(defun sh-mkword-regexpr (word) (defun sh-mkword-regexpr (word)
"Make a regexp which matches WORD as a word. "Make a regexp which matches WORD as a word.
This specifically excludes an occurrence of WORD followed by This specifically excludes an occurrence of WORD followed by
punctuation characters like '-'." punctuation characters like '-'."
(concat word "\\([^-a-z0-9_]\\|$\\)")) (concat word "\\([^-a-z0-9_]\\|$\\)"))
(defun sh-mkword-regexp (word)
"Make a regexp which matches WORD as a word.
This specifically excludes an occurrence of WORD followed by
or preceded by punctuation characters like '-'."
(concat "\\(^\\|[^-a-z0-9_]\\)" word "\\([^-a-z0-9_]\\|$\\)"))
(defconst sh-re-done (sh-mkword-regexpr "done")) (defconst sh-re-done (sh-mkword-regexpr "done"))
...@@ -1120,9 +1126,6 @@ or preceded by punctuation characters like '-'." ...@@ -1120,9 +1126,6 @@ or preceded by punctuation characters like '-'."
'((sh . t)) '((sh . t))
"Non-nil if the shell type needs an electric handling of case alternatives.") "Non-nil if the shell type needs an electric handling of case alternatives.")
(defvar sh-electric-rparen-needed-here nil
"Non-nil if the buffer needs an electric handling of case alternatives.")
(defconst sh-var-list (defconst sh-var-list
'( '(
sh-basic-offset sh-first-lines-indent sh-indent-after-case sh-basic-offset sh-first-lines-indent sh-indent-after-case
...@@ -1257,13 +1260,13 @@ with your script for an edit-interpret-debug cycle." ...@@ -1257,13 +1260,13 @@ with your script for an edit-interpret-debug cycle."
;; we can't look if previous line ended with `\' ;; we can't look if previous line ended with `\'
comint-prompt-regexp "^[ \t]*" comint-prompt-regexp "^[ \t]*"
font-lock-defaults font-lock-defaults
'((sh-font-lock-keywords `((sh-font-lock-keywords
sh-font-lock-keywords-1 sh-font-lock-keywords-2) sh-font-lock-keywords-1 sh-font-lock-keywords-2)
nil nil nil nil
((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil
(font-lock-syntactic-keywords . sh-font-lock-syntactic-keywords)) (font-lock-syntactic-keywords
font-lock-unfontify-region-function ;; Copy so we can use destructive update in `sh-font-lock-heredoc'.
'sh-font-lock-unfontify-region-function . ,(copy-sequence sh-font-lock-syntactic-keywords)))
skeleton-pair-alist '((?` _ ?`)) skeleton-pair-alist '((?` _ ?`))
skeleton-pair-filter 'sh-quoted-p skeleton-pair-filter 'sh-quoted-p
skeleton-further-elements '((< '(- (min sh-indentation skeleton-further-elements '((< '(- (min sh-indentation
...@@ -1420,10 +1423,7 @@ Calls the value of `sh-set-shell-hook' if set." ...@@ -1420,10 +1423,7 @@ Calls the value of `sh-set-shell-hook' if set."
(if (setq sh-indent-supported-here (sh-feature sh-indent-supported)) (if (setq sh-indent-supported-here (sh-feature sh-indent-supported))
(progn (progn
(message "Setting up indent for shell type %s" sh-shell) (message "Setting up indent for shell type %s" sh-shell)
(set (make-local-variable 'sh-electric-rparen-needed-here)
(sh-feature sh-electric-rparen-needed))
(set (make-local-variable 'parse-sexp-lookup-properties) t) (set (make-local-variable 'parse-sexp-lookup-properties) t)
(sh-scan-buffer)
(set (make-local-variable 'sh-kw-alist) (sh-feature sh-kw)) (set (make-local-variable 'sh-kw-alist) (sh-feature sh-kw))
(let ((regexp (sh-feature sh-kws-for-done))) (let ((regexp (sh-feature sh-kws-for-done)))
(if regexp (if regexp
...@@ -1923,7 +1923,8 @@ STRING This is ignored for the purposes of calculating ...@@ -1923,7 +1923,8 @@ STRING This is ignored for the purposes of calculating
;; Note: setting result to t means we are done and will return nil. ;; Note: setting result to t means we are done and will return nil.
;;(This function never returns just t.) ;;(This function never returns just t.)
(cond (cond
((equal (get-text-property (point) 'syntax-table) sh-here-doc-syntax) ((and (boundp 'font-lock-string-face)
(equal (get-text-property (point) 'face) font-lock-string-face))
(setq result t) (setq result t)
(setq have-result t)) (setq have-result t))
((looking-at "\\s-*#") ; was (equal this-kw "#") ((looking-at "\\s-*#") ; was (equal this-kw "#")
...@@ -1982,7 +1983,7 @@ STRING This is ignored for the purposes of calculating ...@@ -1982,7 +1983,7 @@ STRING This is ignored for the purposes of calculating
(cond (cond
((and (equal x ")") ((and (equal x ")")
(equal (get-text-property (1- (point)) 'syntax-table) (equal (get-text-property (1- (point)) 'syntax-table)
sh-special-syntax)) sh-st-punc))
(sh-debug "Case label) here") (sh-debug "Case label) here")
(setq x 'case-label) (setq x 'case-label)
(if (setq val (sh-check-rule 2 x)) (if (setq val (sh-check-rule 2 x))
...@@ -2120,13 +2121,15 @@ we go to the end of the previous line and do not check for continuations." ...@@ -2120,13 +2121,15 @@ we go to the end of the previous line and do not check for continuations."
(forward-comment (- (point-max))) (forward-comment (- (point-max)))
(unless end (beginning-of-line)) (unless end (beginning-of-line))
(when (and (not (bobp)) (when (and (not (bobp))
(equal (get-text-property (1- (point)) 'syntax-table) (boundp 'font-lock-string-face)
sh-here-doc-syntax)) (equal (get-text-property (1- (point)) 'face)
(let ((p1 (previous-single-property-change (1- (point)) 'syntax-table))) font-lock-string-face))
(let ((p1 (previous-single-property-change (1- (point)) 'face)))
(when p1 (when p1
(goto-char p1) (goto-char p1)
(forward-line -1) (if end
(if end (end-of-line))))) (end-of-line)
(beginning-of-line)))))
(unless end (unless end
;; we must check previous lines to see if they are continuation lines ;; we must check previous lines to see if they are continuation lines
;; if so, we must return position of first of them ;; if so, we must return position of first of them
...@@ -2187,8 +2190,7 @@ we go to the end of the previous line and do not check for continuations." ...@@ -2187,8 +2190,7 @@ we go to the end of the previous line and do not check for continuations."
(setq found nil)) (setq found nil))
(or found (or found
(sh-debug "Did not find prev stmt."))) (sh-debug "Did not find prev stmt.")))
found found)))
)))
(defun sh-get-word () (defun sh-get-word ()
...@@ -2283,8 +2285,7 @@ If AND-MOVE is non-nil then move to end of word." ...@@ -2283,8 +2285,7 @@ If AND-MOVE is non-nil then move to end of word."
(buffer-substring (point) (buffer-substring (point)
(progn (skip-chars-forward "^ \t\n;")(point))) (progn (skip-chars-forward "^ \t\n;")(point)))
(unless and-move (unless and-move
(goto-char start))) (goto-char start)))))
))
(defun sh-find-prev-matching (open close &optional depth) (defun sh-find-prev-matching (open close &optional depth)
"Find a matching token for a set of opening and closing keywords. "Find a matching token for a set of opening and closing keywords.
...@@ -2981,337 +2982,7 @@ Return values: ...@@ -2981,337 +2982,7 @@ Return values:
(car (car x))) (car (car x)))
;; result is nil here ;; result is nil here
)) ))
result result)))
)))
;; The default font-lock-unfontify-region-function removes
;; syntax-table properties, and so removes our information.
(defun sh-font-lock-unfontify-region-function (beg end)
(let* ((modified (buffer-modified-p)) (buffer-undo-list t)
(inhibit-read-only t) (inhibit-point-motion-hooks t)
before-change-functions after-change-functions
deactivate-mark buffer-file-name buffer-file-truename)
(remove-text-properties beg end '(face nil))
(when (and (not modified) (buffer-modified-p))
(set-buffer-modified-p nil))))
(defun sh-set-char-syntax (where new-prop)
"Set the character's syntax table property at WHERE to be NEW-PROP."
(or where
(setq where (point)))
(let ((inhibit-modification-hooks t))
(put-text-property where (1+ where) 'syntax-table new-prop)
(add-text-properties where (1+ where)
'(face sh-st-face rear-nonsticky t))
))
(defun sh-check-paren-in-case ()
"Make syntax class of case label's right parenthesis not close parenthesis.
If this parenthesis is a case alternative, set its syntax class to a word."
(let ((start (point))
state prev-line)
;; First test if this is a possible candidate, the first "(" or ")"
;; on the line; then, if go, check prev line is ;; or case.
(save-excursion
(beginning-of-line)
;; stop at comment or when depth becomes -1
(setq state (parse-partial-sexp (point) start -1 nil nil t))
(if (and
(= (car state) -1)
(= (point) start)
(setq prev-line (sh-prev-line nil)))
(progn
(goto-char prev-line)
(beginning-of-line)
;; (setq case-stmt-start (point))
;; (if (looking-at "\\(^\\s-*case[^-a-z0-9_]\\|[^#]*;;\\s-*$\\)")
(if (sh-search-word "\\(case\\|;;\\)" start)
(sh-set-char-syntax (1- start) sh-special-syntax)
))))))
(defun sh-electric-rparen ()
"Insert a right parenthesis and check if it is a case alternative.
If so, its syntax class is set to word, and its text property
is set to have face `sh-st-face'."
(interactive)
(insert ")")
(if sh-electric-rparen-needed-here
(sh-check-paren-in-case)))
(defun sh-electric-hash ()
"Insert a hash, but check it is preceded by \"$\".
If so, it is given a syntax type of comment.
Its text property has face `sh-st-face'."
(interactive)
(let ((pos (point)))
(insert "#")
(if (eq (char-before pos) ?$)
(sh-set-char-syntax pos sh-st-punc))))
(defun sh-electric-less (arg)
"Insert a \"<\" and see if this is the start of a here-document.
If so, the syntax class is set so that it will not be automatically
reindented.
Argument ARG if non-nil disables this test."
(interactive "*P")
(let ((p1 (point)) p2 p3)
(sh-maybe-here-document arg) ;; call the original fn in sh-script.el.
(setq p2 (point))
(if (/= (+ p1 (prefix-numeric-value arg)) p2)
(save-excursion
(forward-line 1)
(end-of-line)
(setq p3 (point))
(sh-set-here-doc-region p2 p3))
)))
(defun sh-set-here-doc-region (start end)
"Mark a here-document from START to END so that it will not be reindented."
(interactive "r")
;; Make the whole thing have syntax type word...
;; That way sexp movement doens't worry about any parentheses.
;; A disadvantage of this is we can't use forward-word within a
;; here-doc, which is annoying.
(let ((inhibit-modification-hooks t))
(put-text-property start end 'syntax-table sh-here-doc-syntax)
(put-text-property start end 'face 'sh-heredoc-face)
(put-text-property (1- end) end 'rear-nonsticky t)
(put-text-property start (1+ start) 'front-sticky t)
))
(defun sh-remove-our-text-properties ()
"Remove text properties relating to right parentheses and here documents."
(interactive)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(let ((plist (text-properties-at (point)))
(next-change
(or (next-single-property-change (point) 'syntax-table
(current-buffer) )
(point-max))))
;; Process text from point to NEXT-CHANGE...
(if (get-text-property (point) 'syntax-table)
(progn
(sh-debug "-- removing props from %d to %d --"
(point) next-change)
(remove-text-properties (point) next-change
'(syntax-table nil))
(remove-text-properties (point) next-change '(face nil))
))
(goto-char next-change)))
))
;; (defun sh-search-word (word &optional limit)
;; "Search forward for regexp WORD occurring as a word not in string nor comment.
;; If found, returns non nil with the match available in \(match-string 2\).
;; Yes 2, not 1, since we build a regexp to guard against false matches
;; such as matching \"a-case\" when we are searching for \"case\".
;; If not found, it returns nil.
;; The search maybe limited by optional argument LIMIT."
;; (interactive "sSearch for: ")
;; (let ((found nil)
;; ;; Cannot use \\b here since it matches "-" and "_"
;; (regexp (sh-mkword-regexp word))
;; start state where)
;; (setq start (point))
;; (while (and (setq start (point))
;; (not found)
;; (re-search-forward regexp limit t))
;; ;; Found str; check it is not in a comment or string.
;; (setq state
;; ;; Stop on comment:
;; (parse-partial-sexp start (point) nil nil nil 'syntax_table))
;; (if (setq where (nth 8 state))
;; ;; in comment or string
;; (if (= where -1)
;; (setq found (point))
;; (if (eq (char-after where) ?#)
;; (end-of-line)
;; (goto-char where)
;; (unless (sh-safe-forward-sexp)
;; ;; If the above fails we must either give up or
;; ;; move forward and try again.
;; (forward-line 1))
;; ))
;; ;; not in comment or string, so accept it
;; (setq found (point))
;; ))
;; found
;; ))
(defun sh-search-word (word &optional limit)
"Search forward for regexp WORD occurring as a word not in string nor comment.
If found, returns non-nil, with the match available in \(match-string 2\).
Yes, that is 2, not 1.
If not found, it returns nil.
The search may be limited by optional argument LIMIT."
(interactive "sSearch for: ")
(let ((found nil)
start state where match)
(setq start (point))
(while (and (not found)
(re-search-forward word limit t))
(setq match (match-data))
;; Found the word as a string; check it occurs as a word.
(when (and (or (= (match-beginning 0) (point-min))
(save-excursion
(goto-char (1- (match-beginning 0)))
(looking-at "[^-a-z0-9_]")))
(or (= (point) (point-max))
(looking-at "[^-a-z0-9_]")))
;; Check it is not in a comment or string.
(setq state
;; Stop on comment:
(parse-partial-sexp start (point) nil nil nil 'syntax_table))
(if (setq where (nth 8 state))
;; in comment or string
(if (= where -1)
(setq found (point))
(if (eq (char-after where) ?#)
(end-of-line)
(goto-char where)
(unless (sh-safe-forward-sexp)
;; If the above fails we must either give up or
;; move forward and try again.
(forward-line 1))))
;; not in comment or string, so accept it
(setq found (point)))
(setq start (point))))
(when found
(set-match-data match)
(goto-char (1- (match-beginning 0)))
(looking-at (sh-mkword-regexp word))
(goto-char found))
found
))
(defun sh-scan-case ()
"Scan a case statement for right parens belonging to case alternatives.
Mark each as having syntax `sh-special-syntax'.
Called from scan-buff. If ok, return non-nil."
(let (end
state
(depth 1) ;; we are called at a "case"
(start (point))
(return t))
;; We enter here at a case statement
;; First, find limits of the case.
(while (and (> depth 0)
(sh-search-word "\\(case\\|esac\\)"))
(if (equal (match-string 2) "case")
(setq depth (1+ depth))
(setq depth (1- depth))))
;; (message "end of search for esac at %d depth=%d" (point) depth)
(setq end (point))
(goto-char start)
;; if we found the esac, then fix all appropriate ')'s in the region
(if (zerop depth)
(progn
(while (< (point) end)
;; search for targetdepth of -1 meaning extra right paren
(setq state (parse-partial-sexp (point) end -1 nil nil nil))
(if (and (= (car state) -1)
(= (char-before) ?\)))
(progn
;; (message "At %d state is %s" (point) state)
;; (message "Fixing %d" (point))
(sh-set-char-syntax (1- (point)) sh-special-syntax)
;; we could advance to the next ";;" perhaps
)
;; (message "? Not found at %d" (point)) ; ok, could be "]"
))
(goto-char end))
(message "No matching esac for case at %d" start)
(setq return nil)
)
return
))
;; FIXME: This loses big time on very large files (such as CVS' sanity.sh).
(defun sh-scan-buffer ()
"Scan a sh buffer for case statements and here-documents.
For each case alternative found, mark its \")\" with a text property
so that its syntax class is no longer a close parenthesis character.
Each here-document is also marked so that it is effectively immune
from indentation changes."
;; Do not call this interactively, call `sh-rescan-buffer' instead.
(sh-must-be-shell-mode)
(let ((n 0)
(initial-buffer-modified-p (buffer-modified-p))
start end where label ws)
(save-excursion
(goto-char (point-min))
;; 1. Scan for ")" in case statements.
(while (and ;; (re-search-forward "^[^#]*\\bcase\\b" nil t)
(sh-search-word "\\(case\\|esac\\)")
;; (progn (message "Found a case at %d" (point)) t)
(sh-scan-case)))
;; 2. Scan for here docs
(goto-char (point-min))
;; while (re-search-forward "<<\\(-?\\)\\(\\s-*\\)\\(.*\\)$" nil t)
(while (re-search-forward "<<\\(-?\\)" nil t)
(unless (sh-in-comment-or-string (match-beginning 0))
;; (setq label (match-string 3))
(setq label (sh-get-word))
(if (string= (match-string 1) "-")
;; if <<- then we allow whitespace
(setq ws "\\s-*")
;; otherwise we don't
(setq ws ""))
(while (string-match "['\"\\]" label)
(setq label (replace-match "" nil nil label)))
(if (setq n (string-match "\\s-+$" label))
(setq label (substring label 0 n)))
(forward-line 1)
;; the line containing the << could be continued...
(while (sh-this-is-a-continuation)
(forward-line 1))
(setq start (point))
(if (re-search-forward (concat "^" ws (regexp-quote label)
"\\s-*$")
nil t)