- result
- )))
-
-
-(defun sh-do-nothing (a b c)
- ;; checkdoc-params: (a b c)
- "A dummy function to prevent font-lock from re-fontifying a change.
-Otherwise, we fontify something and font-lock overwrites it."
- )
-
-;; 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 ((font-lock-fontify-region-function 'sh-do-nothing))
- (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 parethese, and check if it is a case alternative.
-If so, its syntax class is set to word, and its text proerty
-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 proerty 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 ((font-lock-fontify-region-function 'sh-do-nothing))
- (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 occuring 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-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
- ))
-
-
-(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 indenation 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)
- (sh-set-here-doc-region start (point))
- (sh-debug "missing here-doc delimiter `%s'" label))))
- ;; 3. Scan for $# -- make the "#" a punctuation not a comment
- (goto-char (point-min))
- (let (state)
- (while (and (not (eobp))
- (setq state (parse-partial-sexp
- (1+ (point))(point-max) nil nil nil t))
- (nth 4 state))
- (goto-char (nth 8 state))
- (sh-debug "At %d %s" (point) (eq (char-before) ?$))
- (if (eq (char-before) ?$)
- (sh-set-char-syntax (point) sh-st-punc) ;; not a comment!
- (end-of-line) ;; if this *was* a comment, ignore rest of line!
- )))
- ;; 4. Hide these changes from making a previously unmodified
- ;; buffer into a modified buffer.
- (if sh-debug
- (if initial-buffer-modified-p
- (message "buffer was initially modified")
- (message
- "buffer not initially modified - so clearing modified flag")))
- (set-buffer-modified-p initial-buffer-modified-p)
- )))
-
-(defun sh-rescan-buffer ()
- "Rescan the buffer for case alternative parentheses and here documents."
- (interactive)
- (if (eq major-mode 'sh-mode)
- (let ((inhibit-read-only t))
- (sh-remove-our-text-properties)
- (message "Re-scanning buffer...")
- (sh-scan-buffer)
- (message "Re-scanning buffer...done")
- )))