variable) and there's a match from one of the regexps here, it
gets used to set the fill-prefix for the current operation.
-The variable is a list of items of the form `REGEXP . PREFIX'; if
-the REGEXP matches, the PREFIX is used to set the fill prefix.
-It in turn is a list of things:
+The variable is a list of items of the form `PATTERN . PREFIX'; if
+the PATTERN matches, the PREFIX is used to set the fill prefix.
- STRING -- insert a literal string
- (match . N) -- insert the thing matched by bracketed subexpression N
- (pad . N) -- a string of whitespace the same width as subexpression N
- (expr . FORM) -- the result of evaluating FORM")
+A PATTERN is one of the following.
+
+ * STRING -- a regular expression, expected to match at point
+ * (eval . FORM) -- a Lisp form which must evaluate non-nil
+ * (if COND CONSEQ-PAT ALT-PAT) -- if COND evaluates non-nil, must match
+ CONSEQ-PAT; otherwise must match ALT-PAT
+ * (and PATTERN ...) -- must match all of the PATTERNs
+ * (or PATTERN ...) -- must match at least one PATTERN
+ * (not PATTERN) -- mustn't match (probably not useful)
+
+A PREFIX is a list of the following kinds of things:
+
+ * STRING -- insert a literal string
+ * (match . N) -- insert the thing matched by bracketed subexpression N
+ * (pad . N) -- a string of whitespace the same width as subexpression N
+ * (expr . FORM) -- the result of evaluating FORM
+
+Information about `bracketed subexpressions' comes from the match data,
+as modified during matching.")
(make-variable-buffer-local 'mdw-fill-prefix)
(funcall tabfun (point-min) (point-max))
(setq s (buffer-substring (point-min) (1- (point-max)))))))))
-(defun mdw-examine-fill-prefixes (l)
- "Given a list of dynamic fill prefixes, pick one which matches
-context and return the static fill prefix to use. Point must be
-at the start of a line, and match data must be saved."
- (cond ((not l) nil)
- ((looking-at (car (car l)))
- (mdw-maybe-tabify (apply #'concat
- (mapcar #'mdw-do-prefix-match
- (cdr (car l))))))
- (t (mdw-examine-fill-prefixes (cdr l)))))
+(defun mdw-fill-prefix-match-p (pat)
+ "Return non-nil if PAT matches at the current position."
+ (cond ((stringp pat) (looking-at pat))
+ ((not (consp pat)) (error "Unknown pattern item `%S'" pat))
+ ((eq (car pat) 'eval) (eval (cdr pat)))
+ ((eq (car pat) 'if)
+ (if (or (null (cdr pat))
+ (null (cddr pat))
+ (null (cdddr pat))
+ (cddddr pat))
+ (error "Invalid `if' pattern `%S'" pat))
+ (mdw-fill-prefix-match-p (if (eval (cadr pat))
+ (caddr pat)
+ (cadddr pat))))
+ ((eq (car pat) 'and)
+ (let ((pats (cdr pat))
+ (ok t))
+ (while (and pats
+ (or (mdw-fill-prefix-match-p (car pats))
+ (setq ok nil)))
+ (setq pats (cdr pats)))
+ ok))
+ ((eq (car pat) 'or)
+ (let ((pats (cdr pat))
+ (ok nil))
+ (while (and pats
+ (or (not (mdw-fill-prefix-match-p (car pats)))
+ (progn (setq ok t) nil)))
+ (setq pats (cdr pats)))
+ ok))
+ ((eq (car pat) 'not)
+ (if (or (null (cdr pat)) (cddr pat))
+ (error "Invalid `not' pattern `%S'" pat))
+ (not (mdw-fill-prefix-match-p (car pats))))
+ (t (error "Unknown pattern form `%S'" pat))))
(defun mdw-maybe-car (p)
"If P is a pair, return (car P), otherwise just return P."
((eq (car m) 'eval) (eval (cdr m)))
(t "")))
+(defun mdw-examine-fill-prefixes (l)
+ "Given a list of dynamic fill prefixes, pick one which matches
+context and return the static fill prefix to use. Point must be
+at the start of a line, and match data must be saved."
+ (let ((prefix nil))
+ (while (cond ((null l) nil)
+ ((mdw-fill-prefix-match-p (caar l))
+ (setq prefix
+ (mdw-maybe-tabify
+ (apply #'concat
+ (mapcar #'mdw-do-prefix-match
+ (cdr (car l))))))
+ nil))
+ (setq l (cdr l)))
+ prefix))
+
(defun mdw-choose-dynamic-fill-prefix ()
"Work out the dynamic fill prefix based on the variable `mdw-fill-prefix'."
(cond ((and fill-prefix (not (string= fill-prefix ""))) fill-prefix)
(let ((fill-prefix (mdw-choose-dynamic-fill-prefix)))
(fill-paragraph nil)))
+(defun mdw-point-within-string-p ()
+ "Return non-nil if point is within a string."
+ (let ((state (syntax-ppss)))
+ (elt state 3)))
+
(defun mdw-standard-fill-prefix (rx &optional mat)
"Set the dynamic fill prefix, handling standard hanging indents and stuff.
This is just a short-cut for setting the thing by hand, and by
design it doesn't cope with anything approximating a complicated
case."
(setq mdw-fill-prefix
- `((,(concat rx mdw-hanging-indents)
+ `(((if (mdw-point-within-string-p)
+ ,(concat "\\(\\s-*\\)" mdw-hanging-indents)
+ ,(concat rx mdw-hanging-indents))
(match . 1)
(pad . ,(or mat 2))))))
(make-local-variable 'lisp-indent-function)
(setq lisp-indent-function 'common-lisp-indent-function))
-(setq-default lisp-simple-loop-indentation 2
- lisp-loop-keyword-indentation 6
- lisp-loop-forms-indentation 6)
-
(defmacro mdw-advise-hyperspec-lookup (func args)
`(defadvice ,func (around mdw-browse-w3m ,args activate compile)
(if (fboundp 'w3m)
(list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)"
'(0 mdw-punct-face)))))
+;; Special indentation.
+
+(defvar mdw-lisp-loop-default-indent 2)
+
+(setq lisp-simple-loop-indentation 0
+ lisp-loop-keyword-indentation 0
+ lisp-loop-forms-indentation 2
+ lisp-lambda-list-keyword-parameter-alignment t)
+
+(defun mdw-indent-funcall (path state indent-point sexp-column normal-indent)
+ "Indent `funcall' more usefully.
+Essentially, treat `funcall foo' as a function name, and align the arguments
+to `foo'."
+ (and (null (cdr path))
+ (save-excursion
+ (goto-char (cadr state))
+ (forward-char 1)
+ (let ((start-line (line-number-at-pos)))
+ (and (condition-case nil (progn (forward-sexp 3) t)
+ (scan-error nil))
+ (progn
+ (forward-sexp -1)
+ (and (= start-line (line-number-at-pos))
+ (current-column))))))))
+(put 'funcall 'common-lisp-indent-function 'mdw-indent-funcall)
+
+(defadvice common-lisp-loop-part-indentation
+ (around mdw-fix-loop-indentation (indent-point state) activate compile)
+ "Improve `loop' indentation.
+If the first subform is on the same line as the `loop' keyword, then
+align the other subforms beneath it. Otherwise, indent them
+`mdw-lisp-loop-default-indent' columns in from the opening parenthesis."
+
+ (let* ((loop-indentation (save-excursion
+ (goto-char (elt state 1))
+ (current-column))))
+
+ ;; Don't really care about this.
+ (when (and (eq lisp-indent-backquote-substitution-mode 'corrected))
+ (save-excursion
+ (goto-char (elt state 1))
+ (cl-incf loop-indentation
+ (cond ((eq (char-before) ?,) -1)
+ ((and (eq (char-before) ?@)
+ (progn (backward-char)
+ (eq (char-before) ?,)))
+ -2)
+ (t 0)))))
+
+ ;; If the first loop item is on the same line as the `loop' itself then
+ ;; use that as the baseline. Otherwise advance by the default indent.
+ (goto-char (cadr state))
+ (forward-char 1)
+ (let ((baseline-indent
+ (if (= (line-number-at-pos)
+ (if (condition-case nil (progn (forward-sexp 2) t)
+ (scan-error nil))
+ (progn (forward-sexp -1) (line-number-at-pos))
+ -1))
+ (current-column)
+ (+ loop-indentation mdw-lisp-loop-default-indent))))
+
+ (goto-char indent-point)
+ (beginning-of-line)
+
+ (setq ad-return-value
+ (list
+ (cond ((not (lisp-extended-loop-p (elt state 1)))
+ (+ baseline-indent lisp-simple-loop-indentation))
+ ((looking-at "^\\s-*\\(:?\\sw+\\|;\\)")
+ (+ baseline-indent lisp-loop-keyword-indentation))
+ (t
+ (+ baseline-indent lisp-loop-forms-indentation)))
+
+ ;; Tell the caller that the next line needs recomputation, even
+ ;; though it doesn't start a sexp.
+ loop-indentation)))))
+
;; SLIME setup.
+(defvar mdw-friendly-name "[mdw]"
+ "How I want to be addressed.")
+(defadvice slime-user-first-name
+ (around mdw-use-friendly-name compile activate)
+ (if mdw-friendly-name (setq ad-return-value mdw-friendly-name)
+ ad-do-it))
+
(trap
(if (not mdw-fast-startup)
(progn