dot/lisp-init.lisp: Add the `HOME:' logical-pathname host on ECL.
[profile] / el / dot-emacs.el
index 70f1867..fc3c13f 100644 (file)
@@ -1196,14 +1196,28 @@ If there's no fill prefix currently set (by the `fill-prefix'
 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)
 
@@ -1227,16 +1241,41 @@ This is mainly useful in `auto-fill-mode'.")
          (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."
@@ -1261,6 +1300,22 @@ See `mdw-fill-prefix' for details."
        ((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)
@@ -1282,13 +1337,20 @@ case where there isn't a sensible static one."
   (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))))))
 
@@ -4203,10 +4265,6 @@ that character only to be normal punctuation.")
   (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)
@@ -4246,8 +4304,93 @@ that character only to be normal punctuation.")
              (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