(require 'cl)
(require 'parenface)
(require 'mic-paren)
(require 'paredit)
(require 'hl-sexp)
(paren-activate)
(setf paren-priority 'close)
(require 'outline)
(require 'slime)
(setq slime-lisp-implementations
'((sbcl ("/usr/bin/sbcl" "--noinform") :coding-system iso-latin-1-unix)
(cmucl ("/usr/bin/lisp") :coding-system iso-latin-1-unix)
(clisp ("/usr/bin/clisp" "-K" "full") :coding-system utf-8-unix)))
(slime-setup :autodoc t)
(setq slime-complete-symbol-function 'slime-complete-symbol*
common-lisp-hyperspec-root "file:///usr/share/doc/hyperspec-7.0/HyperSpec/"
slime-sbcl-manual-root "file:///usr/share/doc/sbcl-0.9.14/html/sbcl/"
slime-startup-animation nil
slime-kill-without-query-p t
slime-enable-evaluate-in-emacs t
slime-ed-use-dedicated-frame nil)
(defun oa:basic-lisp-mode-hook ()
(paredit-mode 1)
(set-fill-column 80)
(auto-fill-mode 1))
(defun oa:emacs-lisp-mode-hook ()
(oa:basic-lisp-mode-hook)
(eldoc-mode 1))
(defun oa:common-lisp-mode-hook ()
(oa:basic-lisp-mode-hook)
(set (make-local-variable 'lisp-indent-function)
'common-lisp-indent-function))
(add-hook 'lisp-mode-hook #'oa:common-lisp-mode-hook)
(add-hook 'emacs-lisp-mode-hook #'oa:emacs-lisp-mode-hook)
(def-slime-selector-method ?a "interactive emacs lisp REPL buffer."
(or (get-buffer "*ielm*")
(progn (ielm)
(get-buffer "*ielm*"))))
(def-slime-selector-method ?w "emacs lisp scratch buffer."
(get-buffer-create "*scratch*"))
(defun oa:end-of-defun (&optional arg)
"Move to end of defun leaving point directly after the closing paren."
(interactive "p")
(forward-char 1)
(end-of-defun arg)
(backward-char 1))
(defun oa:reformat-defun ()
"Reformat trailing parentheses Lisp-stylishly and reindent toplevel form."
(interactive)
(save-excursion
(oa:end-of-defun)
(slime-close-all-sexp)
(slime-reindent-defun)))
(defun oa:close-all-sexp-and-reindent (&optional region)
"Balance parentheses of open s-expressions at point.
Insert enough right parentheses to balance unmatched left parentheses.
Delete extra left parentheses. Reformat trailing parentheses
Lisp-stylishly."
(interactive)
(slime-close-all-sexp region)
(newline-and-indent)
(slime-reindent-defun))
(defun oa:move-past-close-and-reindent ()
"Move past the closing paren and reindent. "
(interactive)
(condition-case c
(move-past-close-and-reindent)
(error (oa:close-all-sexp-and-reindent))))
(defun oa:close-list ()
"Move past the closing paren. At toplevel add a newline."
(interactive)
(delete-horizontal-space)
(condition-case c
(paredit-close-parenthesis)
(scan-error (unless (looking-at "^$")
(slime-close-all-sexp)
(reindent-then-newline-and-indent)))))
(defun oa:close-list-and-newline ()
"Move past the closing paren. At toplevel add a newline."
(interactive)
(delete-horizontal-space)
(condition-case c
(paredit-close-parenthesis-and-newline)
(scan-error (unless (looking-at "^$")
(slime-close-all-sexp)
(reindent-then-newline-and-indent)))))
(defun oa:backward-up-list-or-backward-sexp ()
"Move point one list up or one sexp backwards if at toplevel. "
(interactive)
(condition-case c
(backward-up-list)
(scan-error (paredit-backward))))
(defun oa:backward-down-list-or-backward-sexp ()
"Move point one list up or one sexp backwards if at toplevel. "
(interactive)
(condition-case c
(backward-down-list)
(scan-error (paredit-backward))))
(defun oa:down-list-or-forward-sexp ()
"Move point one list down or one sexp forward if at lowest level. "
(interactive)
(condition-case c
(down-list)
(scan-error
(paredit-forward))))
(defun oa:mark-list (&optional arg)
"Repeatedly select ever larger balanced expressions around the cursor.
Once you have such an expression marked, you can expand to the end of
the following expression with \\[mark-sexp] and to the beginning of the
previous with \\[backward-sexp]."
(interactive "p")
(condition-case c
(progn
(backward-up-list arg)
(let ((end (save-excursion (forward-sexp) (point))))
(push-mark end nil t)))
(scan-error (mark-sexp))))
(defun oa:backward-up-list-and-kill (&optional arg)
"Kill sexp point is in."
(interactive "p")
(backward-up-list arg)
(kill-sexp))
(defun oa:insert-double-quotes (&optional arg)
"Wrap region in double quotes if region is active, else call paredit-"
(interactive "P")
(if mark-active
(insert-pair arg)
(paredit-doublequote arg)))
(global-set-key [(control c) ?r] 'slime-selector)
(defmacro define-lisp-key (keyspec command)
`(progn
,@(mapcar (lambda (map)
`(define-key ,map ,keyspec ,command))
'(slime-mode-map lisp-mode-map emacs-lisp-mode-map))))
(defvar oa:lisp-key-bindings
`(("C-z" ,#'yank)
(")" ,#'oa:close-list)
("C-(" ,#'paredit-wrap-sexp)
("C-)" ,#'oa:close-list-and-newline)
("M-(" ,#'paredit-backward-slurp-sexp)
("M-)" ,#'paredit-forward-slurp-sexp)
("C-c )" ,#'slime-close-all-sexp)
("C-M-(" ,#'paredit-backward-barf-sexp)
("C-M-)" ,#'paredit-forward-barf-sexp)
("M-a" ,#'beginning-of-defun)
("M-e" ,#'oa:end-of-defun)
("C-c C-b" ,#'oa:backward-up-list-and-kill)
("M-f" ,#'transpose-sexps)
("C-M-f" ,#'transpose-words)
("M-'" ,#'oa:reformat-defun)
("C-M-S-SPC" ,#'oa:mark-list)
("M-h" ,#'paredit-backward)
("M-n" ,#'paredit-forward)
("M-w" ,#'down-list)
("M-t" ,#'backward-up-list)
("M-d" ,#'kill-sexp)
("M-b" ,#'backward-kill-sexp)
("M-p" ,#'slime-pop-find-definition-stack)
("C-M-n" ,#'forward-word)
("C-M-h" ,#'backward-word)
("C-M-w" ,#'up-list)
("C-M-t" ,#'backward-down-list)
("C-M-d" ,#'paredit-forward-kill-word)
("C-M-b" ,#'backward-kill-word)
("C-c RET" ,#'oa:close-all-sexp-and-reindent)
("M-RET" ,#'oa:move-past-close-and-reindent)
("<M-return>" ,#'indent-new-comment-line)
("RET" ,#'paredit-newline)))
(oa:setup-keys paredit-mode-map oa:dvorak-keys)
(oa:setup-keys paredit-mode-map oa:lisp-key-bindings)
(oa:setup-keys emacs-lisp-mode-map oa:lisp-key-bindings)
(oa:setup-keys slime-mode-map oa:dvorak-keys)
(oa:setup-keys slime-mode-map oa:lisp-key-bindings)
(define-key slime-mode-map [(control c) (control d) (control d)] #'slime-describe-symbol)
(define-key emacs-lisp-mode-map [(control c) (control d) (control d)] #'describe-foo-at-point)
(dolist (binding '("RET"))
(define-key paredit-mode-map (read-kbd-macro binding) nil))
(define-key emacs-lisp-mode-map [(tab)]
(make-region-indent-completion-function (lisp-complete-symbol)))
(define-key lisp-mode-map [(tab)]
(make-region-indent-completion-function (slime-complete-symbol) (lisp-indent-line)))
(define-key slime-mode-map [(tab)]
(make-region-indent-completion-function (slime-complete-symbol) (lisp-indent-line)))
(define-key slime-mode-map [(control c) tab] 'slime-complete-form)
(define-key emacs-lisp-mode-map [(control c) (control c)] #'compile-defun)
(define-key emacs-lisp-mode-map [(f1)] 'describe-foo-at-point)
(define-key emacs-lisp-mode-map [(control f1)] 'describe-function)
(define-key emacs-lisp-mode-map [(shift f1)] 'describe-variable)
(define-key emacs-lisp-mode-map [(f3)] 'eval-last-sexp)
(define-key emacs-lisp-mode-map [(control f3)] 'eval-buffer)
(define-key emacs-lisp-mode-map [(shift f3)] 'eval-region)
(define-key emacs-lisp-mode-map [(f5)] 'find-variable-at-point)
(define-key emacs-lisp-mode-map [(control f5)] 'find-variable)
(define-key emacs-lisp-mode-map [(f6)] 'find-function-at-point)
(define-key emacs-lisp-mode-map [(control f6)] 'find-function)
(define-key emacs-lisp-mode-map [(shift f6)] 'find-library)
(defun describe-foo-at-point ()
"Show the documentation of the Elisp function and variable near point.
This checks in turn:
-- for a function name where point is
-- for a variable name where point is
-- for a surrounding function call
"
(interactive)
(let (sym)
(cond ((setq sym (ignore-errors
(with-syntax-table emacs-lisp-mode-syntax-table
(save-excursion
(or (not (zerop (skip-syntax-backward "_w")))
(eq (char-syntax (char-after (point))) ?w)
(eq (char-syntax (char-after (point))) ?_)
(forward-sexp -1))
(skip-chars-forward "`'")
(let ((obj (read (current-buffer))))
(and (symbolp obj) (fboundp obj) obj))))))
(describe-function sym))
((setq sym (variable-at-point)) (describe-variable sym))
((setq sym (function-at-point)) (describe-function sym)))))
(cond ((not (fboundp 'replace-regexp-in-string))
(defun replace-regexp-in-string (regexp rep string &optional
fixedcase literal subexp start)
"Replace all matches for REGEXP with REP in STRING.
Return a new string containing the replacements.
Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
arguments with the same names of function `replace-match'. If START
is non-nil, start replacements at that index in STRING.
REP is either a string used as the NEWTEXT arg of `replace-match' or a
function. If it is a function it is applied to each match to generate
the replacement passed to `replace-match'; the match-data at this
point are such that match 0 is the function's argument.
To replace only the first match (if any), make REGEXP match up to \\'
and replace a sub-expression, e.g.
(replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1)
=> \" bar foo\"
"
(let ((l (length string))
(start (or start 0))
matches str mb me)
(save-match-data
(while (and (< start l) (string-match regexp string start))
(setq mb (match-beginning 0)
me (match-end 0))
(when (= me mb) (setq me (min l (1+ mb))))
(string-match regexp (setq str (substring string mb me)))
(setq matches
(cons (replace-match (if (stringp rep)
rep
(funcall rep (match-string 0 str)))
fixedcase literal str subexp)
(cons (substring string start mb) matches)))
(setq start me))
(setq matches (cons (substring string start l) matches)) (apply #'concat (nreverse matches)))))
))
(if (not (fboundp 'replace-in-string))
(defun replace-in-string (string regexp replacement &optional literal)
"Replace regex in string with replacement"
(replace-regexp-in-string regexp replacement string t literal)))
(unless (fboundp 'font-lock-add-keywords)
(defalias 'font-lock-add-keywords 'ignore))
(if (boundp 'mark-active)
(defun mark-or-region-active ()
"check if the region is currenty active"
mark-active)
(defun mark-or-region-active ()
"check if the region is currenty active"
zmacs-region-active-p))
(put 'defsystem 'common-lisp-indent-function '(4 2))
(push `(("\\.asd\\'" . "ASDF Skeleton")
"System Name: "
";;; -*- lisp -*-
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package #:" str ".system)
(defpackage #:" str ".system
(:use :common-lisp :asdf))))
(in-package #:" str ".system)
(defsystem :" str "
:description " ?\" (read-string "Description: ") ?\""
:long-description " ?\" (read-string "Long Description: ") ?\""
:version \"" (completing-read "Version: " nil nil nil "0.1") "\"
:author \"" (user-full-name) " <" user-mail-address ">\"
:maintainer \"" (user-full-name) " <" user-mail-address ">\"
:licence \"" (completing-read "License: " '(("GPL" 1) ("LGPL" 2) ("LLGPL" 3) ("BSD" 4)))"\"
:depends-on ()
:in-order-to ((test-op (load-op : " str "-test)))
:perform (test-op :after (op c)
(funcall (intern (string '#:run!) '#:it.bese.FiveAM) :" str "))
:components ((:doc-file \"README\")
(:static-file \"" str ".asd\")
(:module \"src\"
:components ((:file \"packages\")
(:file " str " :depends-on (\"packages\"))))))
(defsystem :" str "-test
:components ((:module \"test\"
:components ()))
:depends-on (:" str " :FiveAM))
(defmethod operation-done-p ((o test-op) (c (eql (find-system :" str "))))
(values nil))
") auto-insert-alist)