+\f
+;; Indentation stuff.
+(defun sh-must-support-indent ()
+ "*Signal an error if the shell type for this buffer is not supported.
+Also, the buffer must be in Shell-script mode."
+ (unless sh-indent-supported-here
+ (error "This buffer's shell does not support indentation through Emacs")))
+
+(defun sh-make-vars-local ()
+ "Make the indentation variables local to this buffer.
+Normally they already are local. This command is provided in case
+variable `sh-make-vars-local' has been set to nil.
+
+To revert all these variables to the global values, use
+command `sh-reset-indent-vars-to-global-values'."
+ (interactive)
+ (mapcar 'make-local-variable sh-var-list)
+ (message "Indentation variable are now local."))
+
+(defun sh-reset-indent-vars-to-global-values ()
+ "Reset local indentation variables to the global values.
+Then, if variable `sh-make-vars-local' is non-nil, make them local."
+ (interactive)
+ (mapcar 'kill-local-variable sh-var-list)
+ (if sh-make-vars-local
+ (mapcar 'make-local-variable sh-var-list)))
+
+
+;; Theoretically these are only needed in shell and derived modes.
+;; However, the routines which use them are only called in those modes.
+(defconst sh-special-keywords "then\\|do")
+
+(defun sh-help-string-for-variable (var)
+ "Construct a string for `sh-read-variable' when changing variable VAR ."
+ (let ((msg (documentation-property var 'variable-documentation))
+ (msg2 ""))
+ (unless (memq var '(sh-first-lines-indent sh-indent-comment))
+ (setq msg2
+ (format "\n
+You can enter a number (positive to increase indentation,
+negative to decrease indentation, zero for no change to indentation).
+
+Or, you can enter one of the following symbols which are relative to
+the value of variable `sh-basic-offset'
+which in this buffer is currently %s.
+
+\t%s."
+ sh-basic-offset
+ (mapconcat (lambda (x)
+ (nth (1- (length x)) x))
+ sh-symbol-list "\n\t"))))
+ (concat
+ ;; The following shows the global not the local value!
+ ;; (format "Current value of %s is %s\n\n" var (symbol-value var))
+ msg msg2)))
+
+(defun sh-read-variable (var)
+ "Read a new value for indentation variable VAR."
+ (interactive "*variable? ") ;; to test
+ (let ((minibuffer-help-form `(sh-help-string-for-variable
+ (quote ,var)))
+ val)
+ (setq val (read-from-minibuffer
+ (format "New value for %s (press %s for help): "
+ var (single-key-description help-char))
+ (format "%s" (symbol-value var))
+ nil t))
+ val))
+
+
+
+(defun sh-in-comment-or-string (start)
+ "Return non-nil if START is in a comment or string."
+ (save-excursion
+ (let ((state (syntax-ppss start)))
+ (or (nth 3 state) (nth 4 state)))))
+
+(defun sh-goto-matching-if ()
+ "Go to the matching if for a fi.
+This handles nested if..fi pairs."
+ (let ((found (sh-find-prev-matching "\\bif\\b" "\\bfi\\b" 1)))
+ (if found
+ (goto-char found))))
+
+
+;; Functions named sh-handle-this-XXX are called when the keyword on the
+;; line whose indentation is being handled contain XXX;
+;; those named sh-handle-prev-XXX are when XXX appears on the previous line.
+
+(defun sh-handle-prev-if ()
+ (list '(+ sh-indent-after-if)))
+
+(defun sh-handle-this-else ()
+ (if (sh-goto-matching-if)
+ ;; (list "aligned to if")
+ (list "aligned to if" '(+ sh-indent-for-else))
+ nil
+ ))
+
+(defun sh-handle-prev-else ()
+ (if (sh-goto-matching-if)
+ (list '(+ sh-indent-after-if))
+ ))
+
+(defun sh-handle-this-fi ()
+ (if (sh-goto-matching-if)
+ (list "aligned to if" '(+ sh-indent-for-fi))
+ nil
+ ))
+
+(defun sh-handle-prev-fi ()
+ ;; Why do we have this rule? Because we must go back to the if
+ ;; to get its indent. We may continue back from there.
+ ;; We return nil because we don't have anything to add to result,
+ ;; the side affect of setting align-point is all that matters.
+ ;; we could return a comment (a string) but I can't think of a good one...
+ (sh-goto-matching-if)
+ nil)
+
+(defun sh-handle-this-then ()
+ (let ((p (sh-goto-matching-if)))
+ (if p
+ (list '(+ sh-indent-for-then))
+ )))
+
+(defun sh-handle-prev-then ()
+ (let ((p (sh-goto-matching-if)))
+ (if p
+ (list '(+ sh-indent-after-if))
+ )))
+
+(defun sh-handle-prev-open ()
+ (save-excursion
+ (let ((x (sh-prev-stmt)))
+ (if (and x
+ (progn
+ (goto-char x)
+ (or
+ (looking-at "function\\b")
+ (looking-at "\\s-*\\S-+\\s-*()")
+ )))
+ (list '(+ sh-indent-after-function))
+ (list '(+ sh-indent-after-open)))
+ )))
+
+(defun sh-handle-this-close ()
+ (forward-char 1) ;; move over ")"
+ (if (sh-safe-forward-sexp -1)
+ (list "aligned to opening paren")))
+
+(defun sh-goto-matching-case ()
+ (let ((found (sh-find-prev-matching "\\bcase\\b" "\\besac\\b" 1)))
+ (if found (goto-char found))))
+
+(defun sh-handle-prev-case ()
+ ;; This is typically called when point is on same line as a case
+ ;; we shouldn't -- and can't find prev-case
+ (if (looking-at ".*\\<case\\>")
+ (list '(+ sh-indent-for-case-label))
+ (error "We don't seem to be on a line with a case"))) ;; debug
+
+(defun sh-handle-this-esac ()
+ (if (sh-goto-matching-case)
+ (list "aligned to matching case")))
+
+(defun sh-handle-prev-esac ()
+ (if (sh-goto-matching-case)
+ (list "matching case")))
+
+(defun sh-handle-after-case-label ()
+ (if (sh-goto-matching-case)
+ (list '(+ sh-indent-for-case-alt))))
+
+(defun sh-handle-prev-case-alt-end ()
+ (if (sh-goto-matching-case)
+ (list '(+ sh-indent-for-case-label))))
+
+(defun sh-safe-forward-sexp (&optional arg)
+ "Try and do a `forward-sexp', but do not error.
+Return new point if successful, nil if an error occurred."
+ (condition-case nil
+ (progn
+ (forward-sexp (or arg 1))
+ (point)) ;; return point if successful
+ (error
+ (sh-debug "oops!(1) %d" (point))
+ nil))) ;; return nil if fail
+
+(defun sh-goto-match-for-done ()
+ (let ((found (sh-find-prev-matching sh-regexp-for-done sh-re-done 1)))
+ (if found
+ (goto-char found))))
+
+(defun sh-handle-this-done ()
+ (if (sh-goto-match-for-done)
+ (list "aligned to do stmt" '(+ sh-indent-for-done))))
+
+(defun sh-handle-prev-done ()
+ (if (sh-goto-match-for-done)
+ (list "previous done")))
+
+(defun sh-handle-this-do ()
+ (if (sh-goto-match-for-done)
+ (list '(+ sh-indent-for-do))))
+
+(defun sh-handle-prev-do ()
+ (cond
+ ((save-restriction
+ (narrow-to-region
+ (point)
+ (save-excursion
+ (beginning-of-line)
+ (point)))
+ (sh-goto-match-for-done))
+ (sh-debug "match for done found on THIS line")
+ (list '(+ sh-indent-after-loop-construct)))
+ ((sh-goto-match-for-done)
+ (sh-debug "match for done found on PREV line")
+ (list '(+ sh-indent-after-do)))
+ (t
+ (message "match for done NOT found")
+ nil)))
+
+;; for rc:
+(defun sh-find-prev-switch ()
+ "Find the line for the switch keyword matching this line's case keyword."
+ (re-search-backward "\\<switch\\>" nil t))
+
+(defun sh-handle-this-rc-case ()
+ (if (sh-find-prev-switch)
+ (list '(+ sh-indent-after-switch))
+ ;; (list '(+ sh-indent-for-case-label))
+ nil))
+
+(defun sh-handle-prev-rc-case ()
+ (list '(+ sh-indent-after-case)))
+
+(defun sh-check-rule (n thing)
+ (let ((rule (nth n (assoc thing sh-kw-alist)))
+ (val nil))
+ (if rule
+ (progn
+ (setq val (funcall rule))
+ (sh-debug "rule (%d) for %s at %d is %s\n-> returned %s"
+ n thing (point) rule val)))
+ val))
+
+
+(defun sh-get-indent-info ()
+ "Return indent-info for this line.
+This is a list. nil means the line is to be left as is.
+Otherwise it contains one or more of the following sublists:
+\(t NUMBER\) NUMBER is the base location in the buffer that indentation is
+ relative to. If present, this is always the first of the
+ sublists. The indentation of the line in question is
+ derived from the indentation of this point, possibly
+ modified by subsequent sublists.
+\(+ VAR\)
+\(- VAR\) Get the value of variable VAR and add to or subtract from
+ the indentation calculated so far.
+\(= VAR\) Get the value of variable VAR and *replace* the
+ indentation with its value. This only occurs for
+ special variables such as `sh-indent-comment'.
+STRING This is ignored for the purposes of calculating
+ indentation, it is printed in certain cases to help show
+ what the indentation is based on."
+ ;; See comments before `sh-kw'.
+ (save-excursion
+ (let ((have-result nil)
+ this-kw
+ start
+ val
+ (result nil)
+ (align-point nil)
+ prev-line-end x)
+ (beginning-of-line)
+ ;; Note: setting result to t means we are done and will return nil.
+ ;;(This function never returns just t.)
+ (cond
+ ((or (and (boundp 'font-lock-string-face) (not (bobp))
+ (eq (get-text-property (1- (point)) 'face)
+ font-lock-string-face))
+ (eq (get-text-property (point) 'face) sh-heredoc-face))
+ (setq result t)
+ (setq have-result t))
+ ((looking-at "\\s-*#") ; was (equal this-kw "#")
+ (if (bobp)
+ (setq result t) ;; return nil if 1st line!
+ (setq result (list '(= sh-indent-comment)))
+ ;; we still need to get previous line in case
+ ;; sh-indent-comment is t (indent as normal)
+ (setq align-point (sh-prev-line nil))
+ (setq have-result nil)
+ ))
+ ) ;; cond
+
+ (unless have-result
+ ;; Continuation lines are handled specially
+ (if (sh-this-is-a-continuation)
+ (progn
+ ;; We assume the line being continued is already
+ ;; properly indented...
+ ;; (setq prev-line-end (sh-prev-line))
+ (setq align-point (sh-prev-line nil))
+ (setq result (list '(+ sh-indent-for-continuation)))
+ (setq have-result t))
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (setq this-kw (sh-get-kw)))
+
+ ;; Handle "this" keyword: first word on the line we're
+ ;; calculating indentation info for.
+ (if this-kw
+ (if (setq val (sh-check-rule 1 this-kw))
+ (progn
+ (setq align-point (point))
+ (sh-debug
+ "this - setting align-point to %d" align-point)
+ (setq result (append result val))
+ (setq have-result t)
+ ;; set prev-line to continue processing remainder
+ ;; of this line as a previous line
+ (setq prev-line-end (point))
+ ))))
+
+ (unless have-result
+ (setq prev-line-end (sh-prev-line 'end)))
+
+ (if prev-line-end
+ (save-excursion
+ ;; We start off at beginning of this line.
+ ;; Scan previous statements while this is <=
+ ;; start of previous line.
+ (setq start (point)) ;; for debug only
+ (goto-char prev-line-end)
+ (setq x t)
+ (while (and x (setq x (sh-prev-thing)))
+ (sh-debug "at %d x is: %s result is: %s" (point) x result)
+ (cond
+ ((and (equal x ")")
+ (equal (get-text-property (1- (point)) 'syntax-table)
+ sh-st-punc))
+ (sh-debug "Case label) here")
+ (setq x 'case-label)
+ (if (setq val (sh-check-rule 2 x))
+ (progn
+ (setq result (append result val))
+ (setq align-point (point))))
+ (or (bobp)
+ (forward-char -1))
+ (skip-chars-forward "[a-z0-9]*?")
+ )
+ ((string-match "[])}]" x)
+ (setq x (sh-safe-forward-sexp -1))
+ (if x
+ (progn
+ (setq align-point (point))
+ (setq result (append result
+ (list "aligned to opening paren")))
+ )))
+ ((string-match "[[({]" x)
+ (sh-debug "Checking special thing: %s" x)
+ (if (setq val (sh-check-rule 2 x))
+ (setq result (append result val)))
+ (forward-char -1)
+ (setq align-point (point)))
+ ((string-match "[\"'`]" x)
+ (sh-debug "Skipping back for %s" x)
+ ;; this was oops-2
+ (setq x (sh-safe-forward-sexp -1)))
+ ((stringp x)
+ (sh-debug "Checking string %s at %s" x (point))
+ (if (setq val (sh-check-rule 2 x))
+ ;; (or (eq t (car val))
+ ;; (eq t (car (car val))))
+ (setq result (append result val)))
+ ;; not sure about this test Wed Jan 27 23:48:35 1999
+ (setq align-point (point))
+ (unless (bolp)
+ (forward-char -1)))
+ (t
+ (error "Don't know what to do with %s" x))
+ )
+ ) ;; while
+ (sh-debug "result is %s" result)
+ )
+ (sh-debug "No prev line!")
+ (sh-debug "result: %s align-point: %s" result align-point)
+ )
+
+ (if align-point
+ ;; was: (setq result (append result (list (list t align-point))))
+ (setq result (append (list (list t align-point)) result))
+ )
+ (sh-debug "result is now: %s" result)
+
+ (or result
+ (if prev-line-end
+ (setq result (list (list t prev-line-end)))
+ (setq result (list (list '= 'sh-first-lines-indent)))
+ ))
+
+ (if (eq result t)
+ (setq result nil))
+ (sh-debug "result is: %s" result)
+ result
+ ) ;; let
+ ))
+
+
+(defun sh-get-indent-var-for-line (&optional info)
+ "Return the variable controlling indentation for this line.
+If there is not [just] one such variable, return a string
+indicating the problem.
+If INFO is supplied it is used, else it is calculated."
+ (let ((var nil)
+ (result nil)
+ (reason nil)
+ sym elt)
+ (or info
+ (setq info (sh-get-indent-info)))
+ (if (null info)
+ (setq result "this line to be left as is")
+ (while (and info (null result))
+ (setq elt (car info))
+ (cond
+ ((stringp elt)
+ (setq reason elt)
+ )
+ ((not (listp elt))
+ (error "sh-get-indent-var-for-line invalid elt: %s" elt))
+ ;; so it is a list
+ ((eq t (car elt))
+ ) ;; nothing
+ ((symbolp (setq sym (nth 1 elt)))
+ ;; A bit of a kludge - when we see the sh-indent-comment
+ ;; ignore other variables. Otherwise it is tricky to
+ ;; "learn" the comment indentation.
+ (if (eq var 'sh-indent-comment)
+ (setq result var)
+ (if var
+ (setq result
+ "this line is controlled by more than 1 variable.")
+ (setq var sym))))
+ (t
+ (error "sh-get-indent-var-for-line invalid list elt: %s" elt)))
+ (setq info (cdr info))
+ ))
+ (or result
+ (setq result var))
+ (or result
+ (setq result reason))
+ (if (null result)
+ ;; e.g. just had (t POS)
+ (setq result "line has default indentation"))
+ result))
+
+
+
+;; Finding the previous line isn't trivial.
+;; We must *always* go back one more and see if that is a continuation
+;; line -- it is the PREVIOUS line which is continued, not the one
+;; we are going to!
+;; Also, we want to treat a whole "here document" as one big line,
+;; because we may want to a align to the beginning of it.
+;;
+;; What we do:
+;; - go back to previous non-empty line
+;; - if this is in a here-document, go to the beginning of it
+;; - while previous line is continued, go back one line
+(defun sh-prev-line (&optional end)
+ "Back to end of previous non-comment non-empty line.
+Go to beginning of logical line unless END is non-nil, in which case
+we go to the end of the previous line and do not check for continuations."
+ (save-excursion
+ (beginning-of-line)
+ (forward-comment (- (point-max)))
+ (unless end (beginning-of-line))
+ (when (and (not (bobp))
+ (equal (get-text-property (1- (point)) 'face)
+ sh-heredoc-face))
+ (let ((p1 (previous-single-property-change (1- (point)) 'face)))
+ (when p1
+ (goto-char p1)
+ (if end
+ (end-of-line)
+ (beginning-of-line)))))
+ (unless end
+ ;; we must check previous lines to see if they are continuation lines
+ ;; if so, we must return position of first of them
+ (while (and (sh-this-is-a-continuation)
+ (>= 0 (forward-line -1))))
+ (beginning-of-line)
+ (skip-chars-forward " \t"))
+ (point)))
+
+
+(defun sh-prev-stmt ()
+ "Return the address of the previous stmt or nil."
+ ;; This is used when we are trying to find a matching keyword.
+ ;; Searching backward for the keyword would certainly be quicker, but
+ ;; it is hard to remove "false matches" -- such as if the keyword
+ ;; appears in a string or quote. This way is slower, but (I think) safer.
+ (interactive)
+ (save-excursion
+ (let ((going t)
+ (start (point))
+ (found nil)
+ (prev nil))
+ (skip-chars-backward " \t;|&({[")
+ (while (and (not found)
+ (not (bobp))
+ going)
+ ;; Do a backward-sexp if possible, else backup bit by bit...
+ (if (sh-safe-forward-sexp -1)
+ (progn
+ (if (looking-at sh-special-keywords)
+ (progn
+ (setq found prev))
+ (setq prev (point))
+ ))
+ ;; backward-sexp failed
+ (if (zerop (skip-chars-backward " \t()[\]{};`'"))
+ (forward-char -1))
+ (if (bolp)
+ (let ((back (sh-prev-line nil)))
+ (if back
+ (goto-char back)
+ (setq going nil)))))
+ (unless found
+ (skip-chars-backward " \t")
+ (if (or (and (bolp) (not (sh-this-is-a-continuation)))
+ (eq (char-before) ?\;)
+ (looking-at "\\s-*[|&]"))
+ (setq found (point)))))
+ (if found
+ (goto-char found))
+ (if found
+ (progn
+ (skip-chars-forward " \t|&({[")
+ (setq found (point))))
+ (if (>= (point) start)
+ (progn
+ (debug "We didn't move!")
+ (setq found nil))
+ (or found
+ (sh-debug "Did not find prev stmt.")))
+ found)))
+
+
+(defun sh-get-word ()
+ "Get a shell word skipping whitespace from point."
+ (interactive)
+ (skip-chars-forward "\t ")
+ (let ((start (point)))
+ (while
+ (if (looking-at "[\"'`]")
+ (sh-safe-forward-sexp)
+ ;; (> (skip-chars-forward "^ \t\n\"'`") 0)
+ (> (skip-chars-forward "-_a-zA-Z\$0-9") 0)
+ ))
+ (buffer-substring start (point))
+ ))
+
+(defun sh-prev-thing ()
+ "Return the previous thing this logical line."
+ ;; This is called when `sh-get-indent-info' is working backwards on
+ ;; the previous line(s) finding what keywords may be relevant for
+ ;; indenting. It moves over sexps if possible, and will stop
+ ;; on a ; and at the beginning of a line if it is not a continuation
+ ;; line.
+ ;;
+ ;; Added a kludge for ";;"
+ ;; Possible return values:
+ ;; nil - nothing
+ ;; a string - possibly a keyword
+ ;;
+ (if (bolp)
+ nil
+ (let (c min-point
+ (start (point)))
+ (save-restriction
+ (narrow-to-region
+ (if (sh-this-is-a-continuation)
+ (setq min-point (sh-prev-line nil))
+ (save-excursion
+ (beginning-of-line)
+ (setq min-point (point))))
+ (point))
+ (skip-chars-backward " \t;")
+ (unless (looking-at "\\s-*;;")
+ (skip-chars-backward "^)}];\"'`({[")
+ (setq c (char-before))))
+ (sh-debug "stopping at %d c is %s start=%d min-point=%d"
+ (point) c start min-point)
+ (if (< (point) min-point)
+ (error "point %d < min-point %d" (point) min-point))
+ (cond
+ ((looking-at "\\s-*;;")
+ ;; (message "Found ;; !")
+ ";;")
+ ((or (eq c ?\n)
+ (eq c nil)
+ (eq c ?\;))
+ (save-excursion
+ ;; skip forward over white space newline and \ at eol
+ (skip-chars-forward " \t\n\\\\")
+ (sh-debug "Now at %d start=%d" (point) start)
+ (if (>= (point) start)
+ (progn
+ (sh-debug "point: %d >= start: %d" (point) start)
+ nil)
+ (sh-get-word))
+ ))
+ (t
+ ;; c -- return a string
+ (char-to-string c)
+ ))
+ )))
+
+
+(defun sh-this-is-a-continuation ()
+ "Return non-nil if current line is a continuation of previous line."
+ (save-excursion
+ (and (zerop (forward-line -1))
+ (looking-at ".*\\\\$")
+ (not (nth 4 (parse-partial-sexp (match-beginning 0) (match-end 0)
+ nil nil nil t))))))
+
+(defun sh-get-kw (&optional where and-move)
+ "Return first word of line from WHERE.
+If AND-MOVE is non-nil then move to end of word."
+ (let ((start (point)))
+ (if where
+ (goto-char where))
+ (prog1
+ (buffer-substring (point)
+ (progn (skip-chars-forward "^ \t\n;")(point)))
+ (unless and-move
+ (goto-char start)))))
+
+(defun sh-find-prev-matching (open close &optional depth)
+ "Find a matching token for a set of opening and closing keywords.
+This takes into account that there may be nested open..close pairings.
+OPEN and CLOSE are regexps denoting the tokens to be matched.
+Optional parameter DEPTH (usually 1) says how many to look for."
+ (let ((parse-sexp-ignore-comments t)
+ prev)
+ (setq depth (or depth 1))
+ (save-excursion
+ (condition-case nil
+ (while (and
+ (/= 0 depth)
+ (not (bobp))
+ (setq prev (sh-prev-stmt)))
+ (goto-char prev)
+ (save-excursion
+ (if (looking-at "\\\\\n")
+ (progn
+ (forward-char 2)
+ (skip-chars-forward " \t")))
+ (cond
+ ((looking-at open)
+ (setq depth (1- depth))
+ (sh-debug "found open at %d - depth = %d" (point) depth))
+ ((looking-at close)
+ (setq depth (1+ depth))
+ (sh-debug "found close - depth = %d" depth))
+ (t
+ ))))
+ (error nil))
+ (if (eq depth 0)
+ prev ;; (point)
+ nil)
+ )))
+
+
+(defun sh-var-value (var &optional ignore-error)
+ "Return the value of variable VAR, interpreting symbols.
+It can also return t or nil.
+If an illegal value is found, throw an error unless Optional argument
+IGNORE-ERROR is non-nil."
+ (let ((val (symbol-value var)))
+ (cond
+ ((numberp val)
+ val)
+ ((eq val t)
+ val)
+ ((null val)
+ val)
+ ((eq val '+)
+ sh-basic-offset)
+ ((eq val '-)
+ (- sh-basic-offset))
+ ((eq val '++)
+ (* 2 sh-basic-offset))
+ ((eq val '--)
+ (* 2 (- sh-basic-offset)))
+ ((eq val '*)
+ (/ sh-basic-offset 2))
+ ((eq val '/)
+ (/ (- sh-basic-offset) 2))
+ (t
+ (if ignore-error
+ (progn
+ (message "Don't know how to handle %s's value of %s" var val)
+ 0)
+ (error "Don't know how to handle %s's value of %s" var val))
+ ))))
+
+(defun sh-set-var-value (var value &optional no-symbol)
+ "Set variable VAR to VALUE.
+Unless optional argument NO-SYMBOL is non-nil, then if VALUE is
+can be represented by a symbol then do so."
+ (cond
+ (no-symbol
+ (set var value))
+ ((= value sh-basic-offset)
+ (set var '+))
+ ((= value (- sh-basic-offset))
+ (set var '-))
+ ((eq value (* 2 sh-basic-offset))
+ (set var '++))
+ ((eq value (* 2 (- sh-basic-offset)))
+ (set var '--))
+ ((eq value (/ sh-basic-offset 2))
+ (set var '*))
+ ((eq value (/ (- sh-basic-offset) 2))
+ (set var '/))
+ (t
+ (set var value)))
+ )
+
+
+(defun sh-calculate-indent (&optional info)
+ "Return the indentation for the current line.
+If INFO is supplied it is used, else it is calculated from current line."
+ (let ((ofs 0)
+ (base-value 0)
+ elt a b var val)
+ (or info
+ (setq info (sh-get-indent-info)))
+ (when info
+ (while info
+ (sh-debug "info: %s ofs=%s" info ofs)
+ (setq elt (car info))
+ (cond
+ ((stringp elt)) ;; do nothing?
+ ((listp elt)
+ (setq a (car (car info)))
+ (setq b (nth 1 (car info)))
+ (cond
+ ((eq a t)
+ (save-excursion
+ (goto-char b)
+ (setq val (current-indentation)))
+ (setq base-value val))
+ ((symbolp b)
+ (setq val (sh-var-value b))
+ (cond
+ ((eq a '=)
+ (cond
+ ((null val)
+ ;; no indentation
+ ;; set info to nil so we stop immediately
+ (setq base-value nil ofs nil info nil))
+ ((eq val t) (setq ofs 0)) ;; indent as normal line
+ (t
+ ;; The following assume the (t POS) come first!
+ (setq ofs val base-value 0)
+ (setq info nil)))) ;; ? stop now
+ ((eq a '+) (setq ofs (+ ofs val)))
+ ((eq a '-) (setq ofs (- ofs val)))
+ (t
+ (error "sh-calculate-indent invalid a a=%s b=%s" a b))))
+ (t
+ (error "sh-calculate-indent invalid elt: a=%s b=%s" a b))))
+ (t
+ (error "sh-calculate-indent invalid elt %s" elt)))
+ (sh-debug "a=%s b=%s val=%s base-value=%s ofs=%s"
+ a b val base-value ofs)
+ (setq info (cdr info)))
+ ;; return value:
+ (sh-debug "at end: base-value: %s ofs: %s" base-value ofs)
+
+ (cond
+ ((or (null base-value)(null ofs))
+ nil)
+ ((and (numberp base-value)(numberp ofs))
+ (sh-debug "base (%d) + ofs (%d) = %d"
+ base-value ofs (+ base-value ofs))
+ (+ base-value ofs)) ;; return value
+ (t
+ (error "sh-calculate-indent: Help. base-value=%s ofs=%s"
+ base-value ofs)
+ nil)))))
+
+
+(defun sh-indent-line ()
+ "Indent the current line."
+ (interactive)
+ (let ((indent (sh-calculate-indent))
+ (pos (- (point-max) (point))))
+ (when indent
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (indent-line-to indent)
+ ;; If initial point was within line's indentation,
+ ;; position after the indentation. Else stay at same point in text.
+ (if (> (- (point-max) pos) (point))
+ (goto-char (- (point-max) pos))))))
+
+
+(defun sh-blink (blinkpos &optional msg)
+ "Move cursor momentarily to BLINKPOS and display MSG."
+ ;; We can get here without it being a number on first line
+ (if (numberp blinkpos)
+ (save-excursion
+ (goto-char blinkpos)
+ (message msg)
+ (sit-for blink-matching-delay))
+ (message msg)))
+
+(defun sh-show-indent (arg)
+ "Show the how the currently line would be indented.
+This tells you which variable, if any, controls the indentation of
+this line.
+If optional arg ARG is non-null (called interactively with a prefix),
+a pop up window describes this variable.
+If variable `sh-blink' is non-nil then momentarily go to the line
+we are indenting relative to, if applicable."
+ (interactive "P")
+ (sh-must-support-indent)
+ (let* ((info (sh-get-indent-info))
+ (var (sh-get-indent-var-for-line info))
+ (curr-indent (current-indentation))
+ val msg)
+ (if (stringp var)
+ (message (setq msg var))
+ (setq val (sh-calculate-indent info))
+
+ (if (eq curr-indent val)
+ (setq msg (format "%s is %s" var (symbol-value var)))
+ (setq msg
+ (if val
+ (format "%s (%s) would change indent from %d to: %d"
+ var (symbol-value var) curr-indent val)
+ (format "%s (%s) would leave line as is"
+ var (symbol-value var)))
+ ))
+ (if (and arg var)
+ (describe-variable var)))
+ (if sh-blink
+ (let ((info (sh-get-indent-info)))
+ (if (and info (listp (car info))
+ (eq (car (car info)) t))
+ (sh-blink (nth 1 (car info)) msg)
+ (message msg)))
+ (message msg))
+ ))
+
+(defun sh-set-indent ()
+ "Set the indentation for the current line.
+If the current line is controlled by an indentation variable, prompt
+for a new value for it."
+ (interactive)
+ (sh-must-support-indent)
+ (let* ((info (sh-get-indent-info))
+ (var (sh-get-indent-var-for-line info))
+ val old-val indent-val)
+ (if (stringp var)
+ (message (format "Cannot set indent - %s" var))
+ (setq old-val (symbol-value var))
+ (setq val (sh-read-variable var))
+ (condition-case nil
+ (progn
+ (set var val)
+ (setq indent-val (sh-calculate-indent info))
+ (if indent-val
+ (message "Variable: %s Value: %s would indent to: %d"
+ var (symbol-value var) indent-val)
+ (message "Variable: %s Value: %s would leave line as is."
+ var (symbol-value var)))
+ ;; I'm not sure about this, indenting it now?
+ ;; No. Because it would give the impression that an undo would
+ ;; restore thing, but the value has been altered.
+ ;; (sh-indent-line)
+ )
+ (error
+ (set var old-val)
+ (message "Bad value for %s, restoring to previous value %s"
+ var old-val)
+ (sit-for 1)
+ nil))
+ )))
+
+
+(defun sh-learn-line-indent (arg)
+ "Learn how to indent a line as it currently is indented.
+
+If there is an indentation variable which controls this line's indentation,
+then set it to a value which would indent the line the way it
+presently is.
+
+If the value can be represented by one of the symbols then do so
+unless optional argument ARG (the prefix when interactive) is non-nil."
+ (interactive "*P")
+ (sh-must-support-indent)
+ ;; I'm not sure if we show allow learning on an empty line.
+ ;; Though it might occasionally be useful I think it usually
+ ;; would just be confusing.
+ (if (save-excursion
+ (beginning-of-line)
+ (looking-at "\\s-*$"))
+ (message "sh-learn-line-indent ignores empty lines.")
+ (let* ((info (sh-get-indent-info))
+ (var (sh-get-indent-var-for-line info))
+ ival sval diff new-val
+ (no-symbol arg)
+ (curr-indent (current-indentation)))
+ (cond
+ ((stringp var)
+ (message (format "Cannot learn line - %s" var)))
+ ((eq var 'sh-indent-comment)
+ ;; This is arbitrary...
+ ;; - if curr-indent is 0, set to curr-indent
+ ;; - else if it has the indentation of a "normal" line,
+ ;; then set to t
+ ;; - else set to curr-indent.
+ (setq sh-indent-comment
+ (if (= curr-indent 0)
+ 0
+ (let* ((sh-indent-comment t)
+ (val2 (sh-calculate-indent info)))
+ (if (= val2 curr-indent)
+ t
+ curr-indent))))
+ (message "%s set to %s" var (symbol-value var))
+ )
+ ((numberp (setq sval (sh-var-value var)))
+ (setq ival (sh-calculate-indent info))
+ (setq diff (- curr-indent ival))
+
+ (sh-debug "curr-indent: %d ival: %d diff: %d var:%s sval %s"
+ curr-indent ival diff var sval)
+ (setq new-val (+ sval diff))
+;;; I commented out this because someone might want to replace
+;;; a value of `+' with the current value of sh-basic-offset
+;;; or vice-versa.
+;;; (if (= 0 diff)
+;;; (message "No change needed!")
+ (sh-set-var-value var new-val no-symbol)
+ (message "%s set to %s" var (symbol-value var))
+ )
+ (t
+ (debug)
+ (message "Cannot change %s" var))))))
+
+
+
+(defun sh-mark-init (buffer)
+ "Initialize a BUFFER to be used by `sh-mark-line'."
+ (save-excursion
+ (set-buffer (get-buffer-create buffer))
+ (erase-buffer)
+ (occur-mode)
+ ))
+
+
+(defun sh-mark-line (message point buffer &optional add-linenum occur-point)
+ "Insert MESSAGE referring to location POINT in current buffer into BUFFER.
+Buffer BUFFER is in `occur-mode'.
+If ADD-LINENUM is non-nil the message is preceded by the line number.
+If OCCUR-POINT is non-nil then the line is marked as a new occurrence
+so that `occur-next' and `occur-prev' will work."
+ (let ((m1 (make-marker))
+ start
+ (line ""))
+ (when point
+ (set-marker m1 point (current-buffer))
+ (if add-linenum
+ (setq line (format "%d: " (1+ (count-lines 1 point))))))
+ (save-excursion
+ (if (get-buffer buffer)
+ (set-buffer (get-buffer buffer))
+ (set-buffer (get-buffer-create buffer))
+ (occur-mode)
+ )
+ (goto-char (point-max))
+ (setq start (point))
+ (insert line)
+ (if occur-point
+ (setq occur-point (point)))
+ (insert message)
+ (if point
+ (add-text-properties
+ start (point)
+ '(mouse-face highlight
+ help-echo "mouse-2: go to the line where I learned this")))
+ (insert "\n")
+ (if point
+ (progn
+ (put-text-property start (point) 'occur-target m1)
+ (if occur-point
+ (put-text-property start occur-point
+ 'occur-match t))
+ ))
+ )))
+
+
+
+;; Is this really worth having?
+(defvar sh-learned-buffer-hook nil
+ "*An abnormal hook, called with an alist of learned variables.")
+;; Example of how to use sh-learned-buffer-hook
+;;
+;; (defun what-i-learned (list)
+;; (let ((p list))
+;; (save-excursion
+;; (set-buffer "*scratch*")
+;; (goto-char (point-max))
+;; (insert "(setq\n")
+;; (while p
+;; (insert (format " %s %s \n"
+;; (nth 0 (car p)) (nth 1 (car p))))
+;; (setq p (cdr p)))
+;; (insert ")\n")
+;; )))
+;;
+;; (add-hook 'sh-learned-buffer-hook 'what-i-learned)
+
+
+;; Originally this was sh-learn-region-indent (beg end)
+;; However, in practice this was awkward so I changed it to
+;; use the whole buffer. Use narrowing if needbe.
+(defun sh-learn-buffer-indent (&optional arg)
+ "Learn how to indent the buffer the way it currently is.
+
+Output in buffer \"*indent*\" shows any lines which have conflicting
+values of a variable, and the final value of all variables learned.
+This buffer is popped to automatically if there are any discrepancies.
+
+If no prefix ARG is given, then variables are set to numbers.
+If a prefix arg is given, then variables are set to symbols when
+applicable -- e.g. to symbol `+' if the value is that of the
+basic indent.
+If a positive numerical prefix is given, then `sh-basic-offset'
+is set to the prefix's numerical value.
+Otherwise, sh-basic-offset may or may not be changed, according
+to the value of variable `sh-learn-basic-offset'.
+
+Abnormal hook `sh-learned-buffer-hook' if non-nil is called when the
+function completes. The function is abnormal because it is called
+with an alist of variables learned. This feature may be changed or
+removed in the future.
+
+This command can often take a long time to run."
+ (interactive "P")
+ (sh-must-support-indent)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((learned-var-list nil)
+ (out-buffer "*indent*")
+ (num-diffs 0)
+ previous-set-info
+ (max 17)
+ vec
+ msg
+ (comment-col nil) ;; number if all same, t if seen diff values
+ (comments-always-default t) ;; nil if we see one not default
+ initial-msg
+ (specified-basic-offset (and arg (numberp arg)
+ (> arg 0)))
+ (linenum 0)
+ suggested)
+ (setq vec (make-vector max 0))
+ (sh-mark-init out-buffer)
+
+ (if specified-basic-offset
+ (progn
+ (setq sh-basic-offset arg)
+ (setq initial-msg
+ (format "Using specified sh-basic-offset of %d"
+ sh-basic-offset)))
+ (setq initial-msg
+ (format "Initial value of sh-basic-offset: %s"
+ sh-basic-offset)))
+
+ (while (< (point) (point-max))
+ (setq linenum (1+ linenum))
+ ;; (if (zerop (% linenum 10))
+ (message "line %d" linenum)
+ ;; )
+ (unless (looking-at "\\s-*$") ;; ignore empty lines!
+ (let* ((sh-indent-comment t) ;; info must return default indent
+ (info (sh-get-indent-info))
+ (var (sh-get-indent-var-for-line info))
+ sval ival diff new-val
+ (curr-indent (current-indentation)))
+ (cond
+ ((null var)
+ nil)
+ ((stringp var)
+ nil)
+ ((numberp (setq sval (sh-var-value var 'no-error)))
+ ;; the numberp excludes comments since sval will be t.
+ (setq ival (sh-calculate-indent))
+ (setq diff (- curr-indent ival))
+ (setq new-val (+ sval diff))
+ (sh-set-var-value var new-val 'no-symbol)
+ (unless (looking-at "\\s-*#") ;; don't learn from comments
+ (if (setq previous-set-info (assoc var learned-var-list))
+ (progn
+ ;; it was already there, is it same value ?
+ (unless (eq (symbol-value var)
+ (nth 1 previous-set-info))
+ (sh-mark-line
+ (format "Variable %s was set to %s"
+ var (symbol-value var))
+ (point) out-buffer t t)
+ (sh-mark-line
+ (format " but was previously set to %s"
+ (nth 1 previous-set-info))
+ (nth 2 previous-set-info) out-buffer t)
+ (setq num-diffs (1+ num-diffs))
+ ;; (delete previous-set-info learned-var-list)
+ (setcdr previous-set-info
+ (list (symbol-value var) (point)))
+ )
+ )
+ (setq learned-var-list
+ (append (list (list var (symbol-value var)
+ (point)))
+ learned-var-list)))
+ (if (numberp new-val)
+ (progn
+ (sh-debug
+ "This line's indent value: %d" new-val)
+ (if (< new-val 0)
+ (setq new-val (- new-val)))
+ (if (< new-val max)
+ (aset vec new-val (1+ (aref vec new-val))))))
+ ))
+ ((eq var 'sh-indent-comment)
+ (unless (= curr-indent (sh-calculate-indent info))
+ ;; this is not the default indentation
+ (setq comments-always-default nil)
+ (if comment-col ;; then we have see one before
+ (or (eq comment-col curr-indent)
+ (setq comment-col t)) ;; seen a different one
+ (setq comment-col curr-indent))
+ ))
+ (t
+ (sh-debug "Cannot learn this line!!!")
+ ))
+ (sh-debug
+ "at %s learned-var-list is %s" (point) learned-var-list)
+ ))
+ (forward-line 1)
+ ) ;; while
+ (if sh-debug
+ (progn
+ (setq msg (format
+ "comment-col = %s comments-always-default = %s"
+ comment-col comments-always-default))
+ ;; (message msg)
+ (sh-mark-line msg nil out-buffer)))
+ (cond
+ ((eq comment-col 0)
+ (setq msg "\nComments are all in 1st column.\n"))
+ (comments-always-default
+ (setq msg "\nComments follow default indentation.\n")
+ (setq comment-col t))
+ ((numberp comment-col)
+ (setq msg (format "\nComments are in col %d." comment-col)))
+ (t
+ (setq msg "\nComments seem to be mixed, leaving them as is.\n")
+ (setq comment-col nil)
+ ))
+ (sh-debug msg)
+ (sh-mark-line msg nil out-buffer)
+
+ (sh-mark-line initial-msg nil out-buffer t t)
+
+ (setq suggested (sh-guess-basic-offset vec))
+
+ (if (and suggested (not specified-basic-offset))
+ (let ((new-value
+ (cond
+ ;; t => set it if we have a single value as a number
+ ((and (eq sh-learn-basic-offset t) (numberp suggested))
+ suggested)
+ ;; other non-nil => set it if only one value was found
+ (sh-learn-basic-offset
+ (if (numberp suggested)
+ suggested
+ (if (= (length suggested) 1)
+ (car suggested))))
+ (t
+ nil))))
+ (if new-value
+ (progn
+ (setq learned-var-list
+ (append (list (list 'sh-basic-offset
+ (setq sh-basic-offset new-value)
+ (point-max)))
+ learned-var-list))
+ ;; Not sure if we need to put this line in, since
+ ;; it will appear in the "Learned variable settings".
+ (sh-mark-line
+ (format "Changed sh-basic-offset to: %d" sh-basic-offset)
+ nil out-buffer))
+ (sh-mark-line
+ (if (listp suggested)
+ (format "Possible value(s) for sh-basic-offset: %s"
+ (mapconcat 'int-to-string suggested " "))
+ (format "Suggested sh-basic-offset: %d" suggested))
+ nil out-buffer))))
+
+
+ (setq learned-var-list
+ (append (list (list 'sh-indent-comment comment-col (point-max)))
+ learned-var-list))
+ (setq sh-indent-comment comment-col)
+ (let ((name (buffer-name)))
+ (sh-mark-line "\nLearned variable settings:" nil out-buffer)
+ (if arg
+ ;; Set learned variables to symbolic rather than numeric
+ ;; values where possible.
+ (dolist (learned-var (reverse learned-var-list))
+ (let ((var (car learned-var))
+ (val (nth 1 learned-var)))
+ (when (and (not (eq var 'sh-basic-offset))
+ (numberp val))
+ (sh-set-var-value var val)))))
+ (dolist (learned-var (reverse learned-var-list))
+ (let ((var (car learned-var)))
+ (sh-mark-line (format " %s %s" var (symbol-value var))
+ (nth 2 learned-var) out-buffer)))
+ (save-excursion
+ (set-buffer out-buffer)
+ (goto-char (point-min))
+ (insert
+ (format "Indentation values for buffer %s.\n" name)
+ (format "%d indentation variable%s different values%s\n\n"
+ num-diffs
+ (if (= num-diffs 1)
+ " has" "s have")
+ (if (zerop num-diffs)
+ "." ":"))
+ )))
+ ;; Are abnormal hooks considered bad form?
+ (run-hook-with-args 'sh-learned-buffer-hook learned-var-list)
+ (if (or sh-popup-occur-buffer (> num-diffs 0))
+ (pop-to-buffer out-buffer))
+ )))
+
+(defun sh-guess-basic-offset (vec)
+ "See if we can determine a reasonable value for `sh-basic-offset'.
+This is experimental, heuristic and arbitrary!
+Argument VEC is a vector of information collected by
+`sh-learn-buffer-indent'.
+Return values:
+ number - there appears to be a good single value
+ list of numbers - no obvious one, here is a list of one or more
+ reasonable choices
+ nil - we couldn't find a reasonable one."
+ (let* ((max (1- (length vec)))
+ (i 1)
+ (totals (make-vector max 0)))
+ (while (< i max)
+ (aset totals i (+ (aref totals i) (* 4 (aref vec i))))
+ (if (zerop (% i 2))
+ (aset totals i (+ (aref totals i) (aref vec (/ i 2)))))
+ (if (< (* i 2) max)
+ (aset totals i (+ (aref totals i) (aref vec (* i 2)))))
+ (setq i (1+ i)))
+
+ (let ((x nil)
+ (result nil)
+ tot sum p)
+ (setq i 1)
+ (while (< i max)
+ (if (/= (aref totals i) 0)
+ (setq x (append x (list (cons i (aref totals i))))))
+ (setq i (1+ i)))
+
+ (setq x (sort x (lambda (a b) (> (cdr a) (cdr b)))))
+ (setq tot (apply '+ (append totals nil)))
+ (sh-debug (format "vec: %s\ntotals: %s\ntot: %d"
+ vec totals tot))
+ (cond
+ ((zerop (length x))
+ (message "no values!")) ;; we return nil
+ ((= (length x) 1)
+ (message "only value is %d" (car (car x)))
+ (setq result (car (car x)))) ;; return single value
+ ((> (cdr (car x)) (/ tot 2))
+ ;; 1st is > 50%
+ (message "basic-offset is probably %d" (car (car x)))
+ (setq result (car (car x)))) ;; again, return a single value
+ ((>= (cdr (car x)) (* 2 (cdr (car (cdr x)))))
+ ;; 1st is >= 2 * 2nd
+ (message "basic-offset could be %d" (car (car x)))
+ (setq result (car (car x))))
+ ((>= (+ (cdr (car x))(cdr (car (cdr x)))) (/ tot 2))
+ ;; 1st & 2nd together >= 50% - return a list
+ (setq p x sum 0 result nil)
+ (while (and p
+ (<= (setq sum (+ sum (cdr (car p)))) (/ tot 2)))
+ (setq result (append result (list (car (car p)))))
+ (setq p (cdr p)))
+ (message "Possible choices for sh-basic-offset: %s"
+ (mapconcat 'int-to-string result " ")))
+ (t
+ (message "No obvious value for sh-basic-offset. Perhaps %d"
+ (car (car x)))
+ ;; result is nil here
+ ))
+ result)))
+
+;; ========================================================================
+
+;; Styles -- a quick and dirty way of saving the indentation settings.
+
+(defvar sh-styles-alist nil
+ "A list of all known shell indentation styles.")
+
+(defun sh-name-style (name &optional confirm-overwrite)
+ "Name the current indentation settings as a style called NAME.
+If this name exists, the command will prompt whether it should be
+overwritten if
+- - it was called interactively with a prefix argument, or
+- - called non-interactively with optional CONFIRM-OVERWRITE non-nil."
+ ;; (interactive "sName for this style: ")
+ (interactive
+ (list
+ (read-from-minibuffer "Name for this style? " )
+ (not current-prefix-arg)))
+ (let ((slist (cons name
+ (mapcar (lambda (var) (cons var (symbol-value var)))
+ sh-var-list)))
+ (style (assoc name sh-styles-alist)))
+ (if style
+ (if (and confirm-overwrite
+ (not (y-or-n-p "This style exists. Overwrite it? ")))
+ (message "Not changing style %s" name)
+ (message "Updating style %s" name)
+ (setcdr style (cdr slist)))
+ (message "Creating new style %s" name)
+ (push slist sh-styles-alist))))
+
+(defun sh-load-style (name)
+ "Set shell indentation values for this buffer from those in style NAME."
+ (interactive (list (completing-read
+ "Which style to use for this buffer? "
+ sh-styles-alist nil t)))
+ (let ((sl (assoc name sh-styles-alist)))
+ (if (null sl)
+ (error "sh-load-style - style %s not known" name)
+ (dolist (var (cdr sl))
+ (set (car var) (cdr var))))))
+
+(defun sh-save-styles-to-buffer (buff)
+ "Save all current styles in elisp to buffer BUFF.
+This is always added to the end of the buffer."
+ (interactive (list
+ (read-from-minibuffer "Buffer to save styles in? " "*scratch*")))
+ (with-current-buffer (get-buffer-create buff)
+ (goto-char (point-max))
+ (insert "\n")
+ (pp `(setq sh-styles-alist ',sh-styles-alist) (current-buffer))))
+
+