FG42
/
FG42
1
0
Fork 1
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Rails support added, with tomorrow theme

This commit is contained in:
Sameer Rahmani 2013-06-06 21:22:40 +04:30
parent 7fe81704e9
commit 8e3362f944
37 changed files with 7771 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
conf/dotkuso
View File

@ -9,12 +9,11 @@
(global-linum-mode)
;; Setting up color them -------------------------------------------------------
(require 'color-theme)
(eval-after-load "color-theme"
'(progn
(color-theme-initialize)
(color-theme-arjen)
))
(color-theme-tomorrow-night-eighties)
))
;; Setting up customization -----------------------------------------------------
(custom-set-variables
@ -270,3 +269,32 @@ l;; css flymake ----------------------------------------------------------------
(global-set-key (kbd "C-x p") 'git-gutter:previous-diff)
(global-set-key (kbd "C-x n") 'git-gutter:next-diff)
;;/git-gutter;;
;; Yaml mode --------------------------------------
(require 'yaml-mode)
(add-to-list 'auto-mode-alist '("\\.yml$" . yaml-mode))
(add-hook 'yaml-mode-hook
'(lambda ()
(define-key yaml-mode-map "\C-m" 'newline-and-indent)))
(autoload 'inf-ruby "inf-ruby" "Run an inferior Ruby process" t)
(autoload 'inf-ruby-setup-keybindings "inf-ruby" "" t)
(eval-after-load 'ruby-mode
'(add-hook 'ruby-mode-hook 'inf-ruby-setup-keybindings))
(add-to-list 'load-path "~/.kuso.d/rinari")
(require 'rinari)
(setq rinari-tags-file-name "TAGS")
(add-to-list 'load-path "~/.kuso.d/rhtml")
(require 'rhtml-mode)
(add-hook 'rhtml-mode-hook
(lambda () (rinari-launch)))
(show-paren-mode t)

5
conf/emacs.d/ecb/.gitignore vendored
View File

@ -1,5 +0,0 @@
*.elc
*~
/TAGS
/html-help/
/info-help/

321
conf/emacs.d/rhtml/rhtml-erb.el Normal file
View File

@ -0,0 +1,321 @@
;;;
;;; rhtml-erb.el - ERB tag support for `rhtml-mode'
;;;
;; ***** BEGIN LICENSE BLOCK *****
;; Version: MPL 1.1/GPL 2.0/LGPL 2.1
;; The contents of this file are subject to the Mozilla Public License Version
;; 1.1 (the "License"); you may not use this file except in compliance with
;; the License. You may obtain a copy of the License at
;; http://www.mozilla.org/MPL/
;; Software distributed under the License is distributed on an "AS IS" basis,
;; WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
;; for the specific language governing rights and limitations under the
;; License.
;; The Original Code is ERB Tag Support for RHTML-MODE.
;; The Initial Developer of the Original Code is
;; Paul Nathan Stickney <pstickne@gmail.com>.
;; Portions created by the Initial Developer are Copyright (C) 2006
;; the Initial Developer. All Rights Reserved.
;; Contributor(s):
;; Alternatively, the contents of this file may be used under the terms of
;; either the GNU General Public License Version 2 or later (the "GPL"), or
;; the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
;; in which case the provisions of the GPL or the LGPL are applicable instead
;; of those above. If you wish to allow use of your version of this file only
;; under the terms of either the GPL or the LGPL, and not to allow others to
;; use your version of this file under the terms of the MPL, indicate your
;; decision by deleting the provisions above and replace them with the notice
;; and other provisions required by the GPL or the LGPL. If you do not delete
;; the provisions above, a recipient may use your version of this file under
;; the terms of any one of the MPL, the GPL or the LGPL.
;; ***** END LICENSE BLOCK *****
;;; History
;; 2006SEP12 - Created
;; Brief note on conventions:
;; DELIM - refers to the things like <% and %>
;; TAG - refers to entire <%ERB%> area, -including- the delims
;; (load-file "~/.emacs.d/macro-utils.el")
;; (defmacro symbol-name-or-nil (symbol)
;; (once-only (symbol)
;; `(if ,symbol (symbol-name ,symbol))))
;; (put 'symbol-name-or-nil 'lisp-indent-function 1)
(defconst rhtml-erb-open-delim
"<%"
"ERB opening tag.
Due to implementation of `sgml-mode', this absolutely must begin with a
< and be at least two characters long to work correctly.")
(defconst rhtml-erb-close-delim
"%>"
"ERB ending tag.
I don't think this has any restrictions.")
(defconst rhtml-erb-open-delim-len
(length rhtml-erb-open-delim))
(defconst rhtml-erb-close-delim-len
(length rhtml-erb-open-delim))
(defconst rhtml-erb-delim-re
(concat rhtml-erb-open-delim "\\|" rhtml-erb-close-delim))
(defconst rhtml-erb-tag-open-re
(concat rhtml-erb-open-delim "\\(?:-=\\|[-=#]?\\)?"))
;; specific tags
(defconst rhtml-erb-exec-tag-open-re
(concat rhtml-erb-open-delim "\\(?:-\\(?:[^=#]\\|$\\)\\|[^-=#]\\|$\\)")
"<%, and who would have thought it would be so complicated?")
(defconst rhtml-erb-out-tag-open-re
(concat rhtml-erb-open-delim "-?=")
"<%=")
(defconst rhtml-erb-comment-tag-open-re
(concat rhtml-erb-open-delim "-?#")
"<%#")
(defconst rhtml-erb-tag-body-re
"\\(?:.\\|\n\\)*?")
(defconst rhtml-erb-tag-close-re
(concat "-?" rhtml-erb-close-delim))
(defconst rhtml-erb-tag-re
(concat "\\(" rhtml-erb-tag-open-re "\\)"
"\\(" rhtml-erb-tag-body-re "\\)"
"\\(" rhtml-erb-tag-close-re "\\)"))
(defun rhtml-erb-delim-type (start-delim)
"Return `exec', `out', `comment' or nil dependin on the type of delimeter this is."
(flet ((match? (regex)
(eq (string-match regex start-delim) 0)))
(cond ((match? rhtml-erb-exec-tag-open-re)
'exec)
((match? rhtml-erb-out-tag-open-re)
'out)
((match? rhtml-erb-comment-tag-open-re)
'comment))))
(defun rhtml-erb-middle-offset (prev-line-start cur-line-start)
"Helper method for modified `sgml-calculate-indent'.
Calculates adjustment of branches like \"else\". PREV-LINE-START
and CUR-LINE-START should be the first non-white space on each
line, respectively."
(save-excursion
(+ (progn
(goto-char cur-line-start)
(if (rhtml-scan-for-erb-tags '(erb-middle)) sgml-basic-offset 0))
(progn
(goto-char prev-line-start)
(if (rhtml-scan-for-erb-tags '(erb-middle)) (- sgml-basic-offset) 0)))))
(defconst rhtml-erb-block-open-re
(concat "[]A-Za-z_)}][ ]+do[ ]+\\(?:|[A-Za-z_, ]*|\\)?[ ]*" rhtml-erb-tag-close-re))
(defconst rhtml-erb-brace-block-open-re
(concat "[ ]+{[ ]+\\(?:|[A-Za-z_, ]*|\\)?[ ]*" rhtml-erb-tag-close-re)
"Slightly less strictive to allow for \"hash = {\n\".")
(defmacro rhtml-erb-block-open-p ()
"Guess if a Ruby fragment opens a block with do.
Returns `block' or `brace-block' on success."
`(re-search-forward ,rhtml-erb-block-open-re nil t))
(defmacro rhtml-erb-brace-block-open-p ()
"Guess if a Ruby fragment opens a brace block (with {)
Returns `block' or `brace-block' on success."
`(re-search-forward ,rhtml-erb-brace-block-open-re nil t))
(defun rhtml-at-erb-tag-p ()
"Returns (TAG-START . TAG-END) if at beginning of ERB tag."
(if (looking-at rhtml-erb-tag-re)
(cons (match-beginning 0) (match-end 0))))
(defun rhtml-skip-erb-tag ()
"Skips over an ERB tag starting at (POINT); returns non-nil if succesful.
If the search is successful (POINT) will be advanced."
(let ((found (rhtml-at-erb-tag-p)))
(when found
(goto-char (cdr found)))))
(defun rhtml-erb-tag-type-p (type)
(memq type '(erb-open erb-middle erb-close erb-data)))
(defun rhtml-scan-for-erb-tags (tags)
"Like `rhtml-scan-erb-tag' but will only return (ERB-TYPE . NAME)
if (memq ERB-TYPE tags)."
(let ((start (point))
(tag-info (rhtml-scan-erb-tag)))
(if (memq (car tag-info) tags)
tag-info
;; reset on failure
(goto-char start)
nil)))
(defun rhtml-scan-erb-tag ()
"Scans an ERB tag moving (POINT) to the end and returning (ERB-TYPE . NAME) on success.
ERB-TYPE is `erb-open', `erb-data', `erb-middle', or `erb-close'.
NAME is something like \"erb-brace-block\" or \"erb-start-form-tag\" that is
used for level-matching."
(let* ((erb-tag (rhtml-at-erb-tag-p))
(erb-tag-end (cdr erb-tag)))
(cond (erb-tag
;; Lead-in
(looking-at rhtml-erb-tag-open-re)
(goto-char (match-end 0))
(skip-whitespace-forward)
(prog1
(save-restriction
(narrow-to-region (point) erb-tag-end) ;(- end 2))
(cond ((looking-at "if \\|unless ")
(cons 'erb-open "erb-multi-block"))
((looking-at "for\\b\\|while ")
(cons 'erb-open "erb-block"))
((rhtml-erb-block-open-p)
(cons 'erb-open "erb-block"))
((rhtml-erb-brace-block-open-p)
(cons 'erb-open "erb-brace-block"))
((looking-at "else \\|elsif")
(cons 'erb-middle "erb-middle"))
((looking-at "end\\b")
(cons 'erb-close "erb-block"))
((looking-at "}")
(cons 'erb-close "erb-brace-block"))
((looking-at "start_form_tag\\b")
(cons 'erb-open "erb-form-tag"))
((looking-at "end_form_tag\\b")
(cons 'erb-close "erb-form-tag"))
(t
(cons 'erb-data "erb-data"))))
(goto-char erb-tag-end)))
(t ;no match
(cons nil nil)))))
;; TODO - simply by removing point parameter
(defun rhtml-erb-tag-region (&optional point)
"If inside a ERB tag returns (START . END) of the tag, otherwise nil.
If POINT is specified it will be used instead of (POINT)."
(if point
(save-excursion
(goto-char point)
(rhtml-erb-tag-region))
(let ((prev (save-excursion ; -> (STR . START)
(skip-chars-forward rhtml-erb-open-delim)
(when (re-search-backward rhtml-erb-delim-re nil t)
(cons (match-string 0) (match-beginning 0)))))
(next (save-excursion ; -> (STR . END)
(skip-chars-backward rhtml-erb-open-delim)
(when (re-search-forward rhtml-erb-delim-re nil t)
(cons (match-string 0) (match-end 0))))))
;; limit matches to valid regions
(when (and (string= (car prev) rhtml-erb-open-delim)
(string= (car next) rhtml-erb-close-delim))
(cons (cdr prev) (cdr next))))))
(defun rhtml-erb-regions (begin end)
"Returns a list of elements in the form (TYPE START END) where type is
`exec', `comment', `out'."
(let* (tag-start regions last-tag-end)
(catch 'done
(save-excursion
(goto-char begin)
(while t
(when (not (search-forward rhtml-erb-open-delim end t))
(throw 'done regions))
(setq tag-start (- (point) 2))
(when (not (search-forward rhtml-erb-close-delim end t))
(throw 'done regions))
;; erb tag
(push (list
(case (char-after (+ tag-start 2))
(?= 'out) (?# 'comment) (t 'exec))
tag-start (point))
regions))))))
;; PST -- what is the point? At the very least it needs a better name.
(defun rhtml-erb-regions2 (begin end)
"Returns a list of elements in the form (TYPE START END) where type is
`exec', `comment', `out' or, for non-ERb secions, `other'."
(let* (tag-start regions last-tag-end)
(catch 'done
(save-excursion
(goto-char begin)
(while t
(when (not (search-forward rhtml-erb-open-delim end t))
;; no more erb tags
(push (list 'other (or last-tag-end begin) end)
regions)
(throw 'done regions))
(setq tag-start (- (point) 2))
(when (not (search-forward rhtml-erb-close-delim end t))
(throw 'done regions))
;; other section
;; PST -- may catch partial start tag
(when (> (point) (or last-tag-end begin))
(push (list 'other begin (point))
regions))
(setq last-tag-end (point))
;; erb tag
(push (list
(case (char-after (+ tag-start 2))
(?= 'out) (?# 'comment) (t 'exec))
tag-start (point))
regions))))))
(defun rhtml-union-region-containing-erb-tags (r-start r-end)
"Returns (START . END) for a region which is an aggregate of
the region defined by R-START, R-END and any ERB tags which
start, stop, or are contained in the region."
(let* ((unopened-tag (rhtml-erb-tag-region r-start))
(unclosed-tag (rhtml-erb-tag-region r-end))
(new-start (or (and unopened-tag (car unopened-tag)) r-start))
(new-end (or (and unclosed-tag (cdr unclosed-tag)) r-end)))
(cons new-start new-end)))
(defun rhtml-widen-to-erb-tag ()
"Widens the buffer to the ERB tag.
If no ERB tag is found the buffer will be reset to pre-state.
The point is advanced to the beginning of the new region (even if no ERB found)."
(let ((r-start (point-min))
(r-end (point-max)))
(widen)
(let ((region (rhtml-erb-tag-region)))
(when region
(setq r-start (car region))
(setq r-end (cdr region)))
(narrow-to-region r-start r-end)
(goto-char (point-min)))))
(defun rhtml-region-has-erb-tag-p (start end)
"Returns non-nil if the region bounded by START and END
contains an ERB tag."
(save-excursion
(goto-char start)
(re-search-forward rhtml-erb-tag-re end t)))
;; utility functions
(defun skip-whitespace-forward ()
"Skip forward common ([ \t\r\n]) whitespace."
(skip-chars-forward " \t\r\n"))
;;
(provide 'rhtml-erb)

177
conf/emacs.d/rhtml/rhtml-fonts.el Normal file
View File

@ -0,0 +1,177 @@
;;;
;;; rhtml-fonts.el - font-lock-based fontification support for `rhtml-mode'
;;;
;; This file is not part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;; 2007 MAR 22 - Rewrote to work with jit-lock-mode, cleanup
;; 2007 MAR 28 - PST: changed to GPL license from MPL (using font-lock code)
(defvar rhtml-in-erb-keywords
'(;("\\([A-Z][0-9a-zA-Z_]*\\)" . (1 font-lock-type-face prepend))
("[^_]\\<\\(alias\\|and\\|begin\\|break\\|case\\|catch\\|class\\|def\\|do\\|elsif\\|else\\|fail\\|ensure\\|for\\|end\\|if\\|in\\|module\\|next\\|not\\|or\\|raise\\|redo\\|rescue\\|retry\\|return\\|then\\|throw\\|super\\|unless\\|undef\\|until\\|when\\|while\\|yield\\|render\\)\\>[^_]" .
(1 font-lock-keyword-face prepend))
("\\(@[0-9a-zA-Z_]*\\)" . (1 font-lock-variable-name-face prepend))
("\\(:[0-9a-zA-Z_]*\\)" . (1 font-lock-constant-face prepend))))
(defvar rhtml-font-lock-syntactic-keywords
'(("\\(<\\)!--" (1 "< b"))
("--[ \t\n]*\\(>\\)" (1 "> b"))
("\\(<\\)%" (1 "<"))
("%\\(>\\)" (1 ">"))
"Override `sgml-mode' syntactic keywords to support ERb tags."))
(defun rhtml-activate-fontification ()
"Activate font-lock fontification support for the current buffer."
;; PST: note `jit-lock-mode' seems to play okay with
;; `font-lock-mode' (but I'm still fighting with `font-lock-mode')
(font-lock-mode t)
(jit-lock-mode t)
;; PST -- ERb regions are treated syntactically as comments but have
;; their `face' text property cleared and are overwritten.
(set (make-local-variable 'font-lock-syntactic-keywords)
'rhtml-font-lock-syntactic-keywords)
(add-hook 'jit-lock-functions 'rhtml-fontify-region t t))
(defun rhtml-fontify-buffer ()
(interactive)
(jit-lock-refontify))
(defun rhtml-fontify-erb-block (type begin end)
(let ((delim-face (cdr (assoc type erb-type-to-delim-face)))
(body-face (cdr (assoc type erb-type-to-face)))
(open-start begin)
(open-end (+ begin (if (eq type 'exec) 2 3)))
(close-start (- end 2))
(close-end end))
;; apply edging and base
(font-lock-append-text-property open-start open-end 'face delim-face)
(when body-face
(font-lock-append-text-property open-end close-start 'face body-face))
(font-lock-append-text-property close-start close-end 'face delim-face)
;; apply normal ERb fontification
(when (not (eq type 'comment))
(let ((font-lock-keywords rhtml-in-erb-keywords)
(case-fold-search nil))
(font-lock-fontify-keywords-region open-end close-start)))))
(defun rhtml-font-unfontify-region (beg end)
"Taken from ``font-lock.el''. Similar to
`font-lock-default-unfontify-region' but does not clear syntactical
information. This is useful to keep syntactical state without the
colorization."
(remove-list-of-text-properties
beg end (append
font-lock-extra-managed-props
'(face font-lock-multiline))))
(defun rhtml-fontify-region (begin end)
;; PST -- hack to greedily grab more ERb tags to update (ensures
;; that the current ERb tag is updated entirely)
(save-excursion
(goto-char begin)
(search-backward rhtml-erb-open-delim nil t)
(setq begin (point))
(goto-char end)
(search-forward rhtml-erb-close-delim nil t)
(setq end (point)))
;; fontify ERb tags -- fontification has already been applied by
;; font-lock-mode for sgml-mode so we need to clear faces (but not
;; syntactical information)
(mapc (lambda (i)
(rhtml-font-unfontify-region (nth 1 i) (nth 2 i))
(apply 'rhtml-fontify-erb-block i))
(rhtml-erb-regions begin end)))
;; ERB faces - each type of ERB tag has it's own face properties
(defface erb-face
'((((class color) (min-colors 88) (background dark))
:background "#383838")
(((class color) (min-colors 88) (background light))
;; :background "azure")
:background "snow2")
(((class color) (min-colors 16) (background dark))
:background "blue3")
(((class color) (min-colors 16) (background light))
:background "azure")
(((class color) (min-colors 8))
:background "blue")
(((type tty) (class mono))
:inverse-video t)
(t :background "gray"))
"Default inherited face for ERB tag body"
:group 'rhtml-faces)
(defface erb-delim-face
'((t (:inherit font-lock-preprocessor-face :bold t :italic t)))
"Default inherited face for ERB tag delimeters"
:group 'rhtml-faces)
(defface erb-exec-face
`((t (:inherit erb-face)))
"Basic face for Ruby embedded into HTML"
:group 'rhtml-faces)
(defface erb-exec-delim-face
`((t (:inherit erb-delim-face :weight bold)))
"Basic face for Ruby embedded into HTML"
:group 'rhtml-faces)
(defface erb-out-face
`((t (:inherit erb-face)))
"Basic face for Ruby embedded into HTML"
:group 'rhtml-faces)
(defface erb-out-delim-face
`((((background dark)) :foreground "#aaffff" :background "#383838")
(t (:inherit erb-delim-face :weight bold :foreground "darkred")))
"Basic face for Ruby embedded into HTML"
:group 'rhtml-faces)
(defface erb-comment-face
`((((background dark)) :foreground "lightgreen")
(t (:inherit erb-face :weight bold :foreground "darkgreen")))
"Basic face for Ruby embedded into HTML"
:group 'rhtml-faces)
(defface erb-comment-delim-face
`((((background dark)) :foreground "lightgreen")
(t (:inherit erb-delim-face :weight bold :foreground "darkgreen")))
"Basic face for Ruby embedded into HTML"
:group 'rhtml-faces)
(defvar erb-type-to-face
'((exec . erb-exec-face)
(out . erb-out-face)
(comment . erb-comment-face)))
(defvar erb-type-to-delim-face
'((exec . erb-exec-delim-face)
(out . erb-out-delim-face)
(comment . erb-comment-delim-face)))
;;
(provide 'rhtml-fonts)

107
conf/emacs.d/rhtml/rhtml-mode.el Normal file
View File

@ -0,0 +1,107 @@
;;; rhtml-mode.el --- major mode for editing RHTML files
;; ***** BEGIN LICENSE BLOCK *****
;; Version: MPL 1.1/GPL 2.0/LGPL 2.1
;; The contents of this file are subject to the Mozilla Public License Version
;; 1.1 (the "License"); you may not use this file except in compliance with
;; the License. You may obtain a copy of the License at
;; http://www.mozilla.org/MPL/
;; Software distributed under the License is distributed on an "AS IS" basis,
;; WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
;; for the specific language governing rights and limitations under the
;; License.
;; The Original Code is RHTML-MODE.
;; The Initial Developer of the Original Code is
;; Paul Nathan Stickney <pstickne@gmail.com>.
;; Portions created by the Initial Developer are Copyright (C) 2006
;; the Initial Developer. All Rights Reserved.
;; Contributor(s):
;; Phil Hagelberg
;; Alternatively, the contents of this file may be used under the terms of
;; either the GNU General Public License Version 2 or later (the "GPL"), or
;; the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
;; in which case the provisions of the GPL or the LGPL are applicable instead
;; of those above. If you wish to allow use of your version of this file only
;; under the terms of either the GPL or the LGPL, and not to allow others to
;; use your version of this file under the terms of the MPL, indicate your
;; decision by deleting the provisions above and replace them with the notice
;; and other provisions required by the GPL or the LGPL. If you do not delete
;; the provisions above, a recipient may use your version of this file under
;; the terms of any one of the MPL, the GPL or the LGPL.
;; ***** END LICENSE BLOCK *****
(require 'rhtml-fonts) ;; basic fontification
;; don't require if you don't want it...
(require 'rhtml-sgml-hacks) ;; indent erb with sgml
;;;###autoload
(define-derived-mode rhtml-mode
html-mode "RHTML"
"Embedded Ruby Mode (RHTML)"
(interactive)
(abbrev-mode)
;; disable if you don't want it...
(rhtml-activate-fontification))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.html\\.erb$" . rhtml-mode))
(define-key ruby-mode-map
"\C-c\C-v" (lambda () (interactive) (toggle-buffer 'rails-view)))
(define-key rhtml-mode-map
"\C-c\C-b" 'rinari-find-by-context)
(defun extract-partial (begin end partial-name)
(interactive "r\nsName your partial: ")
(kill-region begin end)
(find-file (concat "_" partial-name "\\.html\\.erb"))
(yank)
(pop-to-buffer nil)
(insert (concat "<%= render :partial => '" partial-name "' %>\n")))
;; PST -- uses rhtml-erb-regions which is defined in rhtml-font which
;; should be moved.
(defun rhtml-dashize (&optional mode)
"Add or remove dashes from the end of ERb blocks. The dash tells ERb to
strip the following newline. This function will NOT add or remove dashes
from blocks that end in a # or #- sequence.
MODE controls how dashes are added or removed. If MODE is `strip' then all
ERb blocks will have the dash removed. If MODE is `add' then all blocks
will have a dash added. If MODE is `auto' or nil then ERb blocks which are
followed by a newline will have a dash added while all other blocks will
have the dash removed."
(interactive "cDashize mode: s) strip, a) add, x) auto (default)")
(let ((real-mode (case mode
((?s strip) 'strip)
((?a add) 'add))))
(mapc (lambda (i)
(let ((end (nth 2 i)))
(save-excursion
(goto-char (- end 2))
(case (or real-mode
(if (eq (char-after end) ?\n)
'add
'strip))
(strip
(when (and (eq (char-before) ?-)
(not (eq (char-before (1- (point))) ?#)))
(delete-backward-char 1)))
(add
(unless (memq (char-before) '(?# ?-))
(insert "-")))))))
;; seq.
(rhtml-erb-regions (point-min) (point-max)))))
(require 'rhtml-navigation)
(provide 'rhtml-mode)

63
conf/emacs.d/rhtml/rhtml-navigation.el Normal file
View File

@ -0,0 +1,63 @@
;; TODO -- need a license boiler-plate
;; Handy RHTML functions
;; (C) 2006 Phil Hagelberg
;; Ripped from the previous rhtml-mode, sorry about making it break
;; too :( -- pst
(defun rails-root (file-path)
"Guess the project root of the given FILE-PATH."
(or (vc-git-root file-path)
(vc-svn-root file-path)
file-path))
(defun rhtml-controller-name-from-view ()
(let* ((dirname (expand-file-name "."))
(controller-with-module
(and (string-match "app/views/\\(.*\\)$" dirname)
(match-string 1 dirname))))
(concat (rails-root (expand-file-name "."))
"/app/controllers/"
controller-with-module
"_controller.rb")))
(defun rhtml-find-action ()
(interactive)
(let ((action (file-name-sans-extension (file-name-nondirectory buffer-file-name))))
(find-file (rhtml-controller-name-from-view))
(beginning-of-buffer)
(search-forward-regexp (concat "def *" action))
(recenter)))
(defun rinari-find-by-context ()
(interactive)
(mapc (lambda (rule) (let ((pattern (car rule)) (line (current-line)))
(if (string-match pattern line) (apply (cdr rule) (match-strings line)))))
;; rules (warning; ALL matches will be acted upon, not just first!)
'((":partial +=> +['\":]\\([a-zA-Z_]+\\)['\" ]" . rhtml-find-partial)
(":controller +=> +['\":]\\([a-zA-Z_]+\\)['\" ,]?.*:action +=> +['\":]\\([a-zA-Z_]+\\)['\" ,]?"
. rinari-find-action)
(":action +=> +['\":]\\([a-zA-Z_]+\\)['\"]?" . rinari-find-action)
)
))
(defun rhtml-find-partial (partial)
(interactive "MPartial: ")
(find-file (concat "_" partial "\\.html\\.erb")))
;; utility functions
(defun current-line ()
(save-excursion
(beginning-of-line)
(set-mark-command nil)
(end-of-line)
(buffer-substring-no-properties (mark) (point))))
(defun match-strings (string &optional n)
(let* ((n (or n 1))
(this-match (match-string n string)))
(when this-match
(append (list this-match) (match-strings string (+ 1 n))))))
(provide 'rhtml-navigation)

93
conf/emacs.d/rhtml/rhtml-ruby-hook.el Normal file
View File

@ -0,0 +1,93 @@
;;;
;;; rhtml-ruby-hook.el - `ruby-mode' access for `rhtml-mode'
;;;
;; ***** BEGIN LICENSE BLOCK *****
;; Version: MPL 1.1/GPL 2.0/LGPL 2.1
;; The contents of this file are subject to the Mozilla Public License Version
;; 1.1 (the "License"); you may not use this file except in compliance with
;; the License. You may obtain a copy of the License at
;; http://www.mozilla.org/MPL/
;; Software distributed under the License is distributed on an "AS IS" basis,
;; WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
;; for the specific language governing rights and limitations under the
;; License.
;; The Original Code is RUBY-MODE Hook Support for RHTML-MODE.
;; The Initial Developer of the Original Code is
;; Paul Nathan Stickney <pstickne@gmail.com>.
;; Portions created by the Initial Developer are Copyright (C) 2006
;; the Initial Developer. All Rights Reserved.
;; Contributor(s):
;; Alternatively, the contents of this file may be used under the terms of
;; either the GNU General Public License Version 2 or later (the "GPL"), or
;; the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
;; in which case the provisions of the GPL or the LGPL are applicable instead
;; of those above. If you wish to allow use of your version of this file only
;; under the terms of either the GPL or the LGPL, and not to allow others to
;; use your version of this file under the terms of the MPL, indicate your
;; decision by deleting the provisions above and replace them with the notice
;; and other provisions required by the GPL or the LGPL. If you do not delete
;; the provisions above, a recipient may use your version of this file under
;; the terms of any one of the MPL, the GPL or the LGPL.
;; ***** END LICENSE BLOCK *****
;;;
;;; Provide an API to 'hook' into Ruby-mode, or rather, provide access
;;; to a temporary `ruby-mode' buffer which can be used to apply
;;; various ruby-mode stuff, primarily indenting.
;;;
;;; History:
;; 2006SEP18
;; - initial implementation
(require 'rhtml-erb)
(require 'ruby-mode) ; for well, `ruby-mode'
(defvar rhtml-ruby-temp-buffer-name
"*rhtml-ruby-hook temp buffer*"
"Buffer name to use for temporary Ruby buffer. Should begin with a * or
space as those carry special meaning.")
(defun rhtml-ruby-temp-buffer ()
"Returns the temporary ruby buffer creating it if needed."
(or (get-buffer rhtml-ruby-temp-buffer-name)
(let ((ruby-buffer (get-buffer-create rhtml-ruby-temp-buffer-name)))
(with-current-buffer ruby-buffer
(buffer-disable-undo)
(ruby-mode))
ruby-buffer)))
(defun rhtml-copy-to-ruby-temp (begin end)
"Buffer to copy from should be selected. BEGIN and END are points in the
current buffer. All existing text in the temporary buffer is replaced."
(let ((source-buffer (current-buffer))
(temp-buffer (rhtml-ruby-temp-buffer)))
(with-current-buffer temp-buffer
(delete-region (point-min) (point-max))
(insert-buffer-substring source-buffer begin end))))
(defun rhtml-ruby-indent-at (indent-pos)
"Returns the indentation for INDENT-POS inside the temporary Ruby buffer
after updating the indenting."
(with-current-buffer (rhtml-ruby-temp-buffer)
(indent-region 0 indent-pos) ; force update
(goto-char indent-pos)
(ruby-calculate-indent)))
(defun rthml-insert-from-ruby-temp ()
"Insert the contents of `rhtml-ruby-temp-buffer' into the current
buffer."
(insert-from-buffer (rhtml-ruby-temp-buffer)))
(provide 'rhtml-ruby-hook)

522
conf/emacs.d/rhtml/rhtml-sgml-hacks.el Normal file
View File

@ -0,0 +1,522 @@
;;;
;;; rhtml-sgml-hacks.el --- add ERB contextual indenting support to sgml-mode
;;;
;;; Initial Developer: Paul Stickney <pstickne@gmail.com>, 2006
;; This file is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty
;; of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
;; See the GNU General Public License for more details.
;; You should have received a copy of the GNU General Public
;; License along with GNU Emacs; if not, write to the Free
;; Software Foundation, 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; README
;;
;; Hacks to sgml-mode *against* Emacs 22.0.5 (2006/09/01 build)
;; - diff'ing and editing for your version may be required!
;; Changes to original code marked with ``PST''.
;;
;; Note: `sgml-mode' indenting in Emacs 21 seems very broken.
;; Please use sgml-mode.el from Emacs 22.
;;
;; Hints to use Emacs 22 sgml-mode with Emacs 21:
;; 1) Replace all occurances of "?\s" with "?\ ". I have no idea what
;; ?\s is supposed to mean (super?) but this lets it eval in Emacs 21.
;; 2) Comment the line containing 'defvaralias'. No reference seems to
;; be made to the alias anyway.
;; 3) Make sure sgml-mode.el is in load-path before stock version and restart
;; emacs. You will have problems if the old `sgml-mode' is
;; loaded first.
;;
;;; History
;; 2006SEP12
;; - Created
;; 2006SEP14
;; - enable/disable hacks use setf so they no longer require feature reloading
;; 2006SEP15
;; - Revert back to old style unloading
;; 2006SEP19
;; - Ruby code inside ERB blocks is now indented. See `rhtml-ruby-hook'.
;; 2006SEP22
;; - < inside ERB tags correctly ignored.
(eval-when-compile
(require 'cl))
(require 'rhtml-erb)
(require 'sgml-mode) ; Force load here, make sure our functions will munge in.
(require 'rhtml-ruby-hook) ; For sub-indenting
;; Crude method of hack control
;; TODO replace, see below
;;
(defun rhtml-disable-sgml-hacks ()
"Try to return `sgml-mode' to its normal state."
(rhtml-remove-feature 'rhtml-sgml-hacks)
(rhtml-reload-feature 'sgml-mode))
(defun rhtml-enable-sgml-hacks ()
"Reload `sgml-mode' hacks. Might be useful after
`rhtml-disable-sgml-hacks'."
(rhtml-reload-feature 'sgml-mode)
(rhtml-reload-feature 'rhtml-sgml-hacks))
(defun rhtml-remove-feature (feature)
(setq features (delq feature features)))
(defun rhtml-reload-feature (feature)
(rhtml-remove-feature feature)
(require feature))
;;; Failed attempt at non feature-realoding
;;; (What is wrong?)
;; Save original functions
;;
;; (defconst rhtml-dirty-functions
;; '(sgml-get-context
;; sgml-calculate-indent
;; sgml-lexical-context
;; sgml-beginning-of-tag
;; sgml-parse-tag-backward)
;; "Functions to back up.")
;; (setq rhtml-hacks-backed-up nil)
;; (defconst rhtml-sgml-backup-prop 'rhtml-sgml-definition)
;; (defconst rhtml-hack-backup-prop 'rhtml-hack-definition)
;; (defun rhtml-backup-functions (prop)
;; (dolist (fn rhtml-dirty-functions)
;; (put fn prop (symbol-function fn))))
;; (defun rhtml-restore-functions (prop)
;; (dolist (fn rhtml-dirty-functions)
;; (setf fn (get fn prop))))
;; ;; Backup sgml-mode functions so we can restore them later
;; (rhtml-backup-functions rhtml-sgml-backup-prop)
;; (defun rhtml-disable-sgml-hacks ()
;; "Restore normal functions."
;; ;; Backup rhtml-sgml-hacks functions if not done yet.
;; ;; Without (correctly) doing so we will accidently mix definitions!
;; (unless rhtml-hacks-backed-up
;; (rhtml-backup-functions rhtml-hack-backup-prop)
;; (setq rhtml-hacks-backed-up t))
;; (rhtml-restore-functions rhtml-sgml-backup-prop))
;; (defun rhtml-enable-sgml-hacks ()
;; "Restore hacked functions."
;; (rhtml-restore-functions rhtml-hack-backup-prop))
;; PST - handling of `erb-*'
(defun sgml-get-context (&optional until)
"Determine the context of the current position.
By default, parse until we find a start-tag as the first thing on a line.
If UNTIL is `empty', return even if the context is empty (i.e.
we just skipped over some element and got to a beginning of line).
The context is a list of tag-info structures. The last one is the tag
immediately enclosing the current position.
Point is assumed to be outside of any tag. If we discover that it's
not the case, the first tag returned is the one inside which we are."
(let ((here (point))
(stack nil)
(ignore nil)
(context nil)
tag-info)
;; CONTEXT keeps track of the tag-stack
;; STACK keeps track of the end tags we've seen (and thus the start-tags
;; we'll have to ignore) when skipping over matching open..close pairs.
;; IGNORE is a list of tags that can be ignored because they have been
;; closed implicitly.
(skip-chars-backward " \t\n") ; Make sure we're not at indentation.
(while
(and (not (eq until 'now))
(or stack
(not (if until (eq until 'empty) context))
(not (sgml-at-indentation-p))
(and context
(/= (point) (sgml-tag-start (car context)))
(sgml-unclosed-tag-p (sgml-tag-name (car context)))))
(setq tag-info (ignore-errors (sgml-parse-tag-backward))))
;; This tag may enclose things we thought were tags. If so,
;; discard them.
(while (and context
(> (sgml-tag-end tag-info)
(sgml-tag-end (car context))))
(setq context (cdr context)))
(cond
((> (sgml-tag-end tag-info) here)
;; Oops!! Looks like we were not outside of any tag, after all.
(push tag-info context)
(setq until 'now))
;; start-tag
((memq (sgml-tag-type tag-info) '(open erb-open)) ;; PST
(cond
((null stack)
(if (member-ignore-case (sgml-tag-name tag-info) ignore)
;; There was an implicit end-tag.
nil
(push tag-info context)
;; We're changing context so the tags implicitly closed inside
;; the previous context aren't implicitly closed here any more.
;; [ Well, actually it depends, but we don't have the info about
;; when it doesn't and when it does. --Stef ]
(setq ignore nil)))
((eq t (compare-strings (sgml-tag-name tag-info) nil nil
(car stack) nil nil t))
(setq stack (cdr stack)))
;; PST - "erb-block" closes both "erb-block" and "erb-multi-block"
((and (member (sgml-tag-name tag-info) '("erb-block" "erb-multi-block"))
(string= (car stack) '"erb-block"))
(setq stack (cdr stack)))
;; /PST
(t
;; The open and close tags don't match.
(if (not sgml-xml-mode)
(unless (sgml-unclosed-tag-p (sgml-tag-name tag-info))
(message "Unclosed tag <%s>" (sgml-tag-name tag-info))
(let ((tmp stack))
;; We could just assume that the tag is simply not closed
;; but it's a bad assumption when tags *are* closed but
;; not properly nested.
(while (and (cdr tmp)
(not (eq t (compare-strings
(sgml-tag-name tag-info) nil nil
(cadr tmp) nil nil t))))
(setq tmp (cdr tmp)))
(if (cdr tmp) (setcdr tmp (cddr tmp)))))
(message "Unmatched tags <%s> and </%s>"
(sgml-tag-name tag-info) (pop stack)))))
(if (and (null stack) (sgml-unclosed-tag-p (sgml-tag-name tag-info)))
;; This is a top-level open of an implicitly closed tag, so any
;; occurrence of such an open tag at the same level can be ignored
;; because it's been implicitly closed.
(push (sgml-tag-name tag-info) ignore)))
;; end-tag
((memq (sgml-tag-type tag-info) '(close erb-close)) ;; PST
(if (sgml-empty-tag-p (sgml-tag-name tag-info))
(message "Spurious </%s>: empty tag" (sgml-tag-name tag-info))
(push (sgml-tag-name tag-info) stack)))
))
;; return context
context))
;; PST - added calulations for ERB tags
;; *** Bug when point at end?
(defun sgml-calculate-indent (&optional lcon)
"Calculate the column to which this line should be indented.
LCON is the lexical context, if any."
(unless lcon (setq lcon (sgml-lexical-context)))
;; Indent comment-start markers inside <!-- just like comment-end markers.
(if (and (eq (car lcon) 'tag)
(looking-at "--")
(save-excursion (goto-char (cdr lcon)) (looking-at "<!--")))
(setq lcon (cons 'comment (+ (cdr lcon) 2))))
(case (car lcon)
(string
;; Go back to previous non-empty line.
(while (and (> (point) (cdr lcon))
(zerop (forward-line -1))
(looking-at "[ \t]*$")))
(if (> (point) (cdr lcon))
;; Previous line is inside the string.
(current-indentation)
(goto-char (cdr lcon))
(1+ (current-column))))
(comment
(let ((mark (looking-at "--")))
;; Go back to previous non-empty line.
(while (and (> (point) (cdr lcon))
(zerop (forward-line -1))
(or (looking-at "[ \t]*$")
(if mark (not (looking-at "[ \t]*--"))))))
(if (> (point) (cdr lcon))
;; Previous line is inside the comment.
(skip-chars-forward " \t")
(goto-char (cdr lcon))
;; Skip `<!' to get to the `--' with which we want to align.
(search-forward "--")
(goto-char (match-beginning 0)))
(when (and (not mark) (looking-at "--"))
(forward-char 2) (skip-chars-forward " \t"))
(current-column)))
;; We don't know how to indent it. Let's be honest about it.
(cdata nil)
;; PST - Indent Ruby inside ERB tags
((erb-open erb-close erb-middle erb-data)
(let ((indent-pos (point)))
(re-search-backward rhtml-erb-tag-open-re)
(goto-char (match-end 0)) ; skip tag
(let* ((content-start (point))
(base-indent (current-column))
;; inside-indent-pos also accounts for sync'ing injection
(inside-indent-pos (+ 1 base-indent (- indent-pos content-start))))
(re-search-forward rhtml-erb-tag-close-re)
(let ((content-end (match-beginning 0)))
(rhtml-copy-to-ruby-temp content-start content-end)
;; Inject spaces into first-line (which might have had
;; previous contents trimmed) to keep points in sync.
(with-current-buffer (rhtml-ruby-temp-buffer)
(goto-char 0)
(insert (make-string base-indent ?\ )))
(rhtml-ruby-indent-at inside-indent-pos)))))
;; /PST
(tag
(goto-char (1+ (cdr lcon)))
(skip-chars-forward "^ \t\n") ;Skip tag name.
(skip-chars-forward " \t")
(if (not (eolp))
(current-column)
;; This is the first attribute: indent.
(goto-char (1+ (cdr lcon)))
(+ (current-column) sgml-basic-offset)))
(text
(while
(if (looking-at "</")
(forward-sexp 1)
;; PST do likewise for ERB tags
(rhtml-scan-for-erb-tags '(erb-close)))
(skip-chars-forward " \t"))
(let* ((here (point))
(unclosed (and ;; (not sgml-xml-mode)
(looking-at sgml-tag-name-re)
(member-ignore-case (match-string 1)
sgml-unclosed-tags)
(match-string 1)))
(context
;; If possible, align on the previous non-empty text line.
;; Otherwise, do a more serious parsing to find the
;; tag(s) relative to which we should be indenting.
(if (and (not unclosed) (skip-chars-backward " \t")
(< (skip-chars-backward " \t\n") 0)
(back-to-indentation)
(> (point) (cdr lcon)))
nil
(goto-char here)
(nreverse (sgml-get-context (if unclosed nil 'empty)))))
(there (point)))
;; Ignore previous unclosed start-tag in context.
(while (and context unclosed
(eq t (compare-strings
(sgml-tag-name (car context)) nil nil
unclosed nil nil t)))
(setq context (cdr context)))
;; Indent to reflect nesting.
(cond
;; If we were not in a text context after all, let's try again.
((and context (> (sgml-tag-end (car context)) here))
(goto-char here)
(sgml-calculate-indent
(cons (if (memq (sgml-tag-type (car context)) '(comment cdata))
(sgml-tag-type (car context)) 'tag)
(sgml-tag-start (car context)))))
;; Align on the first element after the nearest open-tag, if any.
((and context
(goto-char (sgml-tag-end (car context)))
(skip-chars-forward " \t\n")
(< (point) here) (sgml-at-indentation-p))
(+ (current-column)
(rhtml-erb-middle-offset here there))) ;; PST
(t ;; follows another a tag
(goto-char there)
(+ (current-column)
(rhtml-erb-middle-offset here there) ;; PST
(* sgml-basic-offset (length context)))))))
(otherwise
(error "Unrecognized context %s" (car lcon)))
))
;; PST - support for `erb-*' (replaces `jsp') as well as getting name
(defun sgml-parse-tag-backward (&optional limit)
"Parse an SGML tag backward, and return information about the tag.
Assume that parsing starts from within a textual context.
Leave point at the beginning of the tag."
(catch 'found
(let (tag-type tag-start tag-end name)
(or (re-search-backward "[<>]" limit 'move)
(error "No tag found"))
(when (eq (char-after) ?<)
;; Oops!! Looks like we were not in a textual context after all!.
;; Let's try to recover.
(with-syntax-table sgml-tag-syntax-table
(let ((pos (point)))
(condition-case nil
(forward-sexp)
(scan-error
;; This < seems to be just a spurious one, let's ignore it.
(goto-char pos)
(throw 'found (sgml-parse-tag-backward limit))))
;; Check it is really a tag, without any extra < or > inside.
(unless (sgml-tag-text-p pos (point))
(goto-char pos)
(throw 'found (sgml-parse-tag-backward limit)))
(forward-char -1))))
(setq tag-end (1+ (point)))
(cond
((sgml-looking-back-at "--") ; comment
(setq tag-type 'comment
tag-start (search-backward "<!--" nil t)))
((sgml-looking-back-at "]]") ; cdata
(setq tag-type 'cdata
tag-start (re-search-backward "<!\\[[A-Z]+\\[" nil t)))
(t
(setq tag-start
(with-syntax-table sgml-tag-syntax-table
(goto-char tag-end)
(condition-case nil
(backward-sexp)
(scan-error
;; This > isn't really the end of a tag. Skip it.
(goto-char (1- tag-end))
(throw 'found (sgml-parse-tag-backward limit))))
;; PST, ignore <'s in ERB tags
(when (rhtml-erb-tag-region)
(throw 'found (sgml-parse-tag-backward limit)))
;; /PST
(point)))
(goto-char (1+ tag-start))
(case (char-after)
(?! ; declaration
(setq tag-type 'decl))
(?? ; processing-instruction
(setq tag-type 'pi))
(?/ ; close-tag
(forward-char 1)
(setq tag-type 'close
name (sgml-parse-tag-name)))
;; PST - ERB
;; TODO does not work with defvar delim setup.
(?%
(backward-char 1) ; ERB tags *always* include delims
(let ((erb-info (save-excursion (rhtml-scan-erb-tag))))
(when (car erb-info)
(setq tag-type (car erb-info))
(setq name (cdr erb-info)))))
;; /PST
(t ; open or empty tag
(setq tag-type 'open
name (sgml-parse-tag-name))
(if (or (eq ?/ (char-before (- tag-end 1)))
(sgml-empty-tag-p name))
(setq tag-type 'empty))))))
(goto-char tag-start)
(sgml-make-tag tag-type tag-start tag-end name))))
;; PST -- ERB tags return useful stuff such as "erb-block"
(defun sgml-beginning-of-tag (&optional top-level)
"Skip to beginning of tag and return its name.
If this can't be done, return nil."
(let ((context (sgml-lexical-context)))
(if (memq (car context) '(tag erb-open erb-close erb-middle)) ;; PST
(progn
(goto-char (cdr context))
;; PST cond added for ERB
(or (cdr (save-excursion (rhtml-scan-erb-tag)))
(if (looking-at sgml-tag-name-re)
(match-string-no-properties 1))))
(if top-level nil
(when (not (eq (car context) 'text))
(goto-char (cdr context))
(sgml-beginning-of-tag t))))))
;; PST -- Added support for `erb-*' types
(defun sgml-lexical-context (&optional limit)
"Return the lexical context at point as (TYPE . START).
START is the location of the start of the lexical element.
TYPE is one of `string', `comment', `tag', `cdata', `erb-*' or `text'.
Optional argument LIMIT is the position to start parsing from.
If nil, start from a preceding tag at indentation."
(interactive) ;; PST
(save-excursion
(let ((pos (point))
text-start state)
(if limit
(goto-char limit)
;; Skip tags backwards until we find one at indentation
(while (and (ignore-errors (sgml-parse-tag-backward))
(not (sgml-at-indentation-p)))))
(with-syntax-table sgml-tag-syntax-table
(while (< (point) pos)
;; When entering this loop we're inside text.
(setq text-start (point))
(skip-chars-forward "^<" pos)
(setq state
(cond
((= (point) pos)
;; We got to the end without seeing a tag.
nil)
((looking-at "<!\\[[A-Z]+\\[")
;; We've found a CDATA section or similar.
(let ((cdata-start (point)))
(unless (search-forward "]]>" pos 'move)
(list 0 nil nil 'cdata nil nil nil nil cdata-start))))
;; PST
((looking-at rhtml-erb-tag-open-re)
(let ((erb-start (point))
(tag-type (car (rhtml-scan-erb-tag))))
(if tag-type
(list 0 nil nil tag-type nil nil nil nil erb-start)
(forward-char 1) ;not really an ERB tag, skip it (could cause <<tag>)?
nil)))
;; /PST
(t
;; We've reached a tag. Parse it.
;; FIXME: Handle net-enabling start-tags
(parse-partial-sexp (point) pos 0))))))
(let ((lcon
(cond
((eq (nth 3 state) 'cdata) (cons 'cdata (nth 8 state)))
((rhtml-erb-tag-type-p (nth 3 state)) (cons (nth 3 state) (nth 8 state))) ;; PST
((nth 3 state) (cons 'string (nth 8 state)))
((nth 4 state) (cons 'comment (nth 8 state)))
((and state (> (nth 0 state) 0)) (cons 'tag (nth 1 state)))
(t (cons 'text text-start)))))
lcon))))
;;;
;;; Hacks disabled by default
;;;
;;(rhtml-disable-sgml-hacks)
;;;
(provide 'rhtml-sgml-hacks)

948
conf/emacs.d/rinari/rinari.el Normal file
View File

@ -0,0 +1,948 @@
;;; rinari.el --- Rinari Is Not A Rails IDE
;; Copyright (C) 2008 Phil Hagelberg, Eric Schulte
;; Author: Phil Hagelberg, Eric Schulte
;; URL: https://github.com/eschulte/rinari
;; Version: DEV
;; Created: 2006-11-10
;; Keywords: ruby, rails, project, convenience, web
;; EmacsWiki: Rinari
;; Package-Requires: ((ruby-mode "1.0") (inf-ruby "2.2.1") (ruby-compilation "0.16") (jump "2.0"))
;; This file is NOT part of GNU Emacs.
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Rinari Is Not A Ruby IDE.
;; Well, ok it kind of is. Rinari is a set of Emacs Lisp modes that is
;; aimed towards making Emacs into a top-notch Ruby and Rails
;; development environment.
;; Rinari can be installed through ELPA (see http://tromey.com/elpa/)
;; To install from source, copy the directory containing this file
;; into your Emacs Lisp directory, assumed here to be ~/.emacs.d. Add
;; these lines of code to your .emacs file:
;; ;; rinari
;; (add-to-list 'load-path "~/.emacs.d/rinari")
;; (require 'rinari)
;; (global-rinari-mode)
;; Whether installed through ELPA or from source you probably want to
;; add the following lines to your .emacs file:
;; ;; ido
;; (require 'ido)
;; (ido-mode t)
;; Note: if you cloned this from a git repo, you will have to grab the
;; submodules which can be done by running the following commands from
;; the root of the rinari directory
;; git submodule init
;; git submodule update
;;; Code:
;;;###begin-elpa-ignore
(let* ((this-dir (file-name-directory (or load-file-name buffer-file-name)))
(util-dir (file-name-as-directory (expand-file-name "util" this-dir)))
(inf-ruby-dir (file-name-as-directory (expand-file-name "inf-ruby" util-dir)))
(jump-dir (file-name-as-directory (expand-file-name "jump" util-dir))))
(dolist (dir (list util-dir inf-ruby-dir jump-dir))
(when (file-exists-p dir)
(add-to-list 'load-path dir))))
;;;###end-elpa-ignore
(require 'ruby-mode)
(require 'inf-ruby)
(require 'ruby-compilation)
(require 'jump)
(require 'cl)
(require 'easymenu)
;; fill in some missing variables for XEmacs
(when (eval-when-compile (featurep 'xemacs))
;;this variable does not exist in XEmacs
(defvar safe-local-variable-values ())
;;find-file-hook is not defined and will otherwise not be called by XEmacs
(define-compatible-variable-alias 'find-file-hook 'find-file-hooks))
(defgroup rinari nil
"Rinari customizations."
:prefix "rinari-"
:group 'rinari)
(defcustom rinari-major-modes nil
"Major Modes from which to launch Rinari."
:type '(repeat symbol)
:group 'rinari)
(defcustom rinari-exclude-major-modes nil
"Major Modes in which to never launch Rinari."
:type '(repeat symbol)
:group 'rinari)
(defcustom rinari-tags-file-name
"TAGS"
"Path to your TAGS file inside of your rails project. See `tags-file-name'."
:group 'rinari)
(defcustom rinari-fontify-rails-keywords t
"When non-nil, fontify keywords such as 'before_filter', 'url_for'.")
(defcustom rinari-controller-keywords
'("logger" "polymorphic_path" "polymorphic_url" "mail" "render" "attachments"
"default" "helper" "helper_attr" "helper_method" "layout" "url_for"
"serialize" "exempt_from_layout" "filter_parameter_logging" "hide_action"
"cache_sweeper" "protect_from_forgery" "caches_page" "cache_page"
"caches_action" "expire_page" "expire_action" "rescue_from" "params"
"request" "response" "session" "flash" "head" "redirect_to"
"render_to_string" "respond_with" "before_filter" "append_before_filter"
"prepend_before_filter" "after_filter" "append_after_filter"
"prepend_after_filter" "around_filter" "append_around_filter"
"prepend_around_filter" "skip_before_filter" "skip_after_filter" "skip_filter")
"List of keywords to highlight for controllers"
:group 'rinari
:type '(repeat string))
(defcustom rinari-migration-keywords
'("create_table" "change_table" "drop_table" "rename_table" "add_column"
"rename_column" "change_column" "change_column_default" "remove_column"
"add_index" "remove_index" "rename_index" "execute")
"List of keywords to highlight for migrations"
:group 'rinari
:type '(repeat string))
(defcustom rinari-model-keywords
'("default_scope" "named_scope" "scope" "serialize" "belongs_to" "has_one"
"has_many" "has_and_belongs_to_many" "composed_of" "accepts_nested_attributes_for"
"before_create" "before_destroy" "before_save" "before_update" "before_validation"
"before_validation_on_create" "before_validation_on_update" "after_create"
"after_destroy" "after_save" "after_update" "after_validation"
"after_validation_on_create" "after_validation_on_update" "around_create"
"around_destroy" "around_save" "around_update" "after_commit" "after_find"
"after_initialize" "after_rollback" "after_touch" "attr_accessible"
"attr_protected" "attr_readonly" "validates" "validate" "validate_on_create"
"validate_on_update" "validates_acceptance_of" "validates_associated"
"validates_confirmation_of" "validates_each" "validates_exclusion_of"
"validates_format_of" "validates_inclusion_of" "validates_length_of"
"validates_numericality_of" "validates_presence_of" "validates_size_of"
"validates_uniqueness_of" "validates_with")
"List of keywords to highlight for models"
:group 'rinari
:type '(repeat string))
(defvar rinari-minor-mode-hook nil
"*Hook for customising Rinari.")
(defcustom rinari-rails-env nil
"Use this to force a value for RAILS_ENV when running rinari.
Leave this set to nil to not force any value for RAILS_ENV, and
leave this to the environment variables outside of Emacs.")
(defvar rinari-minor-mode-prefixes
(list ";" "'")
"List of characters, each of which will be bound (with control-c) as a prefix for `rinari-minor-mode-map'.")
(defcustom rinari-inf-ruby-prompt-pattern
"\\(^>> .*\\)\\|\\(^\\(irb([^)]+)\\|\\(\[[0-9]+\] \\)?[Pp]ry ?([^)]+)\\|\\(jruby-\\|JRUBY-\\)?[1-9]\\.[0-9]\\.[0-9]+\\(-?p?[0-9]+\\)?\\) ?\\(:[0-9]+\\)* ?[\]>*\"'/`]>? *\\)"
"The value used for `inf-ruby-prompt-pattern' in `rinari-console' buffers."
:group 'rinari)
(defvar rinari-partial-regex
"render \\(:partial *=> \\)?*[@'\"]?\\([A-Za-z/_]+\\)['\"]?"
"Regex that matches a partial rendering call.")
(defadvice ruby-compilation-do (around rinari-compilation-do activate)
"Set default directory to the rails root before running ruby processes."
(let ((default-directory (or (rinari-root) default-directory)))
ad-do-it
(rinari-launch)))
(defadvice ruby-compilation-rake (around rinari-compilation-rake activate)
"Set default directory to the rails root before running rake processes."
(let ((default-directory (or (rinari-root) default-directory)))
ad-do-it
(rinari-launch)))
(defadvice ruby-compilation-cap (around rinari-compilation-cap activate)
"Set default directory to the rails root before running cap processes."
(let ((default-directory (or (rinari-root) default-directory)))
ad-do-it
(rinari-launch)))
(defun rinari-parse-yaml ()
"Parse key/value pairs out of a simple yaml file."
(let ((end (save-excursion (re-search-forward "^[^:]*$" nil t) (point)))
pairs)
(while (re-search-forward "^ *\\(.*\\): \\(.*\\)$" end t)
(push (cons (match-string 1) (match-string 2)) pairs))
pairs))
(defun rinari-root (&optional dir home)
"Return the root directory of the project within which DIR is found.
Optional argument HOME is ignored."
(let ((default-directory (or dir default-directory)))
(when (file-directory-p default-directory)
(if (file-exists-p (expand-file-name "environment.rb" (expand-file-name "config")))
default-directory
;; regexp to match windows roots, tramp roots, or regular posix roots
(unless (string-match "\\(^[[:alpha:]]:/$\\|^/[^\/]+:/?$\\|^/$\\)" default-directory)
(rinari-root (expand-file-name (file-name-as-directory ".."))))))))
(defun rinari-highlight-keywords (keywords)
"Highlight the passed KEYWORDS in current buffer.
Use `font-lock-add-keywords' in case of `ruby-mode' or
`ruby-extra-keywords' in case of Enhanced Ruby Mode."
(if (boundp 'ruby-extra-keywords)
(progn
(setq ruby-extra-keywords (append ruby-extra-keywords keywords))
(ruby-local-enable-extra-keywords))
(font-lock-add-keywords
nil
(list (list
(concat "\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b"
(regexp-opt keywords t)
ruby-keyword-end-re)
(list 2 'font-lock-builtin-face))))))
(defun rinari-apply-keywords-for-file-type ()
"Apply extra font lock keywords specific to models, controllers etc."
(when (and rinari-fontify-rails-keywords (buffer-file-name))
(loop for (re keywords) in `(("_controller\\.rb$" ,rinari-controller-keywords)
("app/models/.+\\.rb$" ,rinari-model-keywords)
("db/migrate/.+\\.rb$" ,rinari-migration-keywords))
do (when (string-match-p re (buffer-file-name))
(rinari-highlight-keywords keywords)))))
(add-hook 'ruby-mode-hook 'rinari-apply-keywords-for-file-type)
;;--------------------------------------------------------------------------------
;; user functions
(defun rinari-rake (&optional task edit-cmd-args)
"Select and run a rake TASK using `ruby-compilation-rake'."
(interactive "P")
(ruby-compilation-rake task edit-cmd-args
(when rinari-rails-env
(list (cons "RAILS_ENV" rinari-rails-env)))))
(defun rinari-cap (&optional task edit-cmd-args)
"Select and run a capistrano TASK using `ruby-compilation-cap'."
(interactive "P")
(ruby-compilation-cap task edit-cmd-args
(when rinari-rails-env
(list (cons "RAILS_ENV" rinari-rails-env)))))
(defun rinari--discover-rails-commands ()
"Return a list of commands supported by the main rails script."
(let ((rails-script (rinari--rails-path)))
(when rails-script
(ruby-compilation-extract-output-matches rails-script "^ \\([a-z]+\\)[[:space:]].*$"))))
(defvar rinari-rails-commands-cache nil
"Cached values for commands that can be used with 'script/rails' in Rails 3.")
(defun rinari-get-rails-commands ()
"Return a cached list of commands supported by the main rails script."
(when (null rinari-rails-commands-cache)
(setq rinari-rails-commands-cache (rinari--discover-rails-commands)))
rinari-rails-commands-cache)
(defun rinari-script (&optional script)
"Select and run SCRIPT from the script/ directory of the rails application."
(interactive)
(let* ((completions (append (directory-files (rinari-script-path) nil "^[^.]")
(rinari-get-rails-commands)))
(script (or script (jump-completing-read "Script: " completions)))
(ruby-compilation-error-regexp-alist ;; for jumping to newly created files
(if (equal script "generate")
'(("^ +\\(create\\) +\\([^[:space:]]+\\)" 2 3 nil 0 2)
("^ +\\(exists\\) +\\([^[:space:]]+\\)" 2 3 nil 0 1)
("^ +\\(conflict\\) +\\([^[:space:]]+\\)" 2 3 nil 0 0))
ruby-compilation-error-regexp-alist))
(script-path (concat (rinari--wrap-rails-command script) " ")))
(when (string-match-p "^\\(db\\)?console" script)
(error "Use the dedicated rinari function to run this interactive script"))
(ruby-compilation-run (concat script-path " " (read-from-minibuffer (concat script " ")))
nil
(concat "rails " script))))
(defun rinari-test (&optional edit-cmd-args)
"Run the current ruby function as a test, or run the corresponding test.
If current function is not a test,`rinari-find-test' is used to
find the corresponding test. Output is sent to a compilation buffer
allowing jumping between errors and source code. Optional prefix
argument EDIT-CMD-ARGS lets the user edit the test command
arguments."
(interactive "P")
(or (rinari-test-function-name)
(string-match "test" (or (ruby-add-log-current-method)
(file-name-nondirectory (buffer-file-name))))
(rinari-find-test))
(let* ((fn (rinari-test-function-name))
(path (buffer-file-name))
(ruby-options (list "-I" (expand-file-name "test" (rinari-root)) path))
(default-command (mapconcat
'identity
(append (list path) (when fn (list "--name" (concat "/" fn "/"))))
" "))
(command (if edit-cmd-args
(read-string "Run w/Compilation: " default-command)
default-command)))
(if path
(ruby-compilation-run command ruby-options)
(message "no test available"))))
(defun rinari-test-function-name()
"Return the name of the test function at point, or nil if not found."
(save-excursion
(when (re-search-backward (concat "^[ \t]*\\(def\\|test\\)[ \t]+"
"\\([\"'].*?[\"']\\|" ruby-symbol-re "*\\)"
"[ \t]*") nil t)
(let ((name (match-string 2)))
(if (string-match "^[\"']\\(.*\\)[\"']$" name)
(replace-regexp-in-string
"\\?" "\\\\\\\\?"
(replace-regexp-in-string " +" "_" (match-string 1 name)))
(when (string-match "^test" name)
name))))))
(defun rinari--rails-path ()
"Return the path of the 'rails' command, or nil if not found."
(let* ((script (rinari-script-path))
(rails-script (expand-file-name "rails" script)))
(if (file-exists-p rails-script)
rails-script
(executable-find "rails"))))
(defun rinari--wrap-rails-command (command)
"Given a COMMAND such as 'console', return a suitable command line.
Where the corresponding script is executable, it will be run
as-is. Otherwise, as can be the case on Windows, the command will
be prepended with `ruby-compilation-executable'."
(let* ((default-directory (rinari-root))
(script (rinari-script-path))
(script-command (expand-file-name command script))
(command-line
(if (file-exists-p script-command)
script-command
(concat (rinari--rails-path) " " command))))
(if (file-executable-p (first (split-string-and-unquote command-line)))
command-line
(concat ruby-compilation-executable " " command-line))))
(defun rinari-console (&optional edit-cmd-args)
"Run a Rails console in a compilation buffer.
The buffer will support command history and links between errors
and source code. Optional prefix argument EDIT-CMD-ARGS lets the
user edit the console command arguments."
(interactive "P")
(let* ((default-directory (rinari-root))
(command (rinari--wrap-rails-command "console")))
;; Start console in correct environment.
(when rinari-rails-env
(setq command (concat command " " rinari-rails-env)))
;; For customization of the console command with prefix arg.
(setq command (if edit-cmd-args
(read-string "Run Ruby: " (concat command " "))
command))
(with-current-buffer (run-ruby command "rails console")
(dolist (var '(inf-ruby-prompt-pattern inf-ruby-first-prompt-pattern))
(set (make-local-variable var) rinari-inf-ruby-prompt-pattern))
(rinari-launch))))
(defun rinari-sql-buffer-name (env)
"Return the name of the sql buffer for ENV."
(format "*%s-sql*" env))
(defun rinari-sql ()
"Browse the application's database.
Looks up login information from your conf/database.sql file."
(interactive)
(let* ((environment (or rinari-rails-env (getenv "RAILS_ENV") "development"))
(sql-buffer (get-buffer (rinari-sql-buffer-name environment))))
(if sql-buffer
(pop-to-buffer sql-buffer)
(let* ((database-alist (save-excursion
(with-temp-buffer
(insert-file-contents
(expand-file-name
"database.yml"
(file-name-as-directory
(expand-file-name "config" (rinari-root)))))
(goto-char (point-min))
(re-search-forward (concat "^" environment ":"))
(rinari-parse-yaml))))
(adapter (or (cdr (assoc "adapter" database-alist)) "sqlite"))
(sql-user (or (cdr (assoc "username" database-alist)) "root"))
(sql-password (or (cdr (assoc "password" database-alist)) ""))
(sql-password (when (> (length sql-password) 0) sql-password))
(sql-database (or (cdr (assoc "database" database-alist))
(concat (file-name-nondirectory (rinari-root))
"_" environment)))
(server (or (cdr (assoc "host" database-alist)) "localhost"))
(port (cdr (assoc "port" database-alist)))
(sql-server (if port (concat server ":" port) server)))
(funcall
(intern (concat "sql-"
(cond
((string-match "mysql" adapter)
"mysql")
((string-match "sqlite" adapter)
"sqlite")
((string-match "postgresql" adapter)
"postgres")
(t adapter)))))
(rename-buffer sql-buffer)
(rinari-launch)))))
(defun rinari-web-server (&optional edit-cmd-args)
"Start a Rails webserver.
Dumps output to a compilation buffer allowing jumping between
errors and source code. Optional prefix argument EDIT-CMD-ARGS
lets the user edit the server command arguments."
(interactive "P")
(let* ((default-directory (rinari-root))
(command (rinari--wrap-rails-command "server")))
;; Start web server in correct environment.
(when rinari-rails-env
(setq command (concat command " -e " rinari-rails-env)))
;; For customization of the web server command with prefix arg.
(setq command (if edit-cmd-args
(read-string "Run Ruby: " (concat command " "))
command))
(ruby-compilation-run command nil "server"))
(rinari-launch))
(defun rinari-web-server-restart (&optional edit-cmd-args)
"Ensure a fresh `rinari-web-server' is running, first killing any old one.
Optional prefix argument EDIT-CMD-ARGS lets the user edit the
server command arguments."
(interactive "P")
(let ((rinari-web-server-buffer "*server*"))
(when (get-buffer rinari-web-server-buffer)
(set-process-query-on-exit-flag (get-buffer-process rinari-web-server-buffer) nil)
(kill-buffer rinari-web-server-buffer))
(rinari-web-server edit-cmd-args)))
(defun rinari-insert-erb-skeleton (no-equals)
"Insert an erb skeleton at point.
With optional prefix argument NO-EQUALS, don't include an '='."
(interactive "P")
(insert "<%")
(insert (if no-equals " -" "= "))
(insert "%>")
(backward-char (if no-equals 4 3)))
(defun rinari-extract-partial (begin end partial-name)
"Extracts the region from BEGIN to END into a partial called PARTIAL-NAME."
(interactive "r\nsName your partial: ")
(let ((path (buffer-file-name))
(ending (rinari-ending)))
(if (string-match "view" path)
(let ((partial-name
(replace-regexp-in-string "[[:space:]]+" "_" partial-name)))
(kill-region begin end)
(if (string-match "\\(.+\\)/\\(.+\\)" partial-name)
(let ((default-directory (expand-file-name (match-string 1 partial-name)
(expand-file-name ".."))))
(find-file (concat "_" (match-string 2 partial-name) ending)))
(find-file (concat "_" partial-name ending)))
(yank) (pop-to-buffer nil)
(rinari-insert-partial partial-name ending))
(message "not in a view"))))
(defun rinari-insert-output (ruby-expr ending)
"Insert view code which outputs RUBY-EXPR, suitable for the file's ENDING."
(let ((surround
(cond
((string-match "\\.erb" ending)
(cons "<%= " " %>"))
((string-match "\\.haml" ending)
(cons "= " " ")))))
(insert (concat (car surround) ruby-expr (cdr surround) "\n"))))
(defun rinari-insert-partial (partial-name ending)
"Insert a call to PARTIAL-NAME, formatted for the file's ENDING.
Supported markup languages are: Erb, Haml"
(rinari-insert-output (concat "render :partial => \"" partial-name "\"") ending))
(defun rinari-goto-partial ()
"Visits the partial that is called on the current line."
(interactive)
(let ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position))))
(when (string-match rinari-partial-regex line)
(setq line (match-string 2 line))
(let ((file
(if (string-match "/" line)
(concat (rinari-root) "app/views/"
(replace-regexp-in-string "\\([^/]+\\)/\\([^/]+\\)$" "\\1/_\\2" line))
(concat default-directory "_" line))))
(find-file (concat file (rinari-ending)))))))
(defvar rinari-rgrep-file-endings
"*.[^l]*"
"Ending of files to search for matches using `rinari-rgrep'.")
(defun rinari-rgrep (&optional arg)
"Search through the rails project for a string or `regexp'.
With optional prefix argument ARG, just run `rgrep'."
(interactive "P")
(grep-compute-defaults)
(if arg
(call-interactively 'rgrep)
(let ((query (if mark-active
(buffer-substring-no-properties (point) (mark))
(thing-at-point 'word))))
(funcall 'rgrep (read-from-minibuffer "search for: " query)
rinari-rgrep-file-endings (rinari-root)))))
(defun rinari-ending ()
"Return the file extension of the current file."
(let* ((path (buffer-file-name))
(ending
(and (string-match ".+?\\(\\.[^/]*\\)$" path)
(match-string 1 path))))
ending))
(defun rinari-script-path ()
"Return the absolute path to the script folder."
(concat (file-name-as-directory (expand-file-name "script" (rinari-root)))))
;;--------------------------------------------------------------------
;; rinari movement using jump.el
(defun rinari-generate (type name)
"Run the generate command to generate a TYPE called NAME."
(let* ((default-directory (rinari-root))
(command (rinari--wrap-rails-command "generate")))
(message (shell-command-to-string (concat command " " type " " (read-from-minibuffer (format "create %s: " type) name))))))
(defvar rinari-ruby-hash-regexp
"\\(:[^[:space:]]*?\\)[[:space:]]*\\(=>[[:space:]]*[\"\':]?\\([^[:space:]]*?\\)[\"\']?[[:space:]]*\\)?[,){}\n]"
"Regexp to match subsequent key => value pairs of a ruby hash.")
(defun rinari-ruby-values-from-render (controller action)
"Return (CONTROLLER . ACTION) after adjusting for the hash values at point."
(let ((end (save-excursion
(re-search-forward "[^,{(]$" nil t)
(1+ (point)))))
(save-excursion
(while (and (< (point) end)
(re-search-forward rinari-ruby-hash-regexp end t))
(when (> (length (match-string 3)) 1)
(case (intern (match-string 1))
(:partial
(let ((partial (match-string 3)))
(if (string-match "\\(.+\\)/\\(.+\\)" partial)
(progn
(setf controller (match-string 1 partial))
(setf action (concat "_" (match-string 2 partial))))
(setf action (concat "_" partial)))))
(:action (setf action (match-string 3)))
(:controller (setf controller (match-string 3)))))))
(cons controller action)))
(defun rinari-which-render (renders)
"Select and parse one of the RENDERS supplied."
(let ((path (jump-completing-read
"Follow: "
(mapcar (lambda (lis)
(concat (car lis) "/" (cdr lis)))
renders))))
(string-match "\\(.*\\)/\\(.*\\)" path)
(cons (match-string 1 path) (match-string 2 path))))
(defun rinari-follow-controller-and-action (controller action)
"Follow CONTROLLER and ACTION through to the final controller or view.
The user is prompted to follow through any intermediate renders
and redirects."
(save-excursion ;; if we can find the controller#action pair
(if (and (jump-to-path (format "app/controllers/%s_controller.rb#%s" controller action))
(equalp (jump-method) action))
(let ((start (point)) ;; demarcate the borders
(renders (list (cons controller action))) render view)
(ruby-forward-sexp)
;; collect redirection options and pursue
(while (re-search-backward "re\\(?:direct_to\\|nder\\)" start t)
(add-to-list 'renders (rinari-ruby-values-from-render controller action)))
(let ((render (if (equalp 1 (length renders))
(car renders)
(rinari-which-render renders))))
(if (and (equalp (cdr render) action)
(equalp (car render) controller))
(list controller action) ;; directed to here so return
(rinari-follow-controller-and-action (or (car render)
controller)
(or (cdr render)
action)))))
;; no controller entry so return
(list controller action))))
(defvar rinari-jump-schema
'((model
"m"
(("app/controllers/\\1_controller.rb#\\2$" . "app/models/\\1.rb#\\2")
("app/views/\\1/.*" . "app/models/\\1.rb")
("app/helpers/\\1_helper.rb" . "app/models/\\1.rb")
("db/migrate/.*create_\\1.rb" . "app/models/\\1.rb")
("spec/models/\\1_spec.rb" . "app/models/\\1.rb")
("spec/controllers/\\1_controller_spec.rb". "app/models/\\1.rb")
("spec/views/\\1/.*" . "app/models/\\1.rb")
("spec/fixtures/\\1.yml" . "app/models/\\1.rb")
("test/functional/\\1_controller_test.rb" . "app/models/\\1.rb")
("test/unit/\\1_test.rb#test_\\2$" . "app/models/\\1.rb#\\2")
("test/unit/\\1_test.rb" . "app/models/\\1.rb")
("test/fixtures/\\1.yml" . "app/models/\\1.rb")
(t . "app/models/"))
(lambda (path)
(rinari-generate "model"
(and (string-match ".*/\\(.+?\\)\.rb" path)
(match-string 1 path)))))
(controller
"c"
(("app/models/\\1.rb" . "app/controllers/\\1_controller.rb")
("app/views/\\1/\\2\\..*" . "app/controllers/\\1_controller.rb#\\2")
("app/helpers/\\1_helper.rb" . "app/controllers/\\1_controller.rb")
("db/migrate/.*create_\\1.rb" . "app/controllers/\\1_controller.rb")
("spec/models/\\1_spec.rb" . "app/controllers/\\1_controller.rb")
("spec/controllers/\\1_spec.rb" . "app/controllers/\\1.rb")
("spec/views/\\1/\\2\\.*_spec.rb" . "app/controllers/\\1_controller.rb#\\2")
("spec/fixtures/\\1.yml" . "app/controllers/\\1_controller.rb")
("test/functional/\\1_test.rb#test_\\2$" . "app/controllers/\\1.rb#\\2")
("test/functional/\\1_test.rb" . "app/controllers/\\1.rb")
("test/unit/\\1_test.rb#test_\\2$" . "app/controllers/\\1_controller.rb#\\2")
("test/unit/\\1_test.rb" . "app/controllers/\\1_controller.rb")
("test/fixtures/\\1.yml" . "app/controllers/\\1_controller.rb")
(t . "app/controllers/"))
(lambda (path)
(rinari-generate "controller"
(and (string-match ".*/\\(.+?\\)_controller\.rb" path)
(match-string 1 path)))))
(view
"v"
(("app/models/\\1.rb" . "app/views/\\1/.*")
((lambda () ;; find the controller/view
(let* ((raw-file (and (buffer-file-name)
(file-name-nondirectory (buffer-file-name))))
(file (and raw-file
(string-match "^\\(.*\\)_controller.rb" raw-file)
(match-string 1 raw-file))) ;; controller
(raw-method (ruby-add-log-current-method))
(method (and file raw-method ;; action
(string-match "#\\(.*\\)" raw-method)
(match-string 1 raw-method))))
(when (and file method) (rinari-follow-controller-and-action file method))))
. "app/views/\\1/\\2.*")
("app/controllers/\\1_controller.rb" . "app/views/\\1/.*")
("app/helpers/\\1_helper.rb" . "app/views/\\1/.*")
("db/migrate/.*create_\\1.rb" . "app/views/\\1/.*")
("spec/models/\\1_spec.rb" . "app/views/\\1/.*")
("spec/controllers/\\1_spec.rb" . "app/views/\\1/.*")
("spec/views/\\1/\\2_spec.rb" . "app/views/\\1/\\2.*")
("spec/fixtures/\\1.yml" . "app/views/\\1/.*")
("test/functional/\\1_controller_test.rb" . "app/views/\\1/.*")
("test/unit/\\1_test.rb#test_\\2$" . "app/views/\\1/_?\\2.*")
("test/fixtures/\\1.yml" . "app/views/\\1/.*")
(t . "app/views/.*"))
t)
(test
"t"
(("app/models/\\1.rb#\\2$" . "test/unit/\\1_test.rb#test_\\2")
("app/controllers/\\1.rb#\\2$" . "test/functional/\\1_test.rb#test_\\2")
("app/views/\\1/_?\\2\\..*" . "test/functional/\\1_controller_test.rb#test_\\2")
("app/helpers/\\1_helper.rb" . "test/functional/\\1_controller_test.rb")
("db/migrate/.*create_\\1.rb" . "test/unit/\\1_test.rb")
("test/functional/\\1_controller_test.rb" . "test/unit/\\1_test.rb")
("test/unit/\\1_test.rb" . "test/functional/\\1_controller_test.rb")
(t . "test/.*"))
t)
(rspec
"r"
(("app/\\1\\.rb" . "spec/\\1_spec.rb")
("app/\\1$" . "spec/\\1_spec.rb")
("spec/views/\\1_spec.rb" . "app/views/\\1")
("spec/\\1_spec.rb" . "app/\\1.rb")
(t . "spec/.*"))
t)
(fixture
"x"
(("app/models/\\1.rb" . "test/fixtures/\\1.yml")
("app/controllers/\\1_controller.rb" . "test/fixtures/\\1.yml")
("app/views/\\1/.*" . "test/fixtures/\\1.yml")
("app/helpers/\\1_helper.rb" . "test/fixtures/\\1.yml")
("db/migrate/.*create_\\1.rb" . "test/fixtures/\\1.yml")
("spec/models/\\1_spec.rb" . "test/fixtures/\\1.yml")
("spec/controllers/\\1_controller_spec.rb". "test/fixtures/\\1.yml")
("spec/views/\\1/.*" . "test/fixtures/\\1.yml")
("test/functional/\\1_controller_test.rb" . "test/fixtures/\\1.yml")
("test/unit/\\1_test.rb" . "test/fixtures/\\1.yml")
(t . "test/fixtures/"))
t)
(rspec-fixture
"z"
(("app/models/\\1.rb" . "spec/fixtures/\\1.yml")
("app/controllers/\\1_controller.rb" . "spec/fixtures/\\1.yml")
("app/views/\\1/.*" . "spec/fixtures/\\1.yml")
("app/helpers/\\1_helper.rb" . "spec/fixtures/\\1.yml")
("db/migrate/.*create_\\1.rb" . "spec/fixtures/\\1.yml")
("spec/models/\\1_spec.rb" . "spec/fixtures/\\1.yml")
("spec/controllers/\\1_controller_spec.rb". "spec/fixtures/\\1.yml")
("spec/views/\\1/.*" . "spec/fixtures/\\1.yml")
("test/functional/\\1_controller_test.rb" . "spec/fixtures/\\1.yml")
("test/unit/\\1_test.rb" . "spec/fixtures/\\1.yml")
(t . "spec/fixtures/"))
t)
(helper
"h"
(("app/models/\\1.rb" . "app/helpers/\\1_helper.rb")
("app/controllers/\\1_controller.rb" . "app/helpers/\\1_helper.rb")
("app/views/\\1/.*" . "app/helpers/\\1_helper.rb")
("app/helpers/\\1_helper.rb" . "app/helpers/\\1_helper.rb")
("db/migrate/.*create_\\1.rb" . "app/helpers/\\1_helper.rb")
("spec/models/\\1_spec.rb" . "app/helpers/\\1_helper.rb")
("spec/controllers/\\1_spec.rb" . "app/helpers/\\1_helper.rb")
("spec/views/\\1/.*" . "app/helpers/\\1_helper.rb")
("test/functional/\\1_controller_test.rb" . "app/helpers/\\1_helper.rb")
("test/unit/\\1_test.rb#test_\\2$" . "app/helpers/\\1_helper.rb#\\2")
("test/unit/\\1_test.rb" . "app/helpers/\\1_helper.rb")
(t . "app/helpers/"))
t)
(migration
"i"
(("app/controllers/\\1_controller.rb" . "db/migrate/.*create_\\1.rb")
("app/views/\\1/.*" . "db/migrate/.*create_\\1.rb")
("app/helpers/\\1_helper.rb" . "db/migrate/.*create_\\1.rb")
("app/models/\\1.rb" . "db/migrate/.*create_\\1.rb")
("spec/models/\\1_spec.rb" . "db/migrate/.*create_\\1.rb")
("spec/controllers/\\1_spec.rb" . "db/migrate/.*create_\\1.rb")
("spec/views/\\1/.*" . "db/migrate/.*create_\\1.rb")
("test/functional/\\1_controller_test.rb" . "db/migrate/.*create_\\1.rb")
("test/unit/\\1_test.rb#test_\\2$" . "db/migrate/.*create_\\1.rb#\\2")
("test/unit/\\1_test.rb" . "db/migrate/.*create_\\1.rb")
(t . "db/migrate/"))
(lambda (path)
(rinari-generate "migration"
(and (string-match ".*create_\\(.+?\\)\.rb" path)
(match-string 1 path)))))
(cells
"C"
(("app/cells/\\1_cell.rb" . "app/cells/\\1/.*")
("app/cells/\\1/\\2.*" . "app/cells/\\1_cell.rb#\\2")
(t . "app/cells/"))
(lambda (path)
(rinari-generate "cells"
(and (string-match ".*/\\(.+?\\)_cell\.rb" path)
(match-string 1 path)))))
(features "F" ((t . "features/.*feature")) nil)
(steps "S" ((t . "features/step_definitions/.*")) nil)
(environment "e" ((t . "config/environments/")) nil)
(application "a" ((t . "config/application.rb")) nil)
(configuration "n" ((t . "config/")) nil)
(script "s" ((t . "script/")) nil)
(lib "l" ((t . "lib/")) nil)
(log "o" ((t . "log/")) nil)
(worker "w" ((t . "lib/workers/")) nil)
(public "p" ((t . "public/")) nil)
(stylesheet "y" ((t . "public/stylesheets/.*")
(t . "app/assets/stylesheets/.*")) nil)
(sass "Y" ((t . "public/stylesheets/sass/.*")
(t . "app/stylesheets/.*")) nil)
(javascript "j" ((t . "public/javascripts/.*")
(t . "app/assets/javascripts/.*")) nil)
(plugin "u" ((t . "vendor/plugins/")) nil)
(mailer "M" ((t . "app/mailers/")) nil)
(file-in-project "f" ((t . ".*")) nil)
(by-context
";"
(((lambda () ;; Find-by-Context
(let ((path (buffer-file-name)))
(when (string-match ".*/\\(.+?\\)/\\(.+?\\)\\..*" path)
(let ((cv (cons (match-string 1 path) (match-string 2 path))))
(when (re-search-forward "<%=[ \n\r]*render(? *" nil t)
(setf cv (rinari-ruby-values-from-render (car cv) (cdr cv)))
(list (car cv) (cdr cv)))))))
. "app/views/\\1/\\2.*"))))
"Jump schema for rinari.")
(defun rinari-apply-jump-schema (schema)
"Define the rinari-find-* functions by passing each element SCHEMA to `defjump'."
(mapcar
(lambda (type)
(let ((name (first type))
(specs (third type))
(make (fourth type)))
(eval `(defjump
,(intern (format "rinari-find-%S" name))
,specs
rinari-root
,(format "Go to the most logical %S given the current location" name)
,(when make `(quote ,make))
'ruby-add-log-current-method))))
schema))
(rinari-apply-jump-schema rinari-jump-schema)
;;--------------------------------------------------------------------
;; minor mode and keymaps
(defvar rinari-minor-mode-map
(let ((map (make-sparse-keymap)))
map)
"Key map for Rinari minor mode.")
(defun rinari-bind-key-to-func (key func)
"Bind KEY to FUNC with each of the `rinari-minor-mode-prefixes'."
(dolist (prefix rinari-minor-mode-prefixes)
(eval `(define-key rinari-minor-mode-map
,(format "\C-c%s%s" prefix key) ,func))))
(defvar rinari-minor-mode-keybindings
'(("s" . 'rinari-script) ("q" . 'rinari-sql)
("e" . 'rinari-insert-erb-skeleton) ("t" . 'rinari-test)
("r" . 'rinari-rake) ("c" . 'rinari-console)
("w" . 'rinari-web-server) ("g" . 'rinari-rgrep)
("x" . 'rinari-extract-partial) ("p" . 'rinari-goto-partial)
(";" . 'rinari-find-by-context) ("'" . 'rinari-find-by-context)
("d" . 'rinari-cap))
"Alist mapping of keys to functions in `rinari-minor-mode-map'.")
(dolist (el (append (mapcar (lambda (el)
(cons (concat "f" (second el))
(read (format "'rinari-find-%S" (first el)))))
rinari-jump-schema)
rinari-minor-mode-keybindings))
(rinari-bind-key-to-func (car el) (cdr el)))
(easy-menu-define rinari-minor-mode-menu rinari-minor-mode-map
"Rinari menu"
'("Rinari"
["Search" rinari-rgrep t]
"---"
["Find file in project" rinari-find-file-in-project t]
["Find file by context" rinari-find-by-context t]
("Jump to..."
["Model" rinari-find-model t]
["Controller" rinari-find-controller t]
["View" rinari-find-view t]
["Helper" rinari-find-helper t]
["Worker" rinari-find-worker t]
["Mailer" rinari-find-mailer t]
"---"
["Javascript" rinari-find-javascript t]
["Stylesheet" rinari-find-stylesheet t]
["Sass" rinari-find-sass t]
["public/" rinari-find-public t]
"---"
["Test" rinari-find-test t]
["Rspec" rinari-find-rspec t]
["Fixture" rinari-find-fixture t]
["Rspec fixture" rinari-find-rspec-fixture t]
["Feature" rinari-find-features t]
["Step" rinari-find-steps t]
"---"
["application.rb" rinari-find-application t]
["config/" rinari-find-configuration t]
["environments/" rinari-find-environment t]
["migrate/" rinari-find-migration t]
["lib/" rinari-find-lib t]
["script/" rinari-find-script t]
["log/" rinari-find-log t])
"---"
("Web server"
["Start" rinari-web-server t]
["Restart" rinari-web-server-restart t])
["Console" rinari-console t]
["SQL prompt" rinari-sql t]
"---"
["Script" rinari-script t]
["Rake" rinari-rake t]
["Cap" rinari-cap t]))
;;;###autoload
(defun rinari-launch ()
"Call function `rinari-minor-mode' if inside a rails project.
Otherwise, disable that minor mode if currently enabled."
(interactive)
(let ((root (rinari-root)))
(if root
(let ((r-tags-path (concat root rinari-tags-file-name)))
(set (make-local-variable 'tags-file-name)
(and (file-exists-p r-tags-path) r-tags-path))
(rinari-minor-mode t))
(when rinari-minor-mode
(rinari-minor-mode -1)))))
(defun rinari-launch-maybe ()
"Call `rinari-launch' if customized to do so.
Both `rinari-major-modes' and `rinari-exclude-major-modes' will
be used to make the decision. When the global rinari mode is
active, the default is to try to launch rinari in any major
mode. If `rinari-major-modes' is non-nil, then launching will
happen only in the listed modes. Major modes listed in
`rinari-exclude-major-modes' will never have rinari
auto-launched, but `rinari-launch' can still be used to manually
enable rinari in buffers using those modes."
(when (and (not (minibufferp))
(or (null rinari-major-modes)
(memq major-mode rinari-major-modes))
(or (null rinari-exclude-major-modes)
(not (memq major-mode rinari-exclude-major-modes))))
(rinari-launch)))
(add-hook 'mumamo-after-change-major-mode-hook 'rinari-launch)
(defadvice cd (after rinari-on-cd activate)
"Call `rinari-launch' when changing directories.
This will activate/deactivate rinari as necessary when changing
into and out of rails project directories."
(rinari-launch))
;;;###autoload
(define-minor-mode rinari-minor-mode
"Enable Rinari minor mode to support working with the Ruby on Rails framework."
nil
" Rinari"
rinari-minor-mode-map)
;;;###autoload
(define-global-minor-mode global-rinari-mode
rinari-minor-mode rinari-launch-maybe)
(provide 'rinari)
;; Local Variables:
;; coding: utf-8
;; indent-tabs-mode: nil
;; byte-compile-warnings: (not cl-functions)
;; eval: (checkdoc-minor-mode 1)
;; End:
;;; rinari.el ends here

215
conf/emacs.d/rinari/util/cucumber-mode-compilation.el Normal file
View File

@ -0,0 +1,215 @@
;;
;; Add cucumber feature-running support to rinari
;;
;; This code targetted at Michael Klishin's cucumber-mode.el which can be found at:
;;
;; http://github.com/michaelklishin/cucumber.el
;;
;; Author: Mike Dalessio (borrowing heavily from Eric Schulte's ruby-compilation.el)
;; Created: 2009-01-29
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Allow for execution of cucumber features dumping the results into a
;; compilation buffer. Gives the user the ability to jump to errors in
;; source code.
;;
;; The functions you will probably want to use are
;;
;; cucumber-compilation-this-buffer (C-x t)
;; cucumber-compilation-this-scenario (C-x C-t)
;;
;;; TODO:
;;
;; cucumber-compilation-error-regexp could be vastly improved.
;; Do we really need to strip ansi color codes out?
;;
(require 'ansi-color)
(require 'compile)
(require 'inf-ruby)
(require 'which-func)
(defvar cucumber-compilation-executable "cucumber"
"The binary to run the feature scenarios. Override if you use JRuby etc.")
(defvar cucumber-compilation-error-regexp
"^\\([[:space:]]*\\|.*\\[\\|[^\*].*at \\)\\[?\\([^[:space:]]*\\):\\([[:digit:]]+\\)[]:)\n]?"
"regular expression to match errors in cucumber process output")
(defvar cucumber-compilation-error-regexp-alist
`((,cucumber-compilation-error-regexp 2 3))
"a version of `compilation-error-regexp-alist' to be used in
cucumber output (should be used with `make-local-variable')")
(defvar cucumber-compilation-clear-between t
"Whether to clear the compilation output between runs.")
(defvar cucumber-compilation-reuse-buffers t
"Whether to re-use the same comint buffer for focussed tests.")
(defadvice cucumber-compilation-do (around cucumber-compilation-do activate)
"Set default directory to the root of the rails application
before running cucumber processes."
(let ((default-directory (or (rinari-root) default-directory)))
ad-do-it
(rinari-launch)))
;;;###autoload
(defun cucumber-compilation-this-buffer ()
"Run the current buffer's scenarios through cucumber."
(interactive)
(cucumber-compilation-run (buffer-file-name)))
;;;###autoload
(defun cucumber-compilation-this-scenario ()
"Run the scenario at point through cucumber."
(interactive)
(let ((scenario-name (cucumber-compilation-this-scenario-name))
(profile-name (cucumber-compilation-profile-name)))
(pop-to-buffer (cucumber-compilation-do
(cucumber-compilation-this-test-buffer-name scenario-name)
(list cucumber-compilation-executable
(buffer-file-name)
"-p" profile-name
"-s" scenario-name)))))
(defun cucumber-compilation-this-test-buffer-name (scenario-name)
"The name of the buffer in which test-at-point will run."
(interactive)
(if cucumber-compilation-reuse-buffers
(file-name-nondirectory (buffer-file-name))
(format "cucumber: %s - %s"
(file-name-nondirectory (buffer-file-name))
scenario-name)))
;;;###autoload
(defun cucumber-compilation-run (cmd)
"Run a cucumber process, dumping output to a compilation buffer."
(interactive)
(let* ((name (file-name-nondirectory (car (split-string cmd))))
(profile-name (cucumber-compilation-profile-name))
(cmdlist (list cucumber-compilation-executable
"-p" profile-name
(expand-file-name cmd))))
(pop-to-buffer (cucumber-compilation-do name cmdlist))))
(defun cucumber-compilation-do (name cmdlist)
(save-some-buffers (not compilation-ask-about-save)
compilation-save-buffers-predicate)
(let ((comp-buffer-name (format "*%s*" name)))
(unless (comint-check-proc comp-buffer-name)
(let* ((buffer (apply 'make-comint name (car cmdlist) nil (cdr cmdlist)))
(proc (get-buffer-process buffer)))
(save-excursion
(set-buffer buffer) ;; set buffer local variables and process ornaments
(set-process-sentinel proc 'cucumber-compilation-sentinel)
(set-process-filter proc 'cucumber-compilation-insertion-filter)
(set (make-local-variable 'compilation-error-regexp-alist)
cucumber-compilation-error-regexp-alist)
(set (make-local-variable 'kill-buffer-hook)
(lambda ()
(let ((orphan-proc (get-buffer-process (buffer-name))))
(if orphan-proc
(kill-process orphan-proc)))))
(compilation-minor-mode t)
(cucumber-compilation-minor-mode t))))
comp-buffer-name))
(defun cucumber-compilation-sentinel (proc msg)
"Notify to changes in process state"
(message "%s - %s" proc (replace-regexp-in-string "\n" "" msg)))
(defun cucumber-compilation-previous-error-group ()
"Jump to the start of the previous error group in the current compilation buffer."
(interactive)
(compilation-previous-error 1)
(while (string-match cucumber-compilation-error-regexp (thing-at-point 'line))
(forward-line -1))
(forward-line 1) (recenter))
(defun cucumber-compilation-next-error-group ()
"Jump to the start of the previous error group in the current compilation buffer."
(interactive)
(while (string-match cucumber-compilation-error-regexp (thing-at-point 'line))
(forward-line 1))
(compilation-next-error 1) (recenter))
(defun cucumber-compilation-insertion-filter (proc string)
"Insert text to buffer stripping ansi color codes"
(with-current-buffer (process-buffer proc)
(let ((moving (= (point) (process-mark proc))))
(save-excursion
(goto-char (process-mark proc))
(insert (ansi-color-apply string))
(set-marker (process-mark proc) (point)))
(if moving (goto-char (process-mark proc))))))
(defun cucumber-compilation-this-scenario-name ()
"Which scenario are we currently in?"
(save-excursion
(search-backward-regexp "\\(?:Scenario:\\) \\(.*\\)")
(match-string-no-properties 1)))
(defun cucumber-compilation-profile-name ()
"Tries to find a comment in the file source indicating which cucumber profile to use.
The comment will be of the format '# profile <profilename>'
If not found, we'll default to 'default'."
(save-excursion
(goto-char (point-min))
(if (re-search-forward "^#[[:space:]]*profile:?[[:space:]]+\\(.+\\)" nil t)
(match-string-no-properties 1)
"default")))
(defvar cucumber-compilation-minor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "q" 'quit-window)
(define-key map "p" 'previous-error-no-select)
(define-key map "n" 'next-error-no-select)
(define-key map "\M-p" 'cucumber-compilation-previous-error-group)
(define-key map "\M-n" 'cucumber-compilation-next-error-group)
(define-key map (kbd "C-c C-c") 'comint-interrupt-subjob)
map)
"Key map for Cucumber Compilation minor mode.")
(define-minor-mode cucumber-compilation-minor-mode
"Enable Cucumber Compilation minor mode providing some key-bindings
for navigating cucumber compilation buffers."
nil
" cucumber:comp"
cucumber-compilation-minor-mode-map
(when cucumber-compilation-clear-between
(delete-region (point-min) (point-max))))
;; So we can invoke it easily.
(add-hook 'feature-mode-hook
'(lambda ()
(define-key feature-mode-map (kbd "C-x t") 'cucumber-compilation-this-buffer)
(define-key feature-mode-map (kbd "C-x C-t") 'cucumber-compilation-this-scenario)
;; ensure font lock font-stripping doesn't kill our explicit ansi colorization
(setq font-lock-unfontify-region-function 'ansi-color-unfontify-region)
))
(provide 'cucumber-mode-compilation)

375
conf/emacs.d/rinari/util/inf-ruby/inf-ruby.el Executable file
View File

@ -0,0 +1,375 @@
;;; inf-ruby.el --- Run a ruby process in a buffer
;; Copyright (C) 1999-2008 Yukihiro Matsumoto, Nobuyoshi Nakada
;; Author: Yukihiro Matsumoto, Nobuyoshi Nakada
;; URL: http://github.com/nonsequitur/inf-ruby
;; Created: 8 April 1998
;; Keywords: languages ruby
;; Version: 2.2.4
;;; Commentary:
;;
;; inf-ruby.el provides a REPL buffer connected to an IRB subprocess.
;;
;; If you're installing manually, you'll need to:
;; * drop the file somewhere on your load path (perhaps ~/.emacs.d)
;; * Add the following lines to your .emacs file:
;; (autoload 'inf-ruby "inf-ruby" "Run an inferior Ruby process" t)
;; (autoload 'inf-ruby-setup-keybindings "inf-ruby" "" t)
;; (eval-after-load 'ruby-mode
;; '(add-hook 'ruby-mode-hook 'inf-ruby-setup-keybindings))
;;; TODO:
;;
;; inferior-ruby-error-regexp-alist doesn't match this example
;; SyntaxError: /home/eschulte/united/org/work/arf/arf/lib/cluster.rb:35: syntax error, unexpected '~', expecting kEND
;; similarity = comparison_cache[m][n] ||= clusters[m] ~ clusters[n]
(require 'comint)
(require 'compile)
(require 'ruby-mode)
(defvar inf-ruby-default-implementation "ruby"
"Which ruby implementation to use if none is specified.")
(defvar inf-ruby-first-prompt-pattern "^irb(.*)[0-9:]+0> *"
"First prompt regex pattern of ruby interpreter.")
(defvar inf-ruby-prompt-pattern "^\\(irb(.*)[0-9:]+[>*\"'] *\\)+"
"Prompt regex pattern of ruby interpreter.")
(defvar inf-ruby-mode-hook nil
"*Hook for customising inf-ruby mode.")
(defvar inf-ruby-mode-map
(let ((map (copy-keymap comint-mode-map)))
(define-key map (kbd "C-c C-l") 'inf-ruby-load-file)
(define-key map (kbd "C-x C-e") 'ruby-send-last-sexp)
(define-key map (kbd "TAB") 'inf-ruby-complete)
map)
"*Mode map for inf-ruby-mode")
(defvar inf-ruby-implementations
'(("ruby" . "irb --inf-ruby-mode -r irb/completion")
("jruby" . "jruby -S irb -r irb/completion")
("rubinius" . "rbx -r irb/completion")
("yarv" . "irb1.9 --inf-ruby-mode -r irb/completion")) ;; TODO: ironruby?
"An alist of ruby implementations to irb executable names.")
;; TODO: do we need these two defvars?
(defvar ruby-source-modes '(ruby-mode)
"*Used to determine if a buffer contains Ruby source code.
If it's loaded into a buffer that is in one of these major modes, it's
considered a ruby source file by ruby-load-file.
Used by these commands to determine defaults.")
(defvar ruby-prev-l/c-dir/file nil
"Caches the last (directory . file) pair.
Caches the last pair used in the last ruby-load-file command.
Used for determining the default in the
next one.")
(defvar inf-ruby-at-top-level-prompt-p t)
(defconst inf-ruby-error-regexp-alist
'(("SyntaxError: compile error\n^\\([^\(].*\\):\\([1-9][0-9]*\\):" 1 2)
("^\tfrom \\([^\(].*\\):\\([1-9][0-9]*\\)\\(:in `.*'\\)?$" 1 2)))
;;;###autoload
(defun inf-ruby-setup-keybindings ()
"Set local key defs to invoke inf-ruby from ruby-mode."
(define-key ruby-mode-map "\M-\C-x" 'ruby-send-definition)
(define-key ruby-mode-map "\C-x\C-e" 'ruby-send-last-sexp)
(define-key ruby-mode-map "\C-c\C-b" 'ruby-send-block)
(define-key ruby-mode-map "\C-c\M-b" 'ruby-send-block-and-go)
(define-key ruby-mode-map "\C-c\C-x" 'ruby-send-definition)
(define-key ruby-mode-map "\C-c\M-x" 'ruby-send-definition-and-go)
(define-key ruby-mode-map "\C-c\C-r" 'ruby-send-region)
(define-key ruby-mode-map "\C-c\M-r" 'ruby-send-region-and-go)
(define-key ruby-mode-map "\C-c\C-z" 'ruby-switch-to-inf)
(define-key ruby-mode-map "\C-c\C-l" 'ruby-load-file)
(define-key ruby-mode-map "\C-c\C-s" 'inf-ruby))
(defvar inf-ruby-buffer nil "Current irb process buffer.")
(defun inf-ruby-mode ()
"Major mode for interacting with an inferior ruby (irb) process.
The following commands are available:
\\{inf-ruby-mode-map}
A ruby process can be fired up with M-x inf-ruby.
Customisation: Entry to this mode runs the hooks on comint-mode-hook and
inf-ruby-mode-hook (in that order).
You can send text to the inferior ruby process from other buffers containing
Ruby source.
ruby-switch-to-inf switches the current buffer to the ruby process buffer.
ruby-send-definition sends the current definition to the ruby process.
ruby-send-region sends the current region to the ruby process.
ruby-send-definition-and-go, ruby-send-region-and-go,
switch to the ruby process buffer after sending their text.
Commands:
Return after the end of the process' output sends the text from the
end of process to point.
Return before the end of the process' output copies the sexp ending at point
to the end of the process' output, and sends it.
Delete converts tabs to spaces as it moves back.
Tab indents for ruby; with arugment, shifts rest
of expression rigidly with the current line.
C-M-q does Tab on each line starting within following expression.
Paragraphs are separated only by blank lines. # start comments.
If you accidentally suspend your process, use \\[comint-continue-subjob]
to continue it."
(interactive)
(comint-mode)
(setq comint-prompt-regexp inf-ruby-prompt-pattern)
(ruby-mode-variables)
(setq major-mode 'inf-ruby-mode)
(setq mode-name "Inf-Ruby")
(setq mode-line-process '(":%s"))
(use-local-map inf-ruby-mode-map)
(add-to-list 'comint-output-filter-functions 'inf-ruby-output-filter)
(setq comint-get-old-input (function inf-ruby-get-old-input))
(make-local-variable 'compilation-error-regexp-alist)
(setq compilation-error-regexp-alist inf-ruby-error-regexp-alist)
(compilation-shell-minor-mode t)
(run-hooks 'inf-ruby-mode-hook))
(defun inf-ruby-output-filter (output)
"Check if the current prompt is a top-level prompt"
(setq inf-ruby-at-top-level-prompt-p
(string-match inf-ruby-prompt-pattern
(car (last (split-string output "\n"))))))
;; adapted from replace-in-string in XEmacs (subr.el)
(defun inf-ruby-remove-in-string (str regexp)
"Remove all matches in STR for REGEXP and returns the new string."
(let ((rtn-str "") (start 0) match prev-start)
(while (setq match (string-match regexp str start))
(setq prev-start start
start (match-end 0)
rtn-str (concat rtn-str (substring str prev-start match))))
(concat rtn-str (substring str start))))
(defun inf-ruby-get-old-input ()
"Snarf the sexp ending at point"
(save-excursion
(let ((end (point)))
(re-search-backward inf-ruby-first-prompt-pattern)
(inf-ruby-remove-in-string (buffer-substring (point) end)
inf-ruby-prompt-pattern))))
;;;###autoload
(defun inf-ruby (&optional impl)
"Run an inferior Ruby process in a buffer.
With prefix argument, prompts for which Ruby implementation
\(from the list `inf-ruby-implementations') to use. Runs the
hooks `inf-ruby-mode-hook' \(after the `comint-mode-hook' is
run)."
(interactive (list (if current-prefix-arg
(completing-read "Ruby Implementation: "
(mapc #'car inf-ruby-implementations))
inf-ruby-default-implementation)))
(setq impl (or impl "ruby"))
(let ((command (cdr (assoc impl inf-ruby-implementations))))
(run-ruby command impl)))
;;;###autoload
(defun run-ruby (&optional command name)
"Run an inferior Ruby process, input and output via buffer *ruby*.
If there is a process already running in `*ruby*', switch to that buffer.
With argument, allows you to edit the command line (default is value
of `ruby-program-name'). Runs the hooks `inferior-ruby-mode-hook'
\(after the `comint-mode-hook' is run).
\(Type \\[describe-mode] in the process buffer for a list of commands.)"
(interactive)
(setq command (or command (cdr (assoc inf-ruby-default-implementation
inf-ruby-implementations))))
(setq name (or name "ruby"))
(if (not (comint-check-proc inf-ruby-buffer))
(let ((commandlist (split-string-and-unquote command)))
(set-buffer (apply 'make-comint name (car commandlist)
nil (cdr commandlist)))
(inf-ruby-mode)))
(pop-to-buffer (setq inf-ruby-buffer (format "*%s*" name))))
(defun inf-ruby-proc ()
"Returns the current IRB process. See variable inf-ruby-buffer."
(or (get-buffer-process (if (eq major-mode 'inf-ruby-mode)
(current-buffer)
inf-ruby-buffer))
(error "No current process. See variable inf-ruby-buffer")))
;; These commands are added to the ruby-mode keymap:
(defconst ruby-send-terminator "--inf-ruby-%x-%d-%d-%d--"
"Template for irb here document terminator.
Must not contain ruby meta characters.")
(defconst inf-ruby-eval-binding "IRB.conf[:MAIN_CONTEXT].workspace.binding")
(defconst ruby-eval-separator "")
(defun ruby-send-region (start end)
"Send the current region to the inferior Ruby process."
(interactive "r")
(let (term (file (or buffer-file-name (buffer-name))) line)
(save-excursion
(save-restriction
(widen)
(goto-char start)
(setq line (+ start (forward-line (- start)) 1))
(goto-char start)
(while (progn
(setq term (apply 'format ruby-send-terminator (random) (current-time)))
(re-search-forward (concat "^" (regexp-quote term) "$") end t)))))
;; compilation-parse-errors parses from second line.
(save-excursion
(let ((m (process-mark (inf-ruby-proc))))
(set-buffer (marker-buffer m))
(goto-char m)
(insert ruby-eval-separator "\n")
(set-marker m (point))))
(comint-send-string (inf-ruby-proc) (format "eval <<'%s', %s, %S, %d\n"
term inf-ruby-eval-binding
file line))
(comint-send-region (inf-ruby-proc) start end)
(comint-send-string (inf-ruby-proc) (concat "\n" term "\n"))))
(defun ruby-send-definition ()
"Send the current definition to the inferior Ruby process."
(interactive)
(save-excursion
(ruby-end-of-defun)
(let ((end (point)))
(ruby-beginning-of-defun)
(ruby-send-region (point) end))))
(defun ruby-send-last-sexp ()
"Send the previous sexp to the inferior Ruby process."
(interactive)
(ruby-send-region (save-excursion (ruby-backward-sexp) (point)) (point)))
(defun ruby-send-block ()
"Send the current block to the inferior Ruby process."
(interactive)
(save-excursion
(ruby-end-of-block)
(end-of-line)
(let ((end (point)))
(ruby-beginning-of-block)
(ruby-send-region (point) end))))
(defun ruby-switch-to-inf (eob-p)
"Switch to the ruby process buffer.
With argument, positions cursor at end of buffer."
(interactive "P")
(if (get-buffer inf-ruby-buffer)
(pop-to-buffer inf-ruby-buffer)
(error "No current process buffer. See variable inf-ruby-buffer."))
(cond (eob-p
(push-mark)
(goto-char (point-max)))))
(defun ruby-send-region-and-go (start end)
"Send the current region to the inferior Ruby process.
Then switch to the process buffer."
(interactive "r")
(ruby-send-region start end)
(ruby-switch-to-inf t))
(defun ruby-send-definition-and-go ()
"Send the current definition to the inferior Ruby.
Then switch to the process buffer."
(interactive)
(ruby-send-definition)
(ruby-switch-to-inf t))
(defun ruby-send-block-and-go ()
"Send the current block to the inferior Ruby.
Then switch to the process buffer."
(interactive)
(ruby-send-block)
(ruby-switch-to-inf t))
(defun ruby-load-file (file-name)
"Load a Ruby file into the inferior Ruby process."
(interactive (comint-get-source "Load Ruby file: " ruby-prev-l/c-dir/file
ruby-source-modes t)) ;; T because LOAD needs an exact name
(comint-check-source file-name) ; Check to see if buffer needs saved.
(setq ruby-prev-l/c-dir/file (cons (file-name-directory file-name)
(file-name-nondirectory file-name)))
(comint-send-string (inf-ruby-proc) (concat "(load \""
file-name
"\"\)\n")))
(defun ruby-escape-single-quoted (str)
(replace-regexp-in-string "'" "\\\\'"
(replace-regexp-in-string "\n" "\\\\n"
(replace-regexp-in-string "\\\\" "\\\\\\\\" str))))
(defsubst inf-ruby-fix-completions-on-windows ()
"On Windows, the string received by `accept-process-output'
starts with the last line that was sent to the Ruby process.
The reason for this is unknown. Remove this line from `completions'."
(if (eq system-type 'windows-nt)
(setq completions (cdr completions))))
(defun inf-ruby-completions (seed)
"Return a list of completions for the line of ruby code starting with SEED."
(let* ((proc (get-buffer-process inf-ruby-buffer))
(comint-filt (process-filter proc))
(kept "") completions)
(set-process-filter proc (lambda (proc string) (setq kept (concat kept string))))
(process-send-string proc (format "puts IRB::InputCompletor::CompletionProc.call('%s').compact\n"
(ruby-escape-single-quoted seed)))
(while (and (not (string-match inf-ruby-prompt-pattern kept))
(accept-process-output proc 2)))
(setq completions (butlast (split-string kept "\r?\n") 2))
(inf-ruby-fix-completions-on-windows)
(set-process-filter proc comint-filt)
completions))
(defun inf-ruby-completion-at-point ()
(if inf-ruby-at-top-level-prompt-p
(let* ((curr (replace-regexp-in-string "\n$" "" (thing-at-point 'line)))
(completions (inf-ruby-completions curr)))
(if completions
(if (= (length completions) 1)
(car completions)
(completing-read "possible completions: "
completions nil t curr))))
(message "Completion aborted: Not at a top-level prompt")
nil))
(defun inf-ruby-complete (command)
"Complete the ruby code at point. Relies on the irb/completion
Module used by readline when running irb through a terminal"
(interactive (list (inf-ruby-completion-at-point)))
(when command
(kill-whole-line 0)
(insert command)))
(defun inf-ruby-complete-or-tab (&optional command)
"Either complete the ruby code at point or call
`indent-for-tab-command' if no completion is available."
(interactive (list (inf-ruby-completion-at-point)))
(if (not command)
(call-interactively 'indent-for-tab-command)
(inf-ruby-complete command)))
;;;###autoload
(eval-after-load 'ruby-mode
'(inf-ruby-setup-keybindings))
(provide 'inf-ruby)
;;; inf-ruby.el ends here

12
conf/emacs.d/rinari/util/jump/README Normal file
View File

@ -0,0 +1,12 @@
jump.el
elisp utility for defining functions which contextually jump between
files in a project (created to facilitate development of rinari and
similar projects see http://github.com/eschulte/rinari/tree/master)
inspired by
find-file-in-project | http://www.emacswiki.org/cgi-bin/wiki/FindFileInProject
toggle.el | http://www.emacswiki.org/cgi-bin/emacs/toggle.el
uses
findr.el | http://www.emacswiki.org/cgi-bin/wiki/FindrPackage

24
conf/emacs.d/rinari/util/jump/Rakefile Normal file
View File

@ -0,0 +1,24 @@
MYDIR = File.dirname(__FILE__)
TESTDIR = "#{MYDIR}/test"
namespace "test" do
desc "Run tests using `emacs-snapshot'"
task :snapshot do
system "emacs-snapshot -Q -l #{TESTDIR}/init.el"
end
desc "Run tests using `emacs-22'"
task :twenty_two do
system "emacs22 -Q -l #{TESTDIR}/init.el"
end
desc "Run tests using `emacs'"
task :emacs do
system "emacs -Q -l #{TESTDIR}/init.el"
end
end
task :default => 'test:emacs'

258
conf/emacs.d/rinari/util/jump/findr.el Normal file
View File

@ -0,0 +1,258 @@
;;; findr.el --- Breadth-first file-finding facility for (X)Emacs
;; Dec 1, 2006
;; Copyright (C) 1999 Free Software Foundation, Inc.
;; Author: David Bakhash <cadet@bu.edu>
;; Maintainer: David Bakhash <cadet@bu.edu>
;; Version: 0.7
;; Created: Tue Jul 27 12:49:22 EST 1999
;; Keywords: files
;; This file is not part of emacs or XEmacs.
;; This file is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of the
;; License, or (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING. If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
;;; Commentary:
;; This code contains a command, called `findr', which allows you to
;; search for a file breadth-first. This works on UNIX, Windows, and
;; over the network, using efs and ange-ftp. It's pretty quick, and (at
;; times) is a better and easier alternative to other mechanisms of
;; finding nested files, when you've forgotten where they are.
;; You pass `findr' a regexp, which must match the file you're looking
;; for, and a directory, and then it just does its thing:
;; M-x findr <ENTER> ^my-lib.p[lm]$ <ENTER> c:/ <ENTER>
;; If called interactively, findr will prompt the user for opening the
;; found file(s). Regardless, it will continue to search, until
;; either the search is complete or the user quits the search.
;; Regardless of the exit (natural or user-invoked), a findr will
;; return a list of found matches.
;; Two other entrypoints let you to act on regexps within the files:
;; `findr-search' to search
;; `findr-query-replace' to replace
;;; Installation:
;; (autoload 'findr "findr" "Find file name." t)
;; (define-key global-map [(meta control S)] 'findr)
;; (autoload 'findr-search "findr" "Find text in files." t)
;; (define-key global-map [(meta control s)] 'findr-search)
;; (autoload 'findr-query-replace "findr" "Replace text in files." t)
;; (define-key global-map [(meta control r)] 'findr-query-replace)
;; Change Log:
;; 0.1: Added prompt to open file, if uses so chooses, following
;; request and code example from Thomas Plass.
;; 0.2: Made `findr' not stop after the first match, based on the
;; request by Thomas Plass.
;; Also, fixed a minor bug where findr was finding additional
;; files that were not correct matches, based on
;; `file-relative-name' misuse (I had to add the 2nd arg to it).
;; 0.3: Added a `sit-for' for redisplay reasons.
;; Modifications as suggested by RMS: e.g. docstring.
;; 0.4 Added `findr-query-replace', courtesy of Dan Nelsen.
;; 0.5 Fixed spelling and minor bug in `findr-query-replace' when
;; non-byte-compiled.
;; 0.6 http://groups.google.com/groups?selm=cxjhfml4b2c.fsf_-_%40acs5.bu.edu :
;; From: David Bakhash (cadet@bu.edu)
;; Subject: Re: latest version of findr.el (5)
;; Date: 1999/07/31
;; Courtesy of Dan Nelsen, this version has search-and-replace capabilities.
;; it's still a bit experimental, so I wouldn't expect too much of it. But it
;; hasn't been tested yet for friendly behavior.
;;
;; The function `findr-query-replace' wasn't working unless you byte-compile the
;; file. But, since findr is really designed for speed, that's not a bad thing
;; (i.e. it forces you to byte-compile it). It's as simple as:
;;
;; M-x byte-compile-file <ENTER> /path/to/findr.el <ENTER>
;;
;; anyhow, I think it should work now.
;;
;; dave
;;
;; 0.7: Added `findr-search', broke `findr' by Patrick Anderson
;; 0.8: fixed 0.7 breakage by Patrick Anderson
;; 0.9: Added customize variables, added file/directory filter regexp
;; minibuffer history by attila.lendvai@gmail.com
;; 0.9.1: Updated date at the top of the file, added .svn filter
;; 0.9.2: Added support for skipping symlinks
(eval-when-compile
(require 'cl))
(provide 'findr)
(defgroup findr nil
"findr configuration."
:prefix "findr-"
:group 'findr)
;; To build the expression below:
;;(let ((result nil))
;; (dolist (el (list ".backups" "_darcs" ".git" "CVS" ".svn"))
;; (setf result (if result
;; (concatenate 'string result "\\|")
;; ""))
;; (setf result (concatenate 'string result "^" (regexp-quote el) "$")))
;; result)
(defcustom findr-skip-directory-regexp "^\\.backups$\\|^_darcs$\\|^\\.git$\\|^CVS$\\|^\\.svn$"
"A regexp that will be matched against the directory names and when it matches then the entire directory is skipped."
:type 'string
:group 'findr)
(defcustom findr-skip-file-regexp "^[#\\.]"
"A regexp that will be matched against all file names (including directories) and when it matches then the file is skipped."
:type 'string
:group 'findr)
(defvar findr-search-regexp-history nil)
(defvar findr-search-replacement-history nil)
(defvar findr-file-name-regexp-history nil)
(defvar findr-directory-history nil)
(defun findr-read-search-regexp (&optional prompt)
(read-from-minibuffer
(or prompt "Search through files for (regexp): ")
nil nil nil 'findr-search-regexp-history))
(defun findr-read-file-regexp (&optional prompt)
(read-from-minibuffer
(or prompt "Look in these files (regexp): ")
(first findr-file-name-regexp-history)
nil nil 'findr-file-name-regexp-history))
(defun findr-read-starting-directory (&optional prompt)
(apply 'read-directory-name
(append
(list (or prompt "Start in directory: ") default-directory
default-directory t nil)
(when (featurep 'xemacs)
(list 'findr-directory-history)))))
;;;; breadth-first file finder...
(defun* findr (name dir &key (prompt-p (interactive-p)) (skip-symlinks t))
"Search directory DIR breadth-first for files matching regexp NAME.
If PROMPT-P is non-nil, or if called interactively, Prompts for visiting
search result\(s\)."
(let ((*dirs* (findr-make-queue))
*found-files*)
(labels ((findr-1 (dir)
(message "Searching %s ..." dir)
(let ((files (directory-files dir t "\\w")))
(loop
for file in files
for fname = (file-relative-name file dir)
when (and (file-directory-p file)
(not (string-match findr-skip-directory-regexp fname))
(and skip-symlinks
(not (file-symlink-p file))))
do (findr-enqueue file *dirs*)
when (and (string-match name fname)
(not (string-match findr-skip-file-regexp fname))
(and skip-symlinks
(not (file-symlink-p file))))
do
;; Don't return directory names when
;; building list for `tags-query-replace' or `tags-search'
;;(when (and (file-regular-p file)
;; (not prompt-p))
;; (push file *found-files*))
;; _never_ return directory names
(when (file-regular-p file)
(push file *found-files*))
(message file)
(when (and prompt-p
(y-or-n-p (format "Find file %s? " file)))
(find-file file)
(sit-for 0) ; redisplay hack
)))))
(unwind-protect
(progn
(findr-enqueue dir *dirs*)
(while (findr-queue-contents *dirs*)
(findr-1 (findr-dequeue *dirs*)))
(message "Searching... done."))
(return-from findr (nreverse *found-files*))))))
(defun findr-query-replace (from to name dir)
"Do `query-replace-regexp' of FROM with TO, on each file found by findr.
If you exit (\\[keyboard-quit] or ESC), you can resume the query replace
with the command \\[tags-loop-continue]."
(interactive (let ((search-for (findr-read-search-regexp "Search through files for (regexp): ")))
(list search-for
(read-from-minibuffer (format "Query replace '%s' with: " search-for)
nil nil nil 'findr-search-replacement-history)
(findr-read-file-regexp)
(findr-read-starting-directory))))
(tags-query-replace from to nil '(findr name dir)))
(defun findr-search (regexp files dir)
"Search through all files listed in tags table for match for REGEXP.
Stops when a match is found.
To continue searching for next match, use command \\[tags-loop-continue]."
(interactive (list (findr-read-search-regexp)
(findr-read-file-regexp)
(findr-read-starting-directory)))
(tags-search regexp '(findr files dir)))
(defun findr-find-files (files dir)
"Same as `findr' except file names are put in a compilation buffer."
(interactive (list (findr-read-file-regexp)
(findr-read-starting-directory)))
;; TODO: open a scratch buffer or store in the clipboard
(mapcar 'message (findr files dir)))
;;;; Queues
(defun findr-make-queue ()
"Build a new queue, with no elements."
(let ((q (cons nil nil)))
(setf (car q) q)
q))
(defun findr-enqueue (item q)
"Insert item at the end of the queue."
(setf (car q)
(setf (rest (car q))
(cons item nil)))
q)
(defun findr-dequeue (q)
"Remove an item from the front of the queue."
(prog1 (pop (cdr q))
(when (null (cdr q))
(setf (car q) q))))
(defsubst findr-queue-contents (q)
(cdr q))
;;; findr.el ends here

157
conf/emacs.d/rinari/util/jump/inflections.el Normal file
View File

@ -0,0 +1,157 @@
;;; inflections.el --- convert english words between singular and plural
;; Copyright (C) 2006 Dmitry Galinsky <dima dot exe at gmail dot com>
;; Author: Dmitry Galinsky, Howard Yeh
;; URL: https://github.com/eschulte/jump.el
;; Version: 1.1
;; Created: 2007-11-02
;; Keywords: ruby rails languages oop
;; This file is NOT part of GNU Emacs.
;;; License
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
;;; Code:
(require 'cl)
(defvar inflection-singulars nil)
(defvar inflection-plurals nil)
(defvar inflection-irregulars nil)
(defvar inflection-uncountables nil)
(defmacro define-inflectors (&rest specs)
(cons 'progn
(loop for (type . rest) in specs
collect (case type
(:singular `(push (quote ,rest) inflection-singulars))
(:plural `(push (quote ,rest) inflection-plurals))
(:irregular `(push (quote ,rest) inflection-irregulars))
(:uncountable `(setf inflection-uncountables
(append (quote ,rest) inflection-uncountables)))))))
(defmacro string=~ (regex string &rest body)
"regex matching similar to the =~ operator found in other languages."
(let ((str (gensym)))
`(lexical-let ((,str ,string))
;; Use lexical-let to make closures (in flet).
(when (string-match ,regex ,str)
(symbol-macrolet ,(loop for i to 9 collect
(let ((sym (intern (concat "$" (number-to-string i)))))
`(,sym (match-string ,i ,str))))
(flet (($ (i) (match-string i ,str))
(sub (replacement &optional (i 0) &key fixedcase literal-string)
(replace-match replacement fixedcase literal-string ,str i)))
(symbol-macrolet ( ;;before
($b (substring ,str 0 (match-beginning 0)))
;;match
($m (match-string 0 ,str))
;;after
($a (substring ,str (match-end 0) (length ,str))))
,@body)))))))
(define-inflectors
(:plural "$" "s")
(:plural "s$" "s")
(:plural "\\(ax\\|test\\)is$" "\\1es")
(:plural "\\(octop\\|vir\\)us$" "\\1i")
(:plural "\\(alias\\|status\\)$" "\\1es")
(:plural "\\(bu\\)s$" "\\1ses")
(:plural "\\(buffal\\|tomat\\)o$" "\\1oes")
(:plural "\\([ti]\\)um$" "\\1a")
(:plural "sis$" "ses")
(:plural "\\(?:\\([^f]\\)fe\\|\\([lr]\\)f\\)$" "\\1\\2ves")
(:plural "\\(hive\\)$" "\\1s")
(:plural "\\([^aeiouy]\\|qu\\)y$" "\\1ies")
(:plural "\\(x\\|ch\\|ss\\|sh\\)$" "\\1es")
(:plural "\\(matr\\|vert\\|ind\\)ix\\|ex$" "\\1ices")
(:plural "\\([m\\|l]\\)ouse$" "\\1ice")
(:plural "^\\(ox\\)$" "\\1en")
(:plural "\\(quiz\\)$" "\\1zes")
(:singular "s$" "")
(:singular "\\(n\\)ews$" "\\1ews")
(:singular "\\([ti]\\)a$" "\\1um")
(:singular "\\(\\(a\\)naly\\|\\(b\\)a\\|\\(d\\)iagno\\|\\(p\\)arenthe\\|\\(p\\)rogno\\|\\(s\\)ynop\\|\\(t\\)he\\)ses$" "\\1\\2sis")
(:singular "\\(^analy\\)ses$" "\\1sis")
(:singular "\\([^f]\\)ves$" "\\1fe")
(:singular "\\(hive\\)s$" "\\1")
(:singular "\\(tive\\)s$" "\\1")
(:singular "\\([lr]\\)ves$" "\\1f")
(:singular "\\([^aeiouy]\\|qu\\)ies$" "\\1y")
(:singular "\\(s\\)eries$" "\\1eries")
(:singular "\\(m\\)ovies$" "\\1ovie")
(:singular "\\(x\\|ch\\|ss\\|sh\\)es$" "\\1")
(:singular "\\([m\\|l]\\)ice$" "\\1ouse")
(:singular "\\(bus\\)es$" "\\1")
(:singular "\\(o\\)es$" "\\1")
(:singular "\\(shoe\\)s$" "\\1")
(:singular "\\(cris\\|ax\\|test\\)es$" "\\1is")
(:singular "\\(octop\\|vir\\)i$" "\\1us")
(:singular "\\(alias\\|status\\)es$" "\\1")
(:singular "^\\(ox\\)en" "\\1")
(:singular "\\(vert\\|ind\\)ices$" "\\1ex")
(:singular "\\(matr\\)ices$" "\\1ix")
(:singular "\\(quiz\\)zes$" "\\1")
(:irregular "stratum" "strate")
(:irregular "syllabus" "syllabi")
(:irregular "radius" "radii")
(:irregular "addendum" "addenda")
(:irregular "cactus" "cacti")
(:irregular "child" "children")
(:irregular "corpus" "corpora")
(:irregular "criterion" "criteria")
(:irregular "datum" "data")
(:irregular "genus" "genera")
(:irregular "man" "men")
(:irregular "medium" "media")
(:irregular "move" "moves")
(:irregular "person" "people")
(:irregular "man" "men")
(:irregular "child" "children")
(:irregular "sex" "sexes")
(:irregular "move" "moves")
(:uncountable "equipment" "information" "rice" "money" "species" "series" "fish" "sheep" "news"))
;;;###autoload
(defun singularize-string (str)
(when (stringp str)
(or (car (member str inflection-uncountables))
(caar (member* (downcase str) inflection-irregulars :key 'cadr :test 'equal))
(loop for (from to) in inflection-singulars
for singular = (string=~ from str (sub to))
when singular do (return singular))
str)))
;;;###autoload
(defun pluralize-string (str)
(when (stringp str)
(or (car (member str inflection-uncountables))
(cadar (member* (downcase str) inflection-irregulars :key 'car :test 'equal))
(loop for (from to) in inflection-plurals
for plurals = (string=~ from str (sub to))
when plurals do (return plurals))
str)))
;; Local Variables:
;; byte-compile-warnings: (not cl-functions)
;; End:
(provide 'inflections)
;;; inflections.el ends here

325
conf/emacs.d/rinari/util/jump/jump.el Normal file
View File

@ -0,0 +1,325 @@
;;; jump.el --- build functions which contextually jump between files
;; Copyright (C) 2008 Eric Schulte
;; Author: Eric Schulte
;; URL: http://github.com/eschulte/jump.el/tree/master
;; Version: DEV
;; Created: 2008-08-21
;; Keywords: project, convenience, navigation
;; Package-Requires: ((findr "0.7") (inflections "1.1"))
;; This file is NOT part of GNU Emacs.
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; This library is intended to aid in the construction of functions
;; for navigating projects. The `defjump' function using a hopefully
;; convenient specification schema which jumps to new file/methods
;; based upon the file/method context of the current buffer/point.
;; This effort was inspired heavily by find-file-in-project.el by Phil
;; Hagelberg and Doug Alcorn, and toggle.el by Ryan Davis. The
;; initial goal of jump.el was to subsume both of these tools.
;;; Example: (jumping to the related model in a rails application)
;; (defjump
;; 'rinari-find-model
;; '(("app/controllers/\\1_controller.rb#\\2" . "app/models/\\1.rb#\\2")
;; ("app/views/\\1/.*" . "app/models/\\1.rb")
;; ("app/helpers/\\1_helper.rb" . "app/models/\\1.rb")
;; ("db/migrate/.*create_\\1.rb" . "app/models/\\1.rb")
;; ("test/functional/\\1_controller_test.rb" . "app/models/\\1.rb")
;; ("test/unit/\\1_test.rb#test_\\2" . "app/models/\\1.rb#\\2")
;; ("test/unit/\\1_test.rb" . "app/models/\\1.rb")
;; ("test/fixtures/\\1.yml" . "app/models/\\1.rb")
;; (t . "app/models/"))
;; 'rinari-root
;; "Go to the most logical model given the current location."
;; '(lambda (path)
;; (message (shell-command-to-string
;; (format "ruby %sscript/generate model %s"
;; (rinari-root)
;; (and (string-match ".*/\\(.+?\\)\.rb" path)
;; (match-string 1 path))))))
;; 'ruby-add-log-current-method)
;;; Code:
(if (featurep 'xemacs)
(add-to-list 'load-path (file-name-as-directory (or load-file-name buffer-file-name))))
(require 'which-func)
(require 'findr)
(require 'inflections)
;; ido-mode must be defined (only an issue with Xemacs)
(unless (fboundp 'ido-mode) (defvar ido-mode nil))
(defvar jump-ignore-file-regexp ;; TODO actually start using this
"\\(.*\\.\\(git\\|svn\\|cvs\\).*\\|.*~\\|.*\\#.*\\#\\)"
"regexp for the find shell command to ignore undesirable files")
(defun jump-completing-read (prompt choices &optional predicate require-match initial-input hist def)
"if `ido-mode' is turned on use ido speedups completing the read"
(if ido-mode
(ido-completing-read prompt choices predicate require-match initial-input hist def)
(if (featurep 'xemacs)
(completing-read prompt (mapcar 'list choices) predicate require-match initial-input hist def)
(completing-read prompt choices predicate require-match initial-input hist def))))
(defun jump-find-file-in-dir (dir)
"if `ido-mode' is turned on use ido speedups finding the file"
(if (or (equal ido-mode 'file) (equal ido-mode 'both))
(ido-find-file-in-dir dir)
(let ((default-directory dir)) (call-interactively 'find-file))))
(defun jump-method ()
"Return the method defined at the current position in current
buffer."
(let ((func (funcall method-command)))
(or (and func (string-match "#\\(.+\\)" func) (match-string 1 func))
func)))
(defun jump-uniqueify (file-cons)
"Set the car of the argument to include the directory name plus the file name."
(setcar file-cons
(concat (car file-cons) " "
(cadr (reverse (split-string (cdr file-cons) "/"))))))
(defun jump-select-and-find-file (files)
"Select a single file from an alist of file names and paths.
Return the path selected or nil if files was empty."
(let ((file (case (length files)
(0 nil)
(1 (caar files))
(t (jump-completing-read "Jump to: "
(mapcar 'car files))))))
(if file (find-file (cdr (assoc file files))))))
(defun jump-remove-unwanted-files (files)
"Remove file matching `jump-ignore-file-regexp' from the list
of possible jumps."
(delete-if nil
(mapcar
(lambda (file-cons)
(unless (string-match jump-ignore-file-regexp (cdr file-cons))
file-cons))
files)))
(defun jump-to-file (&optional file)
"Open the file located at file if file ends in a / then look in
the related directory, and if file contains regexps then select
from all matches."
(interactive "Mfile: ")
(let ((file-cons (cons (file-name-nondirectory file) file))
file-alist)
(if (and (equal (file-name-directory file) file) (file-exists-p file))
(jump-find-file-in-dir (expand-file-name file root)) ;; open directory
(if (file-exists-p file)
(find-file file) ;; open file
(jump-select-and-find-file ;; open with regexp
(jump-remove-unwanted-files
(mapcar (lambda (file)
(let ((file-cons (cons (file-name-nondirectory file)
(expand-file-name file))))
(when (assoc (car file-cons) file-alist)
(jump-uniqueify (assoc (car file-cons) file-alist))
(jump-uniqueify file-cons))
(add-to-list 'file-alist file-cons)
file-cons))
(let ((dir (expand-file-name
(or (file-name-directory (cdr file-cons)) "")
root)))
(when (and (file-exists-p dir) (file-directory-p dir))
(findr (car file-cons)
(expand-file-name
(or (file-name-directory
(cdr file-cons)) "") root)))))))))))
(defun jump-to-method (&optional method)
"If `jump-method' returns method in buffer, go to the first
line inside of method."
(interactive "Mmethod: ")
(goto-char (point-min))
(let (results)
(while (not (setf results
(or (string-equal (jump-method) method)
(and (> (forward-line 1) 0)
(goto-char (point-min)))))))
(when (and (commandp 'recenter-top-bottom) (not (equal results 1))) (recenter-top-bottom))))
(defun jump-to-path (path)
"Jump to the location specified by PATH (regexp allowed in
path). If path ends in / then just look in that directory"
(let ((file path)
method)
(when (string-match "^\\(.*\\)#\\(.*\\)$" path)
(setf method (match-string 2 path))
(setf file (match-string 1 path)))
(when (jump-to-file file) ;; returns t as long as a file was found
(when method (jump-to-method method))
t)))
(defun jump-insert-matches (spec matches)
(if matches
(let ((count 1) (new-spec spec) (spec nil))
(while (not (equal spec new-spec))
(setf spec new-spec)
(setf new-spec
(replace-regexp-in-string (format "\\\\%d" count)
(or (nth (- count 1) matches) ".*?")
spec))
(setf count (+ 1 count)))
new-spec) spec))
(defun jump-inflections (terms)
"Return all combinations of the singular and pluralizations of TERMS."
(let ((terms (mapcar
(lambda (term)
(delete-dups (list term
(singularize-string term)
(pluralize-string term))))
terms))
results interum-results)
(dolist (group terms)
(dolist (term group)
(if results
(dolist (combination results)
(setf interum-results (cons
(cons term combination)
interum-results)))
(setf interum-results (cons (list term) interum-results))))
(setf results interum-results)
(setf interum-results nil))
(mapcar 'reverse results)))
(defun jump-to-all-inflections (spec matches)
(let (status) ;; TODO maybe try file first and method second
(loop for path in (mapcar (lambda (option)
(jump-insert-matches spec option))
(jump-inflections matches))
until (setf status (jump-to-path path)))
status))
(defun jump-to (spec &optional matches make)
"Jump to a spot defined by SPEC. If optional argument MATCHES
replace all '\\n' portions of SPEC with the nth (1 indexed)
element of MATCHES. If optional argument MAKE, then create the
target file if it doesn't exist, if MAKE is a function then use
MAKE to create the target file."
(if (functionp spec) (eval (list spec matches)) ;; custom function in spec
(let ((path (jump-insert-matches spec matches)))
(if (not (or (jump-to-path path)
(and matches (jump-to-all-inflections spec matches))))
(when make (message (format "making %s" path))
(let ((path (if (or (string-match "^\\(.*?\\)\\.\\*" path)
(string-match "^\\(.*/\\)$" path))
(read-from-minibuffer "create " (match-string 1 path))
path)))
(when (functionp make) (eval (list make path)))
(find-file (concat root (if (string-match "^\\(.*\\)#" path)
(match-string 1 path) path)))))
t))))
(defun jump-from (spec)
"Match SPEC to the current location returning a list of any matches"
(cond ((stringp spec)
(let* ((file (or (and (buffer-file-name)
(expand-file-name (buffer-file-name)))
(buffer-name)))
(method (jump-method))
(path (if (string-match "#.+" spec)
(concat file "#" method)
file)))
(and (string-match spec path)
(or (let ((counter 1) mymatch matches)
(while (setf mymatch (match-string counter path))
(setf matches (cons mymatch matches))
(setf counter (+ 1 counter)))
(reverse matches)) t))))
((functionp spec) (eval (list spec)))
((equal t spec) t)
(t (message (format "unrecognized jump-from specification format %s" spec)))))
;;;###autoload
(defmacro defjump (name specs root &optional doc make method-command)
"Define NAME as a function with behavior determined by SPECS.
SPECS should be a list of cons cells of the form
(jump-from-spec . jump-to-spec)
NAME will then try subsequent jump-from-specs until one succeeds,
at which point any resulting match information, along with the
related jump-to-spec will be used to jump to the intended buffer.
See `jump-to' and `jump-from' for information on spec
construction.
ROOT should specify the root of the project in which all jumps
take place, it can be either a string directory path, or a
function returning
Optional argument DOC specifies the documentation of the
resulting function.
Optional argument MAKE can be used to specify that missing files
should be created. If MAKE is a function then it will be called
with the file path as it's only argument. After possibly calling
MAKE `find-file' will be used to open the path.
Optional argument METHOD-COMMAND overrides the function used to
find the current method which defaults to `which-function'."
`(defun ,name (&optional create)
,(concat doc "\n\nautomatically created by `defjump'")
(interactive "P")
(let ((root ,(if (functionp root) `(,root) root))
(method-command ,(or method-command 'which-function))
matches)
(loop ;; try every rule in mappings
for spec in (quote ,(mapcar
(lambda (spec)
(if (stringp (car spec))
;;xemacs did not understand :digit: class
(if (featurep 'xemacs)
(cons (replace-regexp-in-string
"\\\\[0-9]+" "\\\\(.*?\\\\)"
(car spec)) (cdr spec))
(cons (replace-regexp-in-string
"\\\\[[:digit:]]+" "\\\\(.*?\\\\)"
(car spec)) (cdr spec)))
spec))
specs))
;; don't stop until both the front and the back match
;;
;; the back should match if the user is presented with a list
;; of files, or a single file is jumped to
until
(and (setf matches (jump-from (car spec)))
(cond
((equal t matches)
(jump-to (cdr spec) nil (when create ,make)))
((consp matches)
(jump-to (cdr spec) matches (when create ,make)))))))))
;; Local Variables:
;; byte-compile-warnings: (not cl-functions)
;; End:
(provide 'jump)
;;; jump.el ends here

338
conf/emacs.d/rinari/util/jump/test/elunit.el Normal file
View File

@ -0,0 +1,338 @@
;;; elunit.el --- Emacs Lisp Unit Testing framework
;; Copyright (C) 2006 - 2007 Phil Hagelberg
;; Author: Phil Hagelberg
;; URL: http://www.emacswiki.org/cgi-bin/wiki/ElUnit
;; Keywords: unit test tdd
;; EmacsWiki: ElUnit
;; This file is NOT part of GNU Emacs.
;; Last-Updated: Fri Nov 16 16:23:06 2007 PST
;; By: Phil Hagelberg
;; Update #: 1
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Inspired by regress.el by Wayne Mesard and Tom Breton, Test::Unit
;; by Nathaniel Talbott, and xUnit by Kent Beck
;; ElUnit exists to accomodate test-driven development of Emacs Lisp
;; programs. Tests are divided up into suites. Each test makes a
;; number of assertions to ensure that things are going according to
;; expected.
;; Tests are divided into suites for the purpose of hierarchical
;; structure and hooks. The hierarchy allows suites to belong to
;; suites, in essence creating test trees. The hooks are meant to
;; allow for extra setup that happens once per test, for both before
;; and after it runs.
;; The file `elunit-assertions.el' provides a number of helpful
;; assertions for ensuring that things are going properly. You may use
;; Emacs' built-in `assert' function for checking such things, but the
;; assertions in that file provide much better reporting if you use
;; them. Using `assert-that' is preferred over built-in `assert'.
;;; Todo:
;; * more helper functions, specifically for more functional-test stuff.
;;; Usage:
;; See http://www.emacswiki.org/cgi-bin/wiki/ElUnit for discussion and usage.
;; The file `elunit-test.el' contains meta-tests that you may find helpful
;; to refer to as samples.
;; Add the lines:
;; (make-local-variable 'after-save-hook)
;; (add-hook 'after-save-hook (lambda () (elunit "meta-suite")))
;; to the file containing your tests for convenient auto-running.
;;; Code:
(eval-when-compile
(require 'cl)
(require 'compile))
(defstruct test-suite name children tests setup-hook teardown-hook)
(defstruct test name body file line message problem)
(put 'elunit-test-failed 'error-conditions '(failure))
(defvar elunit-default-suite
"default-suite"
"Choice to use for default suite to run (gets updated to last suite run).")
(defvar elunit-suites (list (make-test-suite :name 'default-suite))
"A list of every suite that's been defined.")
(defvar elunit-test-count 0)
(defvar elunit-failures nil
"A list of tests that have failed.")
(defvar elunit-done-running-hook nil
"Runs when the tests are finished; passed a total test count and a failure count.")
(defun elunit-clear-suites ()
"Reset the internal suite list."
(interactive)
(setq elunit-suites (list (make-test-suite :name 'default-suite))))
;;; Defining tests
(defmacro* defsuite (suite-name suite-ancestor &key setup-hook teardown-hook)
"Define a suite, which may be hierarchical."
`(let ((suite (make-test-suite :name ',suite-name
:setup-hook ,setup-hook :teardown-hook ,teardown-hook)))
(elunit-delete-suite ',suite-name)
(if ',suite-ancestor
(push suite (test-suite-children (elunit-get-suite ',suite-ancestor))))
(add-to-list 'elunit-suites suite)))
(defun elunit-get-suite (suite)
"Fetch a SUITE by its name."
(if (test-suite-p suite)
suite
(find suite elunit-suites :test (lambda (suite asuite)
(equal suite (test-suite-name asuite))))))
(defun elunit-delete-suite (name)
"Remove a suite named `NAME'."
(setq elunit-suites (remove (elunit-get-suite name) elunit-suites)))
(defmacro deftest (name suite &rest body)
"Define a test `NAME' in `SUITE' with `BODY'."
(save-excursion
(search-backward (symbol-name name) nil t)
(let ((line (line-number-at-pos))
(file buffer-file-name)
(suite-sym (gensym)))
`(let ((,suite-sym (elunit-get-suite ',suite)))
;; not a foolproof heuristic to get line number, but good enough.
(elunit-delete-test ',name ,suite-sym)
(push (make-test :name ',name :body (lambda () ,@body)
:file ,file :line ,line)
(test-suite-tests ,suite-sym))))))
(defun elunit-get-test (name suite)
"Return a test given a name and suite."
(if (test-p name) name
(find name (test-suite-tests (elunit-get-suite suite))
:test (lambda (name test) (equal name (test-name test))))))
(defun elunit-delete-test (name suite)
"Delete a test."
(let ((suite (elunit-get-suite suite)))
(setf (test-suite-tests suite)
(delete (elunit-get-test name suite) (test-suite-tests suite)))))
(defun elunit-total-test-count (suite)
"Return the total number of tests in a suite."
(let ((suite (elunit-get-suite suite)))
(if suite
(+ (apply #'+ (elunit-total-test-count (test-suite-children suite)))
(length (test-suite-tests suite))))))
(defun elunit-test-docstring (test)
"Return a test's docstring."
(if (equal (car (test-body test)) 'lambda)
(if (stringp (caddr (test-body test)))
(caddr (test-body test))
"")))
;;; Running the tests
(defun elunit (suite)
"Ask for a single suite, run all its tests, and display the results."
(interactive (list (completing-read (concat "Run test suite (default " elunit-default-suite "): " )
(mapcar (lambda (suite) (symbol-name (test-suite-name suite)))
elunit-suites) nil t nil nil elunit-default-suite)))
(setq elunit-default-suite suite)
(setq elunit-test-count 0)
(setq elunit-failures nil)
(with-output-to-temp-buffer "*elunit*"
(switch-to-buffer "*elunit*")
(compilation-minor-mode)
(switch-to-buffer nil)
(princ (concat "Loaded suite: " suite "\n\n"))
(let ((start-time (cadr (current-time))))
(elunit-run-suite (elunit-get-suite (intern suite)))
(princ (format "\n\n%d tests with %d failures in %d seconds."
elunit-test-count (length elunit-failures)
(- (cadr (current-time)) start-time))))
(elunit-report-failures)))
(defun elunit-run-suite (suite)
"Run a suite's tests and children."
(dolist (test (reverse (test-suite-tests suite)))
(if (test-suite-setup-hook suite) (funcall (test-suite-setup-hook suite)))
(elunit-run-test test)
(if (test-suite-teardown-hook suite) (funcall (test-suite-teardown-hook suite))))
(dolist (child-suite (test-suite-children suite))
(elunit-run-suite child-suite))
(run-hook-with-args 'elunit-done-running-hook elunit-test-count (length elunit-failures)))
(defun elunit-run-test (test)
"Run a single test."
(condition-case err
(progn
(incf elunit-test-count)
(funcall (test-body test))
(princ "."))
(failure
(elunit-failure test err "F"))
(error
(elunit-failure test err "E"))))
(defun elunit-failure (test err output)
"Display and store failure info."
(princ output)
(setf (test-problem test) err)
;; color overlays are GNU-only IIRC
(unless (featurep 'xemacs)
(switch-to-buffer "*elunit*")
(overlay-put (make-overlay (point) (- (point) 1)) 'face '(foreground-color . "red"))
(switch-to-buffer nil))
(setf (test-message test) err)
(push test elunit-failures))
(defun elunit-report-failures ()
"Summarize failures."
(let ((count 0))
(dolist (test elunit-failures)
(incf count)
(princ (format "\n\n%d) %s %s [%s:%s]
%s
Message: %s
Form: %s" count
(if (equal (car (test-problem test)) 'elunit-test-failed)
"Failure:" " Error:")
(test-name test) (test-file test) (test-line test)
(elunit-test-docstring test) (pp-to-string (test-message test))
(pp-to-string (test-body test)))))))
(add-to-list 'compilation-error-regexp-alist '("\\[\\([^\]]*\\):\\([0-9]+\\)\\]" 1 2))
;;; Helper functions
(defmacro with-test-buffer (&rest body)
"Execute BODY in a test buffer named `*elunit-output*'."
`(save-excursion
(switch-to-buffer "*elunit-output*")
,@body
(kill-buffer "*elunit-output*")))
(defun elunit-quiet (suite)
"Run a suite and display results in the minibuffer."
(interactive (list (completing-read (concat "Run test suite (default " elunit-default-suite "): " )
(mapcar (lambda (suite) (symbol-name (test-suite-name suite)))
elunit-suites) nil t nil nil elunit-default-suite)))
(save-window-excursion
(elunit suite))
(message "%d tests with %d failures" elunit-test-count (length elunit-failures)))
;; TODO: font-lock deftest and defsuite
;; do this too? (put 'defsuite 'lisp-indent-function 1)
(defun fail (&rest args)
"Like `error', but reported differently."
(signal 'elunit-test-failed (list (apply 'format args))))
;;; General assertions
;; These are preferred over stuff like (assert (equal [...] because
;; they use the `fail' function, which reports errors nicely.
(defun assert-that (actual)
(unless actual
(fail "%s expected to be non-nil" actual)))
(defun assert-nil (actual)
(when actual
(fail "%s expected to be nil" actual)))
(defun assert-equal (expected actual)
(unless (equal expected actual)
(fail "%s expected to be %s" actual expected)))
(defun assert-not-equal (expected actual)
(when (equal expected actual)
(fail "%s expected to not be %s" actual expected)))
(defun assert-member (elt list)
(unless (member elt list)
(fail "%s expected to include %s" list elt)))
(defun assert-match (regex string)
(unless (string-match regex string)
(fail "%s expected to match %s" string regex)))
(defmacro assert-error (&rest body)
`(condition-case err
(progn
,@body
(fail "%s expected to signal an error" body))
(error t)))
(defmacro assert-changed (form &rest body)
`(assert-not-equal (eval ,form)
(progn
,@body
(eval ,form))))
(defmacro assert-not-changed (form &rest body)
`(assert-equal (eval ,form)
(progn
,@body
(eval ,form))))
;; Buffer-specific assertions
(defun assert-in-buffer (target &optional buffer)
(save-window-excursion
(if buffer (switch-to-buffer buffer))
(goto-char (point-min))
(unless (search-forward target nil t)
(fail "%s expected to be found in buffer %s" target buffer))))
(defun assert-background (target face &optional buffer)
(save-window-excursion
(if buffer (switch-to-buffer buffer))
(goto-char (point-min))
(unless (search-forward target nil t)
(fail "%s expected to be found in buffer %s" target buffer))
(unless (equal (face (get-text-property (point) 'background)))
(fail "%s expected to be displayed with face %s" target face))))
(defun assert-overlay (pos)
(unless (overlays-at pos)
(fail "Expected overlay at position %d" pos)))
(defun assert-no-overlay (pos)
(if (overlays-at pos)
(fail "Expected no overlay at position %d" pos)))
(provide 'elunit)
;;; elunit.el ends here

107
conf/emacs.d/rinari/util/jump/test/init.el Normal file
View File

@ -0,0 +1,107 @@
(cd (file-name-directory (or load-file-name buffer-file-name)))
(add-to-list 'load-path "../")
(add-to-list 'load-path "./")
(add-to-list 'load-path "~/emacs/elisp/ruby/")
(require 'jump)
(require 'elunit)
(require 'ido)
(require 'ruby-mode)
(ido-mode t)
;;--------------------------------------------------------------------------------
;; test suite
(defsuite jump-suite nil
:setup-hook (lambda ()
(setq
root "~/projects/jump/test/jump-fake-app/"
default-directory "~/projects/jump/test/jump-fake-app/"
method-command 'ruby-add-log-current-method
jump-method-placements
'(("foods/pork.rb" "cook_stomach" 32)
("foods/pork.rb" "cook_butt" 69)
("foods/pork.rb" "cook_outer_back" 117)
("foods/pork.rb" "cook_inner_back" 163))
jump-path-regexps
'(("pork.rb" "foods/pork.rb")
("pork.rb" "foods/")
("pork.rb" "foods/.*")
("pig.rb" "animals/pig.rb")
("pig.rb" "animals/.*g.rb")
("pig.rb" ".*/pig.rb")
("chicken.rb" "animals/chicken.rb")
("chicken.rb" "animals/........rb")
("chicken.rb" "animals/chi.+.rb"))
jump-full-paths
'(("foods/pork.rb#cook_butt" "pork.rb" 69)
("foods/.*#cook_outer_back" "pork.rb" 117)
("animals/.*g.rb#inner_back" "pig.rb" 203)
("animals/chi.+.rb#gizzards" "chicken.rb" 33))))
:teardown-hook (lambda ()
(switch-to-buffer "*Messages*")
(message "test completed")))
;;--------------------------------------------------------------------------------
;; tests
(deftest jump-to-file-test jump-suite ;; test failing but method seems to work
(message "testing that jump-to-file lands in the correct file")
(flet ((check-file-after-jump (file regexp)
(message (format "%s =~ %s" file regexp))
(jump-to-file regexp)
(assert-equal
(file-name-nondirectory buffer-file-name)
file)
(kill-buffer file)))
(check-file-after-jump "chicken.rb" "animals/........rb")
(check-file-after-jump "chicken.rb" ".*ck.*")
(check-file-after-jump "pig.rb" "^...\.rb")
(check-file-after-jump "pig.rb" ".*g\.rb")
(check-file-after-jump "pork.rb" "foods/.*\.rb")))
(deftest jump-method-test jump-suite
(message "testing that jump-method returns the correct method")
(flet ((check-method-at-place (file method target)
(find-file file)
(goto-char target)
(assert-equal (jump-method) method)
(message (format "%s" (thing-at-point 'line)))
(kill-buffer (file-name-nondirectory file))))
(mapcar (lambda (el)
(apply 'check-method-at-place el))
jump-method-placements)))
(deftest jump-to-method-test jump-suite
(message "testing jump-to-method")
(flet ((jump-and-check (file method target)
(find-file file)
(jump-to-method method)
(assert-equal target (point))
(message (format "%s" (thing-at-point 'line)))
(kill-buffer (file-name-nondirectory file))))
(mapcar (lambda (el)
(apply 'jump-and-check el))
jump-method-placements)))
(deftest jump-to-path-test jump-suite
(message "testing jump-to-path")
(flet ((jump-to-path-and-check (path file target)
(jump-to-path path)
(assert-equal
(file-name-nondirectory buffer-file-name)
file)
(assert-equal target (point))
(kill-buffer (file-name-nondirectory file))))
(mapcar (lambda (el)
(apply 'jump-to-path-and-check el))
jump-full-paths)))
(deftest jump-from-function-test jump-suite
(message "testing jumping from a function specification")
(assert-equal
(jump-from (lambda ()
'("pork")))
'("pork")))
;;--------------------------------------------------------------------------------
;; run tests
(elunit "jump-suite")

7
conf/emacs.d/rinari/util/jump/test/jump-fake-app/animals/chicken.rb Normal file
View File

@ -0,0 +1,7 @@
class Chicken
def gizzards
end
end

19
conf/emacs.d/rinari/util/jump/test/jump-fake-app/animals/pig.rb Normal file
View File

@ -0,0 +1,19 @@
class Pig
def stomach
puts "bacon comes from my belly"
end
def butt
puts "ham comes from my butt"
end
def outer_back
puts "my back has backfatt"
end
def inner_back
puts "my back can be cut into chops"
end
end

19
conf/emacs.d/rinari/util/jump/test/jump-fake-app/foods/pork.rb Normal file
View File

@ -0,0 +1,19 @@
class Pork
def cook_stomach
# so much
end
def cook_butt
# good stuff
end
def cook_outer_back
# from one
end
def cook_inner_back
# poor animal
end
end

32
conf/emacs.d/rinari/util/ruby-compilation-rspec.el Normal file
View File

@ -0,0 +1,32 @@
;; Add rspec support to ruby-compilation
;;
;; rspec will run with the -l <line_number> option, so that we can
;; run multiple tests in a context if that's where the point happens
;; to be.
;;
(require 'ruby-compilation)
(add-hook 'ruby-mode-hook (lambda ()
(when (and (not (null buffer-file-name)) (string-match "_spec.rb$" buffer-file-name))
(set (make-local-variable 'ruby-compilation-executable)
(file-name-nondirectory
(or (executable-find "rspec")
(executable-find "spec"))))
(set (make-local-variable 'ruby-compilation-test-name-flag)
"-l"))))
(fset 'ruby-compilation-this-test-name-old
(symbol-function 'ruby-compilation-this-test-name))
(defun ruby-compilation-this-test-name ()
(if (string-match "^r?spec$" ruby-compilation-executable)
(ruby-compilation-this-spec-name)
(ruby-compilation-this-test-name-old)))
(defun ruby-compilation-this-spec-name ()
"Return the line number at point"
(number-to-string (line-number-at-pos)))
(provide 'ruby-compilation-rspec)

356
conf/emacs.d/rinari/util/ruby-compilation.el Normal file
View File

@ -0,0 +1,356 @@
;;; ruby-compilation.el --- run a ruby process in a compilation buffer
;; Copyright (C) 2008 Eric Schulte
;; Author: Eric Schulte
;; URL: https://github.com/eschulte/rinari
;; Version: 0.17
;; Created: 2008-08-23
;; Keywords: test convenience
;; Package-Requires: ((inf-ruby "2.2.1"))
;;; License:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Allow for execution of ruby processes dumping the results into a
;; compilation buffer. Useful for executing tests, or rake tasks
;; where the ability to jump to errors in source code is desirable.
;;
;; The functions you will probably want to use are
;;
;; ruby-compilation-run
;; ruby-compilation-rake
;; ruby-compilation-this-buffer (C-x t)
;; ruby-compilation-this-test (C-x T)
;;
;;; TODO:
;; Clean up function names so they use a common prefix.
;; "p" doesn't work at the end of the compilation buffer.
;;; Code:
(require 'ansi-color)
(require 'pcomplete)
(require 'compile)
(require 'inf-ruby)
(require 'which-func)
(defvar ruby-compilation-error-regexp
"^\\([[:space:]]*\\|.*\\[\\|[^\*].*at \\)\\[?\\([^[:space:]]*\\):\\([[:digit:]]+\\)[]:)\n]?"
"Regular expression to match errors in ruby process output.")
(defvar ruby-compilation-error-regexp-alist
`((,ruby-compilation-error-regexp 2 3))
"A version of `compilation-error-regexp-alist' for use in rails logs.
Should be used with `make-local-variable'.")
(defvar ruby-compilation-executable "ruby"
"What bin to use to launch the tests. Override if you use JRuby etc.")
(defvar ruby-compilation-executable-rake "rake"
"What bin to use to launch rake. Override if you use JRuby etc.")
(defvar ruby-compilation-test-name-flag "-n"
"What flag to use to specify that you want to run a single test.")
(defvar ruby-compilation-clear-between t
"Whether to clear the compilation output between runs.")
(defvar ruby-compilation-reuse-buffers t
"Whether to re-use the same comint buffer for focussed tests.")
;;; Core plumbing
(defun ruby-compilation--adjust-paths (beg end)
(save-excursion
(goto-char beg)
(while (re-search-forward "\\(^[\t ]+\\|\\[\\)/test" end t)
(replace-match "\\1test"))))
(defun ruby-compilation-filter ()
"Filter function for compilation output."
(save-excursion
(forward-line 0)
(let ((end (point)) beg)
(goto-char compilation-filter-start)
(forward-line 0)
(setq beg (point))
;; Only operate on whole lines so we don't get caught with part of an
;; escape sequence in one chunk and the rest in another.
(when (< (point) end)
(setq end (copy-marker end))
(ansi-color-apply-on-region beg end)
(ruby-compilation--adjust-paths beg end)))))
(defvar ruby-compilation--buffer-name nil
"Used to store compilation name so recompilation works as expected.")
(make-variable-buffer-local 'ruby-compilation--buffer-name)
(defun ruby-compilation--kill-any-orphan-proc ()
"Ensure any dangling buffer process is killed."
(let ((orphan-proc (get-buffer-process (buffer-name))))
(when orphan-proc
(kill-process orphan-proc))))
(define-compilation-mode ruby-compilation-mode "RubyComp"
"Ruby compilation mode."
(progn
(set (make-local-variable 'compilation-error-regexp-alist) ruby-compilation-error-regexp-alist)
(add-hook 'compilation-filter-hook 'ruby-compilation-filter nil t)
;; Set any bound buffer name buffer-locally
(setq ruby-compilation--buffer-name ruby-compilation--buffer-name)
(set (make-local-variable 'kill-buffer-hook)
'ruby-compilation--kill-any-orphan-proc)))
;; Low-level API entry point
(defun ruby-compilation-do (name cmdlist)
"In a buffer identified by NAME, run CMDLIST in `ruby-compilation-mode'.
Returns the compilation buffer."
(save-some-buffers (not compilation-ask-about-save)
(when (boundp 'compilation-save-buffers-predicate)
compilation-save-buffers-predicate))
(let* ((this-dir default-directory)
(ruby-compilation--buffer-name (concat "*" name "*"))
(existing-buffer (get-buffer ruby-compilation--buffer-name)))
(when existing-buffer (with-current-buffer existing-buffer
(setq default-directory this-dir)))
(with-current-buffer
(compilation-start
(concat (car cmdlist) " "
(mapconcat 'shell-quote-argument (cdr cmdlist) " "))
'ruby-compilation-mode
(lambda (b) ruby-compilation--buffer-name)))))
(defun ruby-compilation--skip-past-errors (line-incr)
"Repeatedly move LINE-INCR lines forward until the current line is not an error."
(while (string-match ruby-compilation-error-regexp (thing-at-point 'line))
(forward-line line-incr)))
(defun ruby-compilation-previous-error-group ()
"Jump to the start of the previous error group in the current compilation buffer."
(interactive)
(compilation-previous-error 1)
(ruby-compilation--skip-past-errors -1)
(forward-line 1)
(recenter))
(defun ruby-compilation-next-error-group ()
"Jump to the start of the previous error group in the current compilation buffer."
(interactive)
(ruby-compilation--skip-past-errors 1)
(compilation-next-error 1)
(recenter))
(defvar ruby-compilation-minor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "q" 'quit-window)
(define-key map "p" 'previous-error-no-select)
(define-key map "n" 'next-error-no-select)
(define-key map "\M-p" 'ruby-compilation-previous-error-group)
(define-key map "\M-n" 'ruby-compilation-next-error-group)
(define-key map (kbd "C-c C-c") 'comint-interrupt-subjob)
map)
"Key map for Ruby Compilation minor mode.")
(define-minor-mode ruby-compilation-minor-mode
"Enable Ruby Compilation minor mode providing some key-bindings
for navigating ruby compilation buffers."
nil
" ruby:comp"
ruby-compilation-minor-mode-map
(when ruby-compilation-clear-between
(delete-region (point-min) (point-max))))
;; So we can invoke it easily.
;;;###autoload
(eval-after-load 'ruby-mode
'(progn
(define-key ruby-mode-map (kbd "C-x t") 'ruby-compilation-this-buffer)
(define-key ruby-mode-map (kbd "C-x T") 'ruby-compilation-this-test)))
;; So we don't get warnings with .dir-settings.el files
(dolist (executable (list "jruby" "rbx" "ruby1.9" "ruby1.8" "ruby"))
(add-to-list 'safe-local-variable-values
(cons 'ruby-compilation-executable executable)))
;;; Basic public interface
;;;###autoload
(defun ruby-compilation-run (cmd &optional ruby-options name)
"Run CMD using `ruby-compilation-executable' in a ruby compilation buffer.
Argument RUBY-OPTIONS can be used to specify additional
command line args for ruby. If supplied, NAME will be used in
place of the script name to construct the name of the compilation
buffer."
(interactive "FRuby Comand: ")
(let ((name (or name (file-name-nondirectory (car (split-string cmd)))))
(cmdlist (append (list ruby-compilation-executable)
ruby-options
(split-string (expand-file-name cmd)))))
(pop-to-buffer (ruby-compilation-do name cmdlist))))
;;;###autoload
(defun ruby-compilation-this-buffer ()
"Run the current buffer through Ruby compilation."
(interactive)
(ruby-compilation-run (buffer-file-name)))
;;; Special handling for rake and capistrano
(defun ruby-compilation-extract-output-matches (command pattern)
"Run COMMAND, and return all the matching strings for PATTERN."
(delq nil (mapcar #'(lambda(line)
(when (string-match pattern line)
(match-string 1 line)))
(split-string (shell-command-to-string command) "[\n]"))))
(defun ruby-compilation--format-env-vars (pairs)
"Convert PAIRS of (name . value) into a list of name=value strings."
(mapconcat (lambda (pair)
(format "%s=%s" (car pair) (cdr pair)))
pairs " "))
(defun pcmpl-rake-tasks ()
"Return a list of all the rake tasks defined in the current projects."
(ruby-compilation-extract-output-matches "rake -T" "rake \\([^ ]+\\)"))
;;;###autoload
(defun pcomplete/rake ()
"Start pcompletion using the list of available rake tasks."
(pcomplete-here (pcmpl-rake-tasks)))
;;;###autoload
(defun ruby-compilation-rake (&optional edit task env-vars)
"Run a rake process dumping output to a ruby compilation buffer.
If EDIT is t, prompt the user to edit the command line. If TASK
is not supplied, the user will be prompted. ENV-VARS is an
optional list of (name . value) pairs which will be passed to rake."
(interactive "P")
(let* ((task (concat
(or task (if (stringp edit) edit)
(completing-read "Rake: " (pcmpl-rake-tasks)))
" "
(ruby-compilation--format-env-vars env-vars)))
(rake-args (if (and edit (not (stringp edit)))
(read-from-minibuffer "Edit Rake Command: " (concat task " "))
task)))
(pop-to-buffer (ruby-compilation-do
"rake" (cons ruby-compilation-executable-rake
(split-string rake-args))))))
(defun pcmpl-cap-tasks ()
"Return a list of all the cap tasks defined in the current project."
(ruby-compilation-extract-output-matches "cap -T" "cap \\([^ ]+\\)"))
;;;###autoload
(defun pcomplete/cap ()
"Start pcompletion using the list of available capistrano tasks."
(pcomplete-here (pcmpl-cap-tasks)))
;;;###autoload
(defun ruby-compilation-cap (&optional edit task env-vars)
"Run a capistrano process dumping output to a ruby compilation buffer.
If EDIT is t, prompt the user to edit the command line. If TASK
is not supplied, the user will be prompted. ENV-VARS is an
optional list of (name . value) pairs which will be passed to
capistrano."
(interactive "P")
(let* ((task (concat
(or task
(when (stringp edit) edit)
(completing-read "Cap: " (pcmpl-cap-tasks)))
" "
(ruby-compilation--format-env-vars env-vars)))
(cap-args (if (and edit (not (stringp edit)))
(read-from-minibuffer "Edit Cap Command: " (concat task " "))
task)))
(if (string-match "shell" task)
(with-current-buffer (run-ruby (concat "cap " cap-args) "cap")
(dolist (var '(inf-ruby-first-prompt-pattern inf-ruby-prompt-pattern))
(set (make-local-variable var) "^cap> ")))
(progn ;; handle all cap commands aside from shell
(pop-to-buffer (ruby-compilation-do "cap" (cons "cap" (split-string cap-args))))
(ruby-capistrano-minor-mode) ;; override some keybindings to make interaction possible
(push (cons 'ruby-capistrano-minor-mode ruby-capistrano-minor-mode-map)
minor-mode-map-alist)))))
(defvar ruby-capistrano-minor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "n" 'self-insert-command)
(define-key map "p" 'self-insert-command)
(define-key map "q" 'self-insert-command)
(define-key map [return] 'comint-send-input) map)
"Key map for Ruby Capistrano minor mode.")
(define-minor-mode ruby-capistrano-minor-mode
"Enable Ruby Compilation minor mode providing some key-bindings
for navigating ruby compilation buffers."
nil
" capstrano"
ruby-capistrano-minor-mode-map)
;;; Running tests
(defun ruby-compilation-this-test-buffer-name (test-name)
"The name of the buffer in which test-at-point will run TEST-NAME."
(interactive)
(if ruby-compilation-reuse-buffers
(file-name-nondirectory (buffer-file-name))
(format "ruby: %s - %s"
(file-name-nondirectory (buffer-file-name))
test-name)))
(defun ruby-compilation-this-test-name ()
"Return the name of the test at point."
(let ((this-test (which-function)))
(when (listp this-test)
(setq this-test (car this-test)))
(if (or (not this-test)
(not (string-match "#test_" this-test)))
(message "Point is not in a test.")
(cadr (split-string this-test "#")))))
;;;###autoload
(defun ruby-compilation-this-test ()
"Run the test at point through Ruby compilation."
(interactive)
(let ((test-name (ruby-compilation-this-test-name)))
(pop-to-buffer (ruby-compilation-do
(ruby-compilation-this-test-buffer-name test-name)
(list ruby-compilation-executable
(buffer-file-name)
ruby-compilation-test-name-flag test-name)))))
(provide 'ruby-compilation)
;; Local Variables:
;; coding: utf-8
;; indent-tabs-mode: nil
;; eval: (checkdoc-minor-mode 1)
;; End:
;;; ruby-compilation.el ends here

22
conf/emacs.d/rinari/util/test/ert/TODO Normal file
View File

@ -0,0 +1,22 @@
= TODO for ERT
short-term:
* Manual (texinfo)
** Install the manual upon compilation?
** Publish the manual as HTML
* Port over some mode-unit assertions
** assert-face-at-point
** assert-overlay
** assert-font-lock
* Results buffer maybe shouldn't begin with a space?
* What's the purpose of empty arg list in ert-deftest?
* Any way to make ert-deftest only increase indentation by 2?
* Automated buffer-management
* Visualize test results as overlays
* Add `skip' feature for tests that can't run in current environment
long-term:
* Submit to GNU Emacs
* Functions to deal with subprocesses

99
conf/emacs.d/rinari/util/test/ert/ert-functional.el Normal file
View File

@ -0,0 +1,99 @@
;;; ert-functional.el --- Functional Emacs Lisp Regression Testing Helpers
;; Copyright (C) 2008 Phil Hagelberg
;; Author: Phil Hagelberg
;; Version: 0.2
;; Keywords: lisp, tools
;; This file is NOT part of GNU Emacs.
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see `http://www.gnu.org/licenses/'.
;;; Commentary:
;; This file includes some extra higher-level helper functions to use
;; while writing automated tests with ert.el. This includes extra
;; predicates and buffer-management functions.
;; For the purposes of ERT, unit tests are defined as tests that just
;; check return values, and functional tests are anything higher-level
;; than that.
;; Since it is not meant to be loaded during normal use, this file
;; includes functions that are not prefixed for readability's sake.
;;; Code:
(defmacro buffer-changes-p (&rest body)
"Return t if the body changes the buffer contents."
`(let ((buffer-changed-init-value (buffer-string)))
(unwind-protect (progn ,@body)
(string= buffer-changed-init-value
(buffer-string)))))
(defun buffer-contains-p (regexp &optional buffer)
"Return t if contents of buffer (defaults to current) matches regexp."
(save-excursion
(if buffer (switch-to-buffer buffer))
(not (not (search-forward-regexp regexp nil t)))))
(defun correctly-indented-p (filename)
"Returns t if the buffer is already indented the way Emacs would indent it."
(save-excursion
(find-file filename)
(let ((buffer-original-indentation (buffer-string))
(kill-buffer-query-functions nil))
(indent-region (point-min) (point-max))
(let ((buffer-new-indentation (buffer-string)))
(revert-buffer nil t)
(kill-buffer nil)
(string= buffer-original-indentation buffer-new-indentation)))))
(defun ert-test-buffer-substitute (string fn)
"Removes the all occurrences of STRING in the buffer
and runs FN with at that point each one is removed.
Backslash-escaped STRINGs are unescaped and ignored."
(let ((len (length string)))
(save-excursion
(beginning-of-buffer)
(while (search-forward string nil t)
(save-excursion
(backward-char len)
(if (eq (char-before (point)) ?\\) (delete-char -1)
(delete-char len)
(funcall fn)))))))
(defmacro with-test-buffer (contents &rest body)
"Runs BODY in a buffer containing CONTENTS.
The mark may be set in the buffer using the string \"<mark>\".
This can be escaped with a backslash to unclude it literally."
`(with-temp-buffer
(insert ,contents)
(beginning-of-buffer)
(let ((new-mark))
(ert-test-buffer-substitute "<mark>" (lambda () (setq new-mark (point))))
(set-mark new-mark))
(let ((new-point (point)))
(ert-test-buffer-substitute "<point>" (lambda () (setq new-point (point))))
(goto-char new-point))
,@body))
(put 'with-test-buffer 'lisp-indent-function 1)
(provide 'ert-functional)
;;; ert-functional.el ends here

1578
conf/emacs.d/rinari/util/test/ert/ert.el Normal file
View File

File diff suppressed because it is too large Load Diff

309
conf/emacs.d/rinari/util/test/ert/ert.texinfo Normal file
View File

@ -0,0 +1,309 @@
\input texinfo.tex @c -*-texinfo-*-
@c %**start of header
@setfilename ert.info
@settitle Emacs Lisp Regression Tests Manual
@c %**end of header
@dircategory Emacs
@direntry
* ERT: (ert). Emacs Lisp Regression Tests.
@end direntry
@copying
Copyright @copyright{} 2008 Phil Hagelberg
@quotation
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.2 or
any later version published by the Free Software Foundation; with no
Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
Texts.
@end quotation
@end copying
@node Top
@top ERT Manual
ERT is a tool for automated testing in Emacs Lisp. Its main
features are facilities for defining and running test cases and
reporting the results as well as for debugging test failures
interactively.
@menu
* Introduction::
* Defining Tests::
* Should Macro::
* Test Selectors::
* Running Tests::
* Comparison with Other Test Tools::
@end menu
@node Introduction
@chapter Introduction
ERT is designed for automating tests for Emacs Lisp code. It may feel
familiar if you have used classic tools like Test::Unit or xUnit, but
it has a few unique features that take advantage of the dynamic and
interactive nature of Emacs.
ERT is designed with Test-Driven development in mind, though it can
also be used to write tests for existing code. Test-Driven development
is the process by which code is written by writing tests for as-yet
nonexistent code. Tests get written that will purposefully fail
because there is no implementation for them yet. Next the
implementation is written, and when the tests pass, the implementation
may be considered functional. At that point, the code is further
refined to make it simpler and more readable, and changes may be made
with the confidence that the test suite will catch anything that breaks.
Code written in this fashion turns out to be a lot more reliable as
well as easier to maintain if discipline is kept in only implementing
any feature once there are already failing tests that cover all
important aspects of that feature. But sometimes code gets written
that doesn't have tests, in which case tests will have to be written
after the fact. ERT works great for both cases.
@node Defining Tests
@chapter Defining Tests
The @code{ert-deftest} function is used to define a new test. It is
passed a name, an argument list (currently ignored), and a body. This
sample from @file{ert-selftests.el} shows its usage:
@c what's the deal with supplying an arg list if it just gets ignored?
@c can we remove it so it gets treated like a nil in the body?
@lisp
(ert-deftest addition-test ()
(should (= (+ 2 2) 4)))
@end lisp
This simply tests that the @code{+} operator is working
correctly. Since it really just calls a function and checks its return
value, it is a good example of a @b{unit test}, which is one of two
types of common automated test.
@lisp
(ert-deftest print-test ()
(save-excursion (with-output-to-temp-buffer
(should (buffer-changes-p (print "hello"))))))
@end lisp
The other type is a functional test. Functional tests ensure that
higher-level functionality is working. Rather than simply checking the
return value, it performs a more complex operation and ensures that
the state after the operation is as expected.
ERT includes support for both unit tests and functional tests.
@node Should Macro
@chapter Should Macro
Test bodies may include any arbitrary code, but to be useful they will
need to have checks to ensure that the code under test is performing
as expected. @code{should} is similar to cl's @code{assert}, but
signals a different error when its condition is violated that is
caught and processed by ERT. In addition, it analyzes its argument
form and records information that helps debugging.
This test definition:
@lisp
(ert-deftest should-fail ()
(let ((x 2)
(y 4))
(should (= (+ x y (- x y)) 3))))
@end lisp
will produce this when run via @kbd{M-x ert}:
@example
F should-fail
(ert-test-failed
((should
(=
(+ x y ...)
3))
:form
(= 4 3)
:value nil))
@end example
In addition to @code{should}, ERT provides @code{should-not}, which
ensures that the predicate returns nil and @code{should-error}, which
ensures that the body signals an error.
@node Test Selectors
@chapter Test Selectors
Functions like @code{ert-run-tests-interactively} (aliased to
@code{ert}) accept a test selector, which is a Lisp expression
specifying a set of tests. Each test name is a selector that refers
to that test, the selector @code{t} refers to all tests, and the
selector @code{:failed} refers to all tests that failed; but more
complex selectors are available. Test selector syntax is similar to
cl's type specifier syntax.
@itemize
@item @code{nil} -- Selects the empty set.
@item @code{t} -- Selects UNIVERSE.
@item @code{:new} -- Selects all tests that have not been run yet.
@item @code{:failed}, @code{:passed}, @code{:error} -- Select tests according to their most recent result.
@item @code{:expected}, @code{:unexpected} -- Select tests according to their most recent result.
@item @code{a string} -- Selects all tests that have a name that matches the string, a regexp.
@item @code{a test} -- Selects that test.
@item @code{a symbol} -- Selects the test that the symbol names, errors if none.
@end itemize
In addition, more complex selectors exist:
@itemize
@item @code{(member TESTS...)} -- Selects TESTS, a list of tests or symbols naming tests.
@item @code{(eql TEST)} -- Selects TEST, a test or a symbol naming a test.
@item @code{(and SELECTORS...)} -- Selects the tests that match all SELECTORS.
@item @code{(or SELECTORS...)} -- Selects the tests that match any SELECTOR.
@item @code{(not SELECTOR)} -- Selects all tests that do not match SELECTOR.
@item @code{(satisfies PREDICATE)} -- Selects all tests that satisfy PREDICATE.
@end itemize
@node Running Tests
@chapter Running Tests
Invoking ERT via @kbd{M-x ert} will ask for a selector and then run
the tests matched by that selector. Note that it uses @code{read} for
getting the selector input, so entering @kbd{foo} will get interpreted
as a symbol; to get a string it must be wrapped in quotation marks.
Here is an example of the output produced by running the self-tests
with the @kbd{"^ert-"} selector:
@example
Selector: "^ert-"
Passed: 31 (0 unexpected)
Failed: 2 (2 unexpected)
Error: 0 (0 unexpected)
Total: 33/33
Started at: 2008-09-11 08:39:25-0700
Finished.
Finished at: 2008-09-11 08:39:27-0700
FF...............................
F ert-buffer-changes-p
(ert-test-failed
((should
(buffer-changes-p
(insert "hello")))
:form
(let
((buffer-changed-init-value ...))
(unwind-protect
(progn ...)
(string= buffer-changed-init-value ...)))
:value nil))
F ert-buffer-contains-p
(ert-test-failed
((should
(buffer-contains-p "hello"))
:form
(buffer-contains-p "hello")
:value nil))
@end example
As you can see, there's some metadata at the top about the overall
test run. The line of dots and Fs is the progress bar; it fills in
while the test is running to show instant feedback. At the bottom is
shown details about each individual test failure.
@c RET on the failed test's name should jump to the definition, but it
@c seems to be broken? (write a test; duh.)
Anything underlined in the ERT Result buffer is a hyperlink. ERT will
try to identify definitions of functions and macros so that you can
jump to them. @kbd{TAB} and @kbd{S-TAB} will cycle back and forth
between hyperlinks.
Pressing @kbd{r} will cause the test under the point to be re-run on
its own. If @kbd{d} is pressed, it will re-run it with the debugger
enabled. @kbd{b} will show the backtrace that the failure caused, and
@kbd{m} will show its messages.
By default long forms in failure output are truncated, as indicated by
the presence of @samp{...} in the buffer. Pressing @kbd{p} will cause
the full form to be shown.
@node Comparison with Other Test Tools
@chapter Comparison with Other Test Tools
ERT allows test-driven development similar to *Unit frameworks for
other languages. However, two common *Unit features are notably
absent from ERT: fixtures and test suites.
Fixtures, as used e.g. in SUnit or JUnit, have two main purposes:
Setting up (and tearing down) an environment for a set of test
cases, and making that environment accessible through object
attributes that can be used like local variables.
While fixtures are a great syntactic simplification in other
languages, they are not very useful in Lisp, where higher-order
functions and `unwind-protect' are available. One way to implement
and use a fixture in ERT is
@lisp
(defun my-fixture (body)
(unwind-protect
(progn [set up]
(funcall body))
[tear down]))
(ert-deftest my-test ()
(my-fixture
(lambda ()
[test code])))
@end lisp
(Another way would be a @code{with-my-fixture} macro.) This solves
the set-up and tear-down part, and additionally allows any test case
to use any combination of fixtures, so it is more general than what
other tools typically allow.
If the test case needs access to the environment the fixture sets
up, the fixture can be modified to pass arguments to the body.
These are standard Lisp idioms. Special syntax for them could be
added easily enough, but would provide only a minor simplification.
(Note that splitting set-up and tear-down into separate functions,
like *Unit tools usually do, makes it impossible to establish
dynamic `let' bindings as part of the fixture. So, blindly
imitating the way fixtures are implemented in other languages would
be counter-productive in Lisp.)
The purpose of test suites is to group related test cases together.
The most common use of this is to run just the tests for one
particular module. Since symbol prefixes are the usual way of
separating module namespaces in Emacs Lisp, test selectors already
solve this by allowing regexp matching on test names; e.g., the
selector "^ert-" selects ERT's self-tests.
If test suites containing arbitrary sets of tests are found to be
desirable, it would be easy to add a `define-test-selector' mechanism
that introduces a new selector, defined in terms of existing ones;
e.g.
@lisp
;; Note that `define-test-selector' does not exist yet.
(define-test-selector my-test-suite () `(member foo-test bar-test))
@end lisp
would define a test suite named @code{my-test-suite} consisting of
@code{foo-test} and @code{bar-test}. See also @code{deftype} in
Common Lisp.
There are a number of other testing systems written in Emacs Lisp,
though most of them are used only by their authors. Both elunit and
behave.el are deprecated in favour of ERT.
@bye

3
conf/emacs.d/rinari/util/test/ert/test/badly-indented.el Normal file
View File

@ -0,0 +1,3 @@
;; Note: don't auto-indent this; it needs to be badly-indented for the tests.
(hello
world)

594
conf/emacs.d/rinari/util/test/ert/test/ert-selftests.el Normal file
View File

@ -0,0 +1,594 @@
;;; ert-selftests.el --- Self-Tests for ERT
;; Copyright (C) 2007, 2008 Christian M. Ohler
;; Licensed under the same terms as ERT.
(defvar ert-test-root
(file-name-directory (or (buffer-file-name) load-file-name))
"Location of root used for ert tests.")
(add-to-list 'load-path ert-test-root)
(load "../ert")
(load "../ert-functional")
;;; Self-tests.
;; Test that test bodies are actually run.
(defvar ert-test-body-was-run nil)
(ert-deftest ert-test-body-runs ()
(setq ert-test-body-was-run t))
;; Test that nested test bodies run.
(ert-deftest ert-nested-test-body-runs ()
(lexical-let ((was-run nil))
(let ((test (make-ert-test :body (lambda ()
(setq was-run t)))))
(assert (not was-run))
(ert-run-test test)
(assert was-run))))
;; Test that pass/fail works.
(ert-deftest ert-test-pass ()
(let ((test (make-ert-test :body (lambda ()))))
(let ((result (ert-run-test test)))
(assert (typep result 'ert-test-passed)))))
(ert-deftest ert-test-fail ()
(let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
(let ((result (let ((ert-debug-on-error nil))
(ert-run-test test))))
(assert (typep result 'ert-test-failed) t)
(assert (equal (ert-test-result-with-condition-condition result)
'(ert-test-failed "failure message"))
t))))
(ert-deftest ert-test-fail-debug-with-condition-case ()
(let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
(condition-case condition
(progn
(let ((ert-debug-on-error t))
(ert-run-test test))
(assert nil))
((error)
(assert (equal condition '(ert-test-failed "failure message")) t)))))
(ert-deftest ert-test-fail-debug-with-debugger-1 ()
(let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
(let ((debugger (lambda (&rest debugger-args)
(assert nil))))
(let ((ert-debug-on-error nil))
(ert-run-test test)))))
(ert-deftest ert-test-fail-debug-with-debugger-2 ()
(let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
(block nil
(let ((debugger (lambda (&rest debugger-args)
(return-from nil nil))))
(let ((ert-debug-on-error t))
(ert-run-test test))
(assert nil)))))
(ert-deftest ert-test-fail-debug-nested-with-debugger ()
(let ((test (make-ert-test :body (lambda ()
(let ((ert-debug-on-error t))
(ert-fail "failure message"))))))
(let ((debugger (lambda (&rest debugger-args)
(assert nil nil "Assertion a"))))
(let ((ert-debug-on-error nil))
(ert-run-test test))))
(let ((test (make-ert-test :body (lambda ()
(let ((ert-debug-on-error nil))
(ert-fail "failure message"))))))
(block nil
(let ((debugger (lambda (&rest debugger-args)
(return-from nil nil))))
(let ((ert-debug-on-error t))
(ert-run-test test))
(assert nil nil "Assertion b")))))
(ert-deftest ert-test-error ()
(let ((test (make-ert-test :body (lambda () (error "error message")))))
(let ((result (let ((ert-debug-on-error nil))
(ert-run-test test))))
(assert (typep result 'ert-test-error) t)
(assert (equal (ert-test-result-with-condition-condition result)
'(error "error message"))
t))))
(ert-deftest ert-test-error-debug ()
(let ((test (make-ert-test :body (lambda () (error "error message")))))
(condition-case condition
(progn
(let ((ert-debug-on-error t))
(ert-run-test test))
(assert nil))
((error)
(assert (equal condition '(error "error message")) t)))))
;; Test that `should' works.
(ert-deftest ert-test-should ()
(let ((test (make-ert-test :body (lambda () (should nil)))))
(let ((result (let ((ert-debug-on-error nil))
(ert-run-test test))))
(assert (typep result 'ert-test-failed) t)
(assert (equal (ert-test-result-with-condition-condition result)
'(ert-test-failed ((should nil) :form nil :value nil)))
t)))
(let ((test (make-ert-test :body (lambda () (should t)))))
(let ((result (ert-run-test test)))
(assert (typep result 'ert-test-passed) t))))
(ert-deftest ert-test-should-value ()
(should (eql (should 'foo) 'foo))
(should (eql (should 'bar) 'bar)))
(ert-deftest ert-test-should-not ()
(let ((test (make-ert-test :body (lambda () (should-not t)))))
(let ((result (let ((ert-debug-on-error nil))
(ert-run-test test))))
(assert (typep result 'ert-test-failed) t)
(assert (equal (ert-test-result-with-condition-condition result)
'(ert-test-failed ((should-not t) :form t :value t)))
t)))
(let ((test (make-ert-test :body (lambda () (should-not nil)))))
(let ((result (ert-run-test test)))
(assert (typep result 'ert-test-passed)))))
(ert-deftest ert-test-should-error ()
;; No error.
(let ((test (make-ert-test :body (lambda () (should-error (progn))))))
(let ((result (let ((ert-debug-on-error nil))
(ert-run-test test))))
(should (typep result 'ert-test-failed))
(should (equal (ert-test-result-with-condition-condition result)
'(ert-test-failed
((should-error (progn))
:form (progn)
:value nil
:fail-reason "did not signal an error"))))))
;; A simple error.
(let ((test (make-ert-test :body (lambda () (should-error (error "foo"))))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-passed))))
;; Error of unexpected type, no test.
(let ((test (make-ert-test :body (lambda ()
(should-error (error "foo")
:type 'singularity-error)))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-failed))
(should (equal
(ert-test-result-with-condition-condition result)
'(ert-test-failed
((should-error (error "foo") :type 'singularity-error)
:form (error "foo")
:condition (error "foo")
:fail-reason
"the error signalled did not have the expected type"))))))
;; Error of the expected type, no test.
(let ((test (make-ert-test :body (lambda ()
(should-error (signal 'singularity-error
nil)
:type 'singularity-error)))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-passed))))
;; Error that fails the test, no type.
(let ((test (make-ert-test :body (lambda ()
(should-error
(error "foo")
:test (lambda (error) nil))))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-failed))
(should (equal (ert-test-result-with-condition-condition result)
'(ert-test-failed
((should-error (error "foo") :test (lambda (error) nil))
:form (error "foo")
:condition (error "foo")
:fail-reason
"the error signalled did not pass the test"))))))
;; Error that passes the test, no type.
(let ((test (make-ert-test :body (lambda ()
(should-error (error "foo")
:test (lambda (error) t))))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-passed))))
;; Error that has the expected type but fails the test.
(let ((test (make-ert-test :body (lambda ()
(should-error
(signal 'singularity-error nil)
:type 'singularity-error
:test (lambda (error) nil))))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-failed))
(should (equal (ert-test-result-with-condition-condition result)
'(ert-test-failed
((should-error (signal 'singularity-error nil)
:type 'singularity-error
:test (lambda (error) nil))
:form (signal singularity-error nil)
:condition (singularity-error)
:fail-reason
"the error signalled did not pass the test"))))))
;; Error that has the expected type and passes the test.
(let ((test (make-ert-test :body (lambda ()
(should-error
(signal 'singularity-error nil)
:type 'singularity-error
:test (lambda (error) t))))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-passed)))))
(ert-deftest ert-test-should-error-subtypes ()
(let ((test (make-ert-test
:body (lambda ()
(should-error (signal 'singularity-error nil)
:type 'singularity-error
:exclude-subtypes t)))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-passed))))
(let ((test (make-ert-test
:body (lambda ()
(should-error (signal 'arith-error nil)
:type 'singularity-error)))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-failed))
(should (equal
(ert-test-result-with-condition-condition result)
'(ert-test-failed
((should-error (signal 'arith-error nil)
:type 'singularity-error)
:form (signal arith-error nil)
:condition (arith-error)
:fail-reason
"the error signalled did not have the expected type"))))))
(let ((test (make-ert-test
:body (lambda ()
(should-error (signal 'arith-error nil)
:type 'singularity-error
:exclude-subtypes t)))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-failed))
(should (equal
(ert-test-result-with-condition-condition result)
'(ert-test-failed
((should-error (signal 'arith-error nil)
:type 'singularity-error
:exclude-subtypes t)
:form (signal arith-error nil)
:condition (arith-error)
:fail-reason
"the error signalled did not have the expected type"))))))
(let ((test (make-ert-test
:body (lambda ()
(should-error (signal 'singularity-error nil)
:type 'arith-error
:exclude-subtypes t)))))
(let ((result (ert-run-test test)))
(should (typep result 'ert-test-failed))
(should (equal
(ert-test-result-with-condition-condition result)
'(ert-test-failed
((should-error (signal 'singularity-error nil)
:type 'arith-error
:exclude-subtypes t)
:form (signal singularity-error nil)
:condition (singularity-error)
:fail-reason
"the error signalled was a subtype of the expected type")))))))
;; Test that `should' errors contain the information we expect them to.
(defmacro ert-test-my-list (&rest args)
`(list ,@args))
(ert-deftest ert-test-should-failure-debugging ()
(loop for (body expected-condition) in
`((,(lambda () (let ((x nil)) (should x)))
(ert-test-failed ((should x) :form x :value nil)))
(,(lambda () (let ((x t)) (should-not x)))
(ert-test-failed ((should-not x) :form x :value t)))
(,(lambda () (let ((x t)) (should (not x))))
(ert-test-failed ((should (not x)) :form (not t) :value nil)))
(,(lambda () (let ((x nil)) (should-not (not x))))
(ert-test-failed ((should-not (not x)) :form (not nil) :value t)))
(,(lambda () (let ((x t) (y nil)) (should-not (ert-test-my-list x y))))
(ert-test-failed
((should-not (ert-test-my-list x y))
:form (list t nil)
:value (t nil))))
(,(lambda () (let ((x t)) (should (error "foo"))))
(error "foo")))
do
(let ((test (make-ert-test :body body)))
(condition-case actual-condition
(progn
(let ((ert-debug-on-error t))
(ert-run-test test))
(assert nil))
((error)
(should (equal actual-condition expected-condition)))))))
(ert-deftest ert-test-messages ()
(let* ((message-string "Test message")
(messages-buffer (get-buffer-create "*Messages*"))
(test (make-ert-test :body (lambda () (message "%s" message-string)))))
(with-current-buffer messages-buffer
(let ((result (ert-run-test test)))
(should (equal (concat message-string "\n")
(ert-test-result-messages result)))))))
(defun ert-call-with-temporary-messages-buffer (thunk)
(lexical-let ((new-buffer-name (generate-new-buffer-name
"*Messages* orig buffer")))
(unwind-protect
(progn
(with-current-buffer (get-buffer-create "*Messages*")
(rename-buffer new-buffer-name))
(get-buffer-create "*Messages*")
(funcall thunk))
(kill-buffer "*Messages*")
(with-current-buffer new-buffer-name
(rename-buffer "*Messages*")))))
(ert-deftest ert-test-messages-on-log-truncation ()
(let ((test (make-ert-test
:body (lambda ()
;; Emacs would combine messages if we
;; generate the same message multiple
;; times.
(message "a")
(message "b")
(message "c")
(message "d")))))
(let (result)
(ert-call-with-temporary-messages-buffer
(lambda ()
(let ((message-log-max 2))
(setq result (ert-run-test test)))
(should (equal (with-current-buffer "*Messages*"
(buffer-string))
"c\nd\n"))))
(should (equal (ert-test-result-messages result) "a\nb\nc\nd\n")))))
;; Test `ert-select-tests'.
(ert-deftest ert-test-select-regexp ()
(should (equal (ert-select-tests "^ert-test-select-regexp$" t)
(list (ert-get-test 'ert-test-select-regexp)))))
(ert-deftest ert-test-test-boundp ()
(should (ert-test-boundp 'ert-test-test-boundp))
(should-not (ert-test-boundp (make-symbol "ert-not-a-test"))))
(ert-deftest ert-test-select-member ()
(should (equal (ert-select-tests '(member ert-test-select-member) t)
(list (ert-get-test 'ert-test-select-member)))))
(ert-deftest ert-test-select-test ()
(should (equal (ert-select-tests (ert-get-test 'ert-test-select-test) t)
(list (ert-get-test 'ert-test-select-test)))))
(ert-deftest ert-test-select-symbol ()
(should (equal (ert-select-tests 'ert-test-select-symbol t)
(list (ert-get-test 'ert-test-select-symbol)))))
(ert-deftest ert-test-select-and ()
(let ((test (make-ert-test
:name nil
:body nil
:most-recent-result (make-ert-test-failed
:condition nil
:backtrace nil))))
(should (equal (ert-select-tests `(and (member ,test) :failed) t)
(list test)))))
;; Test utility functions.
(ert-deftest ert-proper-list-p ()
(should (ert-proper-list-p '()))
(should (ert-proper-list-p '(1)))
(should (ert-proper-list-p '(1 2)))
(should (ert-proper-list-p '(1 2 3)))
(should (ert-proper-list-p '(1 2 3 4)))
(should (not (ert-proper-list-p 'a)))
(should (not (ert-proper-list-p '(1 . a))))
(should (not (ert-proper-list-p '(1 2 . a))))
(should (not (ert-proper-list-p '(1 2 3 . a))))
(should (not (ert-proper-list-p '(1 2 3 4 . a))))
(let ((a (list 1)))
(setf (cdr (last a)) a)
(should (not (ert-proper-list-p a))))
(let ((a (list 1 2)))
(setf (cdr (last a)) a)
(should (not (ert-proper-list-p a))))
(let ((a (list 1 2 3)))
(setf (cdr (last a)) a)
(should (not (ert-proper-list-p a))))
(let ((a (list 1 2 3 4)))
(setf (cdr (last a)) a)
(should (not (ert-proper-list-p a))))
(let ((a (list 1 2)))
(setf (cdr (last a)) (cdr a))
(should (not (ert-proper-list-p a))))
(let ((a (list 1 2 3)))
(setf (cdr (last a)) (cdr a))
(should (not (ert-proper-list-p a))))
(let ((a (list 1 2 3 4)))
(setf (cdr (last a)) (cdr a))
(should (not (ert-proper-list-p a))))
(let ((a (list 1 2 3)))
(setf (cdr (last a)) (cddr a))
(should (not (ert-proper-list-p a))))
(let ((a (list 1 2 3 4)))
(setf (cdr (last a)) (cddr a))
(should (not (ert-proper-list-p a))))
(let ((a (list 1 2 3 4)))
(setf (cdr (last a)) (cdddr a))
(should (not (ert-proper-list-p a)))))
(ert-deftest ert-parse-keys-and-body ()
(should (equal (ert-parse-keys-and-body '(foo)) '(nil (foo))))
(should (equal (ert-parse-keys-and-body '(:bar foo)) '((:bar foo) nil)))
(should (equal (ert-parse-keys-and-body '(:bar foo a (b))) '((:bar foo) (a (b)))))
(should (equal (ert-parse-keys-and-body '(:bar foo :a (b))) '((:bar foo :a (b)) nil)))
(should (equal (ert-parse-keys-and-body '(bar foo :a (b))) '(nil (bar foo :a (b)))))
(should-error (ert-parse-keys-and-body '(:bar foo :a))))
;; Test `ert-run-tests'.
(ert-deftest ert-test-run-tests ()
(let ((passing-test (make-ert-test :name 'passing-test
:body (lambda () (ert-pass))))
(failing-test (make-ert-test :name 'failing-test
:body (lambda () (ert-fail
"failure message"))))
)
(let ((ert-debug-on-error nil))
(let* ((buffer-name (generate-new-buffer-name " *ert-test-run-tests*"))
(messages nil)
(mock-message-fn
(lambda (format-string &rest args)
(push (apply #'format format-string args) messages))))
(save-window-excursion
(unwind-protect
(let ((case-fold-search nil))
(ert-run-tests-interactively
`(member ,passing-test ,failing-test) buffer-name
mock-message-fn)
(should (equal messages `(,(concat
"Ran 2 tests, 1 results were "
"as expected, 1 unexpected"))))
(with-current-buffer buffer-name
(goto-char (point-min))
(should (equal
(buffer-substring (point-min)
(save-excursion
(forward-line 5)
(point)))
(concat
"Selector: (member <passing-test> <failing-test>)\n"
"Passed: 1 (0 unexpected)\n"
"Failed: 1 (1 unexpected)\n"
"Error: 0 (0 unexpected)\n"
"Total: 2/2\n")))))
(when (get-buffer buffer-name)
(kill-buffer buffer-name))))))))
(ert-deftest ert-test-special-operator-p ()
(should (ert-special-operator-p 'if))
(should-not (ert-special-operator-p 'car))
(should-not (ert-special-operator-p 'ert-special-operator-p))
(let ((b (gensym)))
(should-not (ert-special-operator-p b))
(fset b 'if)
(should (ert-special-operator-p b))))
;; This test attempts to demonstrate that there is no way to force
;; immediate truncation of the *Messages* buffer from Lisp (and hence
;; justifies the existence of
;; `ert-force-message-log-buffer-truncation'): The only way that came
;; to my mind was (message ""), which doesn't have the desired effect.
(ert-deftest ert-test-builtin-message-log-flushing ()
(ert-call-with-temporary-messages-buffer
(lambda ()
(with-current-buffer "*Messages*"
(let ((message-log-max 2))
(let ((message-log-max t))
(loop for i below 4 do
(message "%s" i))
(should (eql (count-lines (point-min) (point-max)) 4)))
(should (eql (count-lines (point-min) (point-max)) 4))
(message "")
(should (eql (count-lines (point-min) (point-max)) 4))
(message "Test message")
(should (eql (count-lines (point-min) (point-max)) 2)))))))
(ert-deftest ert-test-force-message-log-buffer-truncation ()
(labels ((body ()
(loop for i below 5 do
(message "%s" i)))
(c (x)
(ert-call-with-temporary-messages-buffer
(lambda ()
(let ((message-log-max x))
(body))
(with-current-buffer "*Messages*"
(buffer-string)))))
(lisp (x)
(ert-call-with-temporary-messages-buffer
(lambda ()
(let ((message-log-max t))
(body))
(let ((message-log-max x))
(ert-force-message-log-buffer-truncation))
(with-current-buffer "*Messages*"
(buffer-string))))))
(loop for x in '(0 1 2 3 4 5 6 t) do
(should (equal (c x) (lisp x))))))
;;; Predicates
(ert-deftest ert-buffer-changes-p ()
(with-temp-buffer
(should (buffer-changes-p
(insert "hello")))
(should-not (buffer-changes-p
(message "hello")))))
(ert-deftest ert-buffer-contains-p ()
(with-temp-buffer
(insert "hello world")
(should (buffer-contains-p "hello")))
(should-not (buffer-contains-p "goodbye")))
(ert-deftest ert-correctly-indented-p ()
(should (correctly-indented-p (concat ert-test-root "well-indented.el")))
(should-not (correctly-indented-p (concat ert-test-root "badly-indented.el"))))
;;; Utilities
(ert-deftest ert-with-test-buffer ()
(let ((contents "Foo bar\n baz\n\tbip"))
(with-test-buffer contents
(should (string-equal (buffer-string) contents)))))
(ert-deftest ert-with-test-buffer-inserting ()
(let ((contents "Foo bar\n baz\n\tbip"))
(with-test-buffer contents
(insert "Hello\n")
(should (string-equal (buffer-string) (concat "Hello\n" contents))))))
(ert-deftest ert-with-test-buffer-mark ()
(with-test-buffer "Foo<mark> bar baz"
(should (string-equal (buffer-substring (point) (mark)) "Foo"))
(should (string-equal (buffer-string) "Foo bar baz"))))
(ert-deftest ert-with-test-buffer-fake-mark ()
(with-test-buffer "Foo\\<mark> bar baz"
(should (string-equal (buffer-string) "Foo<mark> bar baz"))))
(ert-deftest ert-with-test-buffer-point ()
(with-test-buffer "Foo bar<point> baz"
(insert "bell")
(should (string-equal (buffer-string) "Foo barbell baz"))))
(ert-deftest ert-with-test-buffer-mark-and-point ()
(with-test-buffer "Foo <mark>bar<point> baz"
(upcase-region (mark) (point))
(should (string-equal (buffer-string) "Foo BAR baz"))))
;; Run tests and make sure they actually ran.
(let ((window-configuration (current-window-configuration))
(ert-test-body-was-run nil)
;; The buffer name chosen here should not compete with the default
;; results buffer name for completion in `switch-to-buffer'.
(stats (ert-run-tests-interactively "^ert-" " *ert self-tests*")))
(assert ert-test-body-was-run)
(when (zerop (+ (ert-stats-passed-unexpected stats)
(ert-stats-failed-unexpected stats)
(ert-stats-error-unexpected stats)))
;; Hide results window only when everything went well.
(set-window-configuration window-configuration)))
(provide 'ert-selftests)

2
conf/emacs.d/rinari/util/test/ert/test/well-indented.el Normal file
View File

@ -0,0 +1,2 @@
(hello (world
'elisp)

39
conf/emacs.d/rinari/util/test/ruby-mode-test.el Normal file
View File

@ -0,0 +1,39 @@
(add-to-list 'load-path (file-name-directory (or (buffer-file-name)
load-file-name)))
(load "ert/ert")
(load "ert/ert-functional")
(load "../ruby-mode")
(defmacro with-ruby-buffer (contents &rest body)
"Like `with-test-buffer', but sets the buffer to `ruby-mode'."
`(with-test-buffer ,contents
(ruby-mode)
,@body))
(put 'with-ruby-buffer 'lisp-indent-function 1)
(defmacro test-here-doc-p (contents)
`(with-ruby-buffer ,contents
(ert-test-buffer-substitute "<here-doc>" (lambda () (should (ruby-in-here-doc-p))))
(ert-test-buffer-substitute "<no-here-doc>" (lambda () (should-not (ruby-in-here-doc-p))))))
(ert-deftest ruby-here-doc-p ()
(test-here-doc-p "
<<FOO
<here-doc>
FOO
<no-here-doc>
<<BAR
<here-doc>
BAR"))
(ert-deftest ruby-here-doc-p-multiple ()
(test-here-doc-p "
p <no-here-doc>[<<FOO,<no-here-doc> <<BAR,<no-here-doc> <<BAZ]
<here-doc>
FOO
<here-doc>
BAR
<here-doc>
BAZ
<no-here-doc>"))

609
conf/emacs.d/themes/color-theme-tomorrow.el Normal file
View File

@ -0,0 +1,609 @@
;;; color-theme-tomorrow.el --- GNU Emacs port of the Tomorrow Theme.
;;; Commentary:
;;
;;; Tomorrow Theme
;;
;; Originally by Chris Kempson https://github.com/ChrisKempson/Tomorrow-Theme
;; Ported to GNU Emacs by Chris Charles
;; Rewritten by Steve Purcell <steve@sanityinc.com> for compatibility
;; Update to match master by Donald Curtis <dcurtis@milkbox.net>
;;; Code:
(defconst color-theme-tomorrow-colors
'((night . ((background . "#1d1f21")
(current-line . "#282a2e")
(selection . "#373b41")
(foreground . "#c5c8c6")
(comment . "#969896")
(red . "#cc6666")
(orange . "#de935f")
(yellow . "#f0c674")
(green . "#b5bd68")
(aqua . "#8abeb7")
(blue . "#81a2be")
(purple . "#b294bb")))
(day . ((background . "#ffffff")
(current-line . "#efefef")
(selection . "#d6d6d6")
(foreground . "#4d4d4c")
(comment . "#8e908c")
(red . "#c82829")
(orange . "#f5871f")
(yellow . "#eab700")
(green . "#718c00")
(aqua . "#3e999f")
(blue . "#4271ae")
(purple . "#8959a8")))
(night-eighties . ((background . "#2d2d2d")
(current-line . "#393939")
(selection . "#515151")
(foreground . "#cccccc")
(comment . "#999999")
(red . "#f2777a")
(orange . "#f99157")
(yellow . "#ffcc66")
(green . "#99cc99")
(aqua . "#66cccc")
(blue . "#6699cc")
(purple . "#cc99cc")))
(night-blue . ((background . "#002451")
(current-line . "#00346e")
(selection . "#003f8e")
(foreground . "#ffffff")
(comment . "#7285b7")
(red . "#ff9da4")
(orange . "#ffc58f")
(yellow . "#ffeead")
(green . "#d1f1a9")
(aqua . "#99ffff")
(blue . "#bbdaff")
(purple . "#ebbbff")))
(night-bright . ((background . "#000000")
(current-line . "#2a2a2a")
(selection . "#424242")
(foreground . "#eaeaea")
(comment . "#969896")
(red . "#d54e53")
(orange . "#e78c45")
(yellow . "#e7c547")
(green . "#b9ca4a")
(aqua . "#70c0b1")
(blue . "#7aa6da")
(purple . "#c397d8")))))
(defmacro color-theme-tomorrow--with-colors (mode &rest body)
"Execute `BODY' in a scope with variables bound to the various tomorrow colors.
`MODE' should be set to either 'day, 'night, 'night-eighties, 'night-blue or 'night-bright."
`(let* ((colors (or (cdr (assoc ,mode color-theme-tomorrow-colors))
(error "no such theme flavor")))
(background (cdr (assoc 'background colors)))
(current-line (cdr (assoc 'current-line colors)))
(selection (cdr (assoc 'selection colors)))
(foreground (cdr (assoc 'foreground colors)))
(comment (cdr (assoc 'comment colors)))
(red (cdr (assoc 'red colors)))
(orange (cdr (assoc 'orange colors)))
(yellow (cdr (assoc 'yellow colors)))
(green (cdr (assoc 'green colors)))
(aqua (cdr (assoc 'aqua colors)))
(blue (cdr (assoc 'blue colors)))
(purple (cdr (assoc 'purple colors)))
(class '((class color) (min-colors 89))))
,@body))
(defmacro color-theme-tomorrow--face-specs ()
"Return a backquote which defines a list of face specs.
It expects to be evaluated in a scope in which the various color
names to which it refers are bound."
(quote
`(;; Standard font lock faces
(default ((,class (:foreground ,foreground :background ,background))))
(bold ((,class (:weight bold))))
(bold-italic ((,class (:slant italic :weight bold))))
(underline ((,class (:underline t))))
(italic ((,class (:slant italic))))
(shadow ((,class (:foreground ,comment))))
(success ((,class (:foreground ,green))))
(error ((,class (:foreground ,red))))
(warning ((,class (:foreground ,orange))))
(outline-4 ((,class (:slant normal :foreground ,comment))))
;; Font-lock stuff
(font-lock-builtin-face ((,class (:foreground ,aqua))))
(font-lock-comment-delimiter-face ((,class (:foreground ,comment :slant italic))))
(font-lock-comment-face ((,class (:foreground ,comment :slant italic))))
(font-lock-constant-face ((,class (:foreground ,aqua))))
(font-lock-doc-face ((,class (:foreground ,comment))))
(font-lock-doc-string-face ((,class (:foreground ,yellow))))
(font-lock-function-name-face ((,class (:foreground ,blue))))
(font-lock-keyword-face ((,class (:foreground ,purple))))
(font-lock-negation-char-face ((,class (:foreground ,green))))
(font-lock-preprocessor-face ((,class (:foreground ,purple))))
(font-lock-regexp-grouping-backslash ((,class (:foreground ,yellow))))
(font-lock-regexp-grouping-construct ((,class (:foreground ,purple))))
(font-lock-string-face ((,class (:foreground ,green))))
(font-lock-type-face ((,class (:foreground ,yellow))))
(font-lock-variable-name-face ((,class (:foreground ,orange))))
(font-lock-warning-face ((,class (:weight bold :foreground ,red))))
;; Flymake
(flymake-warnline ((,class (:underline ,orange :background ,background))))
(flymake-errline ((,class (:underline ,red :background ,background))))
;; Clojure errors
(clojure-test-failure-face ((,class (:background nil :inherit flymake-warnline))))
(clojure-test-error-face ((,class (:background nil :inherit flymake-errline))))
(clojure-test-success-face ((,class (:background nil :foreground nil :underline ,green))))
;; For Brian Carper's extended clojure syntax table
(clojure-keyword ((,class (:foreground ,yellow))))
(clojure-parens ((,class (:foreground ,foreground))))
(clojure-braces ((,class (:foreground ,green))))
(clojure-brackets ((,class (:foreground ,yellow))))
(clojure-double-quote ((,class (:foreground ,aqua :background nil))))
(clojure-special ((,class (:foreground ,blue))))
(clojure-java-call ((,class (:foreground ,purple))))
;; Rainbow-delimiters
(rainbow-delimiters-depth-1-face ((,class (:foreground ,purple))))
(rainbow-delimiters-depth-2-face ((,class (:foreground ,blue))))
(rainbow-delimiters-depth-3-face ((,class (:foreground ,aqua))))
(rainbow-delimiters-depth-4-face ((,class (:foreground ,green))))
(rainbow-delimiters-depth-5-face ((,class (:foreground ,yellow))))
(rainbow-delimiters-depth-6-face ((,class (:foreground ,orange))))
(rainbow-delimiters-depth-7-face ((,class (:foreground ,red))))
(rainbow-delimiters-depth-8-face ((,class (:foreground ,comment))))
(rainbow-delimiters-depth-9-face ((,class (:foreground ,foreground))))
(rainbow-delimiters-unmatched-face ((,class (:foreground ,red))))
;; MMM-mode
(mmm-code-submode-face ((,class (:background ,current-line))))
(mmm-comment-submode-face ((,class (:inherit font-lock-comment-face))))
(mmm-output-submode-face ((,class (:background ,current-line))))
;; Search
(match ((,class (:foreground ,blue :background ,background :inverse-video t))))
(isearch ((,class (:foreground ,yellow :background ,background :inverse-video t))))
(isearch-lazy-highlight-face ((,class (:foreground ,aqua :background ,background :inverse-video t))))
(isearch-fail ((,class (:background ,background :inherit font-lock-warning-face :inverse-video t))))
;; IDO
(ido-subdir ((,class (:foreground ,comment))))
(ido-first-match ((,class (:foreground ,orange :weight bold))))
(ido-only-match ((,class (:foreground ,red :weight bold))))
(ido-indicator ((,class (:foreground ,red :background ,background))))
(ido-virtual ((,class (:foreground ,comment))))
;; which-function
(which-func ((,class (:foreground ,blue :background nil :weight bold))))
;; Emacs interface
(cursor ((,class (:background ,red))))
(fringe ((,class (:background ,current-line))))
(linum ((,class (:background ,current-line))))
(hl-line ((,class (:background ,current-line))))
(border ((,class (:background ,current-line))))
(border-glyph ((,class (nil))))
(highlight ((,class (:background ,green))))
(link ((,class (:foreground ,blue))))
(link-visited ((,class (:foreground ,purple))))
(gui-element ((,class (:background ,current-line :foreground ,foreground))))
(mode-line ((,class (:background ,selection :foreground ,foreground))))
(mode-line-inactive ((,class (:background ,current-line :foreground ,foreground))))
(mode-line-buffer-id ((,class (:foreground ,purple :background nil))))
(mode-line-emphasis ((,class (:foreground ,foreground :slant italic))))
(mode-line-highlight ((,class (:foreground ,purple :box nil :weight bold))))
(minibuffer-prompt ((,class (:foreground ,blue))))
(region ((,class (:background ,selection))))
(secondary-selection ((,class (:background ,current-line))))
(header-line ((,class (:inherit mode-line :foreground ,purple :background nil))))
(trailing-whitespace ((,class (:background ,red :foreground ,yellow))))
(whitespace-empty ((,class (:foreground ,red :background ,yellow))))
(whitespace-hspace ((,class (:background ,selection :foreground ,comment))))
(whitespace-indentation ((,class (:background ,yellow :foreground ,red))))
(whitespace-line ((,class (:background ,current-line :foreground ,purple))))
(whitespace-newline ((,class (:foreground ,comment))))
(whitespace-space ((,class (:background ,current-line :foreground ,comment))))
(whitespace-space-after-tab ((,class (:background ,yellow :foreground ,red))))
(whitespace-space-before-tab ((,class (:background ,orange :foreground ,red))))
(whitespace-tab ((,class (:background ,selection :foreground ,comment))))
(whitespace-trailing ((,class (:background ,red :foreground ,yellow))))
;; Parenthesis matching (built-in)
(show-paren-match ((,class (:background ,blue :foreground ,current-line))))
(show-paren-mismatch ((,class (:background ,orange :foreground ,current-line))))
;; Parenthesis matching (mic-paren)
(paren-face-match ((,class (:foreground nil :background nil :inherit show-paren-match))))
(paren-face-mismatch ((,class (:foreground nil :background nil :inherit show-paren-mismatch))))
(paren-face-no-match ((,class (:foreground nil :background nil :inherit show-paren-mismatch))))
;; Parenthesis dimming (parenface)
(paren-face ((,class (:foreground ,comment :background nil))))
(sh-heredoc ((,class (:foreground nil :inherit font-lock-string-face :weight normal))))
(sh-quoted-exec ((,class (:foreground nil :inherit font-lock-preprocessor-face))))
(slime-highlight-edits-face ((,class (:weight bold))))
(slime-repl-input-face ((,class (:weight normal :underline nil))))
(slime-repl-prompt-face ((,class (:underline nil :weight bold :foreground ,purple))))
(slime-repl-result-face ((,class (:foreground ,green))))
(slime-repl-output-face ((,class (:foreground ,blue :background ,background))))
(csv-separator-face ((,class (:foreground ,orange))))
(diff-added ((,class (:foreground ,green))))
(diff-changed ((,class (:foreground ,yellow))))
(diff-removed ((,class (:foreground ,red))))
(diff-header ((,class (:background ,current-line))))
(diff-file-header ((,class (:background ,selection))))
(diff-hunk-header ((,class (:background ,current-line :foreground ,purple))))
(ediff-even-diff-A ((,class (:foreground nil :background nil :inverse-video t))))
(ediff-even-diff-B ((,class (:foreground nil :background nil :inverse-video t))))
(ediff-odd-diff-A ((,class (:foreground ,comment :background nil :inverse-video t))))
(ediff-odd-diff-B ((,class (:foreground ,comment :background nil :inverse-video t))))
(eldoc-highlight-function-argument ((,class (:foreground ,green :weight bold))))
;; undo-tree
(undo-tree-visualizer-default-face ((,class (:foreground ,foreground))))
(undo-tree-visualizer-current-face ((,class (:foreground ,green :weight bold))))
(undo-tree-visualizer-active-branch-face ((,class (:foreground ,red))))
(undo-tree-visualizer-register-face ((,class (:foreground ,yellow))))
;; auctex
(font-latex-bold-face ((,class (:foreground ,green))))
(font-latex-doctex-documentation-face ((,class (:background ,current-line))))
(font-latex-italic-face ((,class (:foreground ,green))))
(font-latex-math-face ((,class (:foreground ,orange))))
(font-latex-sectioning-0-face ((,class (:foreground ,yellow))))
(font-latex-sectioning-1-face ((,class (:foreground ,yellow))))
(font-latex-sectioning-2-face ((,class (:foreground ,yellow))))
(font-latex-sectioning-3-face ((,class (:foreground ,yellow))))
(font-latex-sectioning-4-face ((,class (:foreground ,yellow))))
(font-latex-sectioning-5-face ((,class (:foreground ,yellow))))
(font-latex-sedate-face ((,class (:foreground ,aqua))))
(font-latex-string-face ((,class (:foreground ,yellow))))
(font-latex-verbatim-face ((,class (:foreground ,orange))))
(font-latex-warning-face ((,class (:foreground ,red))))
;; dired+
(diredp-compressed-file-suffix ((,class (:foreground ,blue))))
(diredp-dir-heading ((,class (:foreground nil :background nil :inherit heading))))
(diredp-dir-priv ((,class (:foreground ,aqua :background nil))))
(diredp-exec-priv ((,class (:foreground ,blue :background nil))))
(diredp-executable-tag ((,class (:foreground ,red :background nil))))
(diredp-file-name ((,class (:foreground ,yellow))))
(diredp-file-suffix ((,class (:foreground ,green))))
(diredp-flag-mark-line ((,class (:background nil :inherit highlight))))
(diredp-ignored-file-name ((,class (:foreground ,comment))))
(diredp-link-priv ((,class (:background nil :foreground ,purple))))
(diredp-mode-line-flagged ((,class (:foreground ,red))))
(diredp-mode-line-marked ((,class (:foreground ,green))))
(diredp-no-priv ((,class (:background nil))))
(diredp-number ((,class (:foreground ,yellow))))
(diredp-other-priv ((,class (:background nil :foreground ,purple))))
(diredp-rare-priv ((,class (:foreground ,red :background nil))))
(diredp-read-priv ((,class (:foreground ,green :background nil))))
(diredp-symlink ((,class (:foreground ,purple))))
(diredp-write-priv ((,class (:foreground ,yellow :background nil))))
;; Magit (a patch is pending in magit to make these standard upstream)
(magit-branch ((,class (:foreground ,green))))
(magit-header ((,class (:inherit nil :weight bold))))
(magit-item-highlight ((,class (:inherit highlight :background nil))))
(magit-log-graph ((,class (:foreground ,comment))))
(magit-log-sha1 ((,class (:foreground ,purple))))
(magit-log-head-label-bisect-bad ((,class (:foreground ,red))))
(magit-log-head-label-bisect-good ((,class (:foreground ,green))))
(magit-log-head-label-default ((,class (:foreground ,yellow :box nil :weight bold))))
(magit-log-head-label-local ((,class (:foreground ,blue))))
(magit-log-head-label-remote ((,class (:foreground ,green))))
(magit-log-head-label-tags ((,class (:foreground ,aqua :box nil :weight bold))))
(magit-section-title ((,class (:inherit diff-hunk-header))))
(link ((,class (:foreground nil :underline t))))
(widget-button ((,class (:underline t))))
(widget-field ((,class (:background ,current-line :box (:line-width 1 :color ,foreground)))))
;; Compilation (most faces politely inherit from 'success, 'error, 'warning etc.)
(compilation-column-number ((,class (:foreground ,yellow))))
(compilation-line-number ((,class (:foreground ,yellow))))
(compilation-message-face ((,class (:foreground ,blue))))
(compilation-mode-line-exit ((,class (:foreground ,green))))
(compilation-mode-line-fail ((,class (:foreground ,red))))
(compilation-mode-line-run ((,class (:foreground ,blue))))
;; Grep
(grep-context-face ((,class (:foreground ,comment))))
(grep-error-face ((,class (:foreground ,red :weight bold :underline t))))
(grep-hit-face ((,class (:foreground ,blue))))
(grep-match-face ((,class (:foreground nil :background nil :inherit match))))
(regex-tool-matched-face ((,class (:foreground nil :background nil :inherit match))))
;; mark-multiple
(mm/master-face ((,class (:inherit region :foreground nil :background nil))))
(mm/mirror-face ((,class (:inherit region :foreground nil :background nil))))
(org-agenda-structure ((,class (:foreground ,purple))))
(org-agenda-date ((,class (:foreground ,blue :underline nil))))
(org-agenda-done ((,class (:foreground ,green))))
(org-agenda-dimmed-todo-face ((,class (:foreground ,comment))))
(org-block ((,class (:foreground ,orange))))
(org-code ((,class (:foreground ,yellow))))
(org-column ((,class (:background ,current-line))))
(org-column-title ((,class (:inherit org-column :weight bold :underline t))))
(org-date ((,class (:foreground ,purple :underline t))))
(org-document-info ((,class (:foreground ,aqua))))
(org-document-info-keyword ((,class (:foreground ,green))))
(org-document-title ((,class (:weight bold :foreground ,orange :height 1.44))))
(org-done ((,class (:foreground ,green))))
(org-ellipsis ((,class (:foreground ,comment))))
(org-footnote ((,class (:foreground ,aqua))))
(org-formula ((,class (:foreground ,red))))
(org-hide ((,class (:foreground ,current-line))))
(org-link ((,class (:foreground ,blue))))
(org-scheduled ((,class (:foreground ,green))))
(org-scheduled-previously ((,class (:foreground ,orange))))
(org-scheduled-today ((,class (:foreground ,green))))
(org-special-keyword ((,class (:foreground ,orange))))
(org-table ((,class (:foreground ,purple))))
(org-todo ((,class (:foreground ,red))))
(org-upcoming-deadline ((,class (:foreground ,orange))))
(org-warning ((,class (:weight bold :foreground ,red))))
(markdown-url-face ((,class (:inherit link))))
(markdown-link-face ((,class (:foreground ,blue :underline t))))
(hl-sexp-face ((,class (:background ,current-line))))
(highlight-80+ ((,class (:background ,current-line))))
;; Python-specific overrides
(py-builtins-face ((,class (:foreground ,orange :weight normal))))
;; js2-mode
(js2-warning-face ((,class (:underline ,orange))))
(js2-error-face ((,class (:foreground nil :underline ,red))))
(js2-external-variable-face ((,class (:foreground ,purple))))
(js2-function-param-face ((,class (:foreground ,blue))))
(js2-instance-member-face ((,class (:foreground ,blue))))
(js2-private-function-call-face ((,class (:foreground ,red))))
;; js3-mode
(js3-warning-face ((,class (:underline ,orange))))
(js3-error-face ((,class (:foreground nil :underline ,red))))
(js3-external-variable-face ((,class (:foreground ,purple))))
(js3-function-param-face ((,class (:foreground ,blue))))
(js3-jsdoc-tag-face ((,class (:foreground ,orange))))
(js3-jsdoc-type-face ((,class (:foreground ,aqua))))
(js3-jsdoc-value-face ((,class (:foreground ,yellow))))
(js3-jsdoc-html-tag-name-face ((,class (:foreground ,blue))))
(js3-jsdoc-html-tag-delimiter-face ((,class (:foreground ,green))))
(js3-instance-member-face ((,class (:foreground ,blue))))
(js3-private-function-call-face ((,class (:foreground ,red))))
;; nxml
(nxml-name-face ((,class (:foreground unspecified :inherit font-lock-constant-face))))
(nxml-attribute-local-name-face ((,class (:foreground unspecified :inherit font-lock-variable-name-face))))
(nxml-ref-face ((,class (:foreground unspecified :inherit font-lock-preprocessor-face))))
(nxml-delimiter-face ((,class (:foreground unspecified :inherit font-lock-keyword-face))))
(nxml-delimited-data-face ((,class (:foreground unspecified :inherit font-lock-string-face))))
(rng-error-face ((,class (:underline ,red))))
;; RHTML
(erb-delim-face ((,class (:background ,current-line))))
(erb-exec-face ((,class (:background ,current-line :weight bold))))
(erb-exec-delim-face ((,class (:background ,current-line))))
(erb-out-face ((,class (:background ,current-line :weight bold))))
(erb-out-delim-face ((,class (:background ,current-line))))
(erb-comment-face ((,class (:background ,current-line :weight bold :slant italic))))
(erb-comment-delim-face ((,class (:background ,current-line))))
;; Message-mode
(message-header-other ((,class (:foreground nil :background nil :weight normal))))
(message-header-subject ((,class (:inherit message-header-other :weight bold :foreground ,yellow))))
(message-header-to ((,class (:inherit message-header-other :weight bold :foreground ,orange))))
(message-header-cc ((,class (:inherit message-header-to :foreground nil))))
(message-header-name ((,class (:foreground ,blue :background nil))))
(message-header-newsgroups ((,class (:foreground ,aqua :background nil :slant normal))))
(message-separator ((,class (:foreground ,purple))))
;; Jabber
(jabber-chat-prompt-local ((,class (:foreground ,yellow))))
(jabber-chat-prompt-foreign ((,class (:foreground ,orange))))
(jabber-chat-prompt-system ((,class (:foreground ,yellow :weight bold))))
(jabber-chat-text-local ((,class (:foreground ,yellow))))
(jabber-chat-text-foreign ((,class (:foreground ,orange))))
(jabber-chat-text-error ((,class (:foreground ,red))))
(jabber-roster-user-online ((,class (:foreground ,green))))
(jabber-roster-user-xa ((,class :foreground ,comment)))
(jabber-roster-user-dnd ((,class :foreground ,yellow)))
(jabber-roster-user-away ((,class (:foreground ,orange))))
(jabber-roster-user-chatty ((,class (:foreground ,purple))))
(jabber-roster-user-error ((,class (:foreground ,red))))
(jabber-roster-user-offline ((,class (:foreground ,comment))))
(jabber-rare-time-face ((,class (:foreground ,comment))))
(jabber-activity-face ((,class (:foreground ,purple))))
(jabber-activity-personal-face ((,class (:foreground ,aqua))))
;; Gnus
(gnus-cite-1 ((,class (:inherit outline-1 :foreground nil))))
(gnus-cite-2 ((,class (:inherit outline-2 :foreground nil))))
(gnus-cite-3 ((,class (:inherit outline-3 :foreground nil))))
(gnus-cite-4 ((,class (:inherit outline-4 :foreground nil))))
(gnus-cite-5 ((,class (:inherit outline-5 :foreground nil))))
(gnus-cite-6 ((,class (:inherit outline-6 :foreground nil))))
(gnus-cite-7 ((,class (:inherit outline-7 :foreground nil))))
(gnus-cite-8 ((,class (:inherit outline-8 :foreground nil))))
;; there are several more -cite- faces...
(gnus-header-content ((,class (:inherit message-header-other))))
(gnus-header-subject ((,class (:inherit message-header-subject))))
(gnus-header-from ((,class (:inherit message-header-other-face :weight bold :foreground ,orange))))
(gnus-header-name ((,class (:inherit message-header-name))))
(gnus-button ((,class (:inherit link :foreground nil))))
(gnus-signature ((,class (:inherit font-lock-comment-face))))
(gnus-summary-normal-unread ((,class (:foreground ,blue :weight normal))))
(gnus-summary-normal-read ((,class (:foreground ,foreground :weight normal))))
(gnus-summary-normal-ancient ((,class (:foreground ,aqua :weight normal))))
(gnus-summary-normal-ticked ((,class (:foreground ,orange :weight normal))))
(gnus-summary-low-unread ((,class (:foreground ,comment :weight normal))))
(gnus-summary-low-read ((,class (:foreground ,comment :weight normal))))
(gnus-summary-low-ancient ((,class (:foreground ,comment :weight normal))))
(gnus-summary-high-unread ((,class (:foreground ,yellow :weight normal))))
(gnus-summary-high-read ((,class (:foreground ,green :weight normal))))
(gnus-summary-high-ancient ((,class (:foreground ,green :weight normal))))
(gnus-summary-high-ticked ((,class (:foreground ,orange :weight normal))))
(gnus-summary-cancelled ((,class (:foreground ,red :background nil :weight normal))))
(gnus-group-mail-low ((,class (:foreground ,comment))))
(gnus-group-mail-low-empty ((,class (:foreground ,comment))))
(gnus-group-mail-1 ((,class (:foreground nil :weight normal :inherit outline-1))))
(gnus-group-mail-2 ((,class (:foreground nil :weight normal :inherit outline-2))))
(gnus-group-mail-3 ((,class (:foreground nil :weight normal :inherit outline-3))))
(gnus-group-mail-4 ((,class (:foreground nil :weight normal :inherit outline-4))))
(gnus-group-mail-5 ((,class (:foreground nil :weight normal :inherit outline-5))))
(gnus-group-mail-6 ((,class (:foreground nil :weight normal :inherit outline-6))))
(gnus-group-mail-1-empty ((,class (:inherit gnus-group-mail-1 :foreground ,comment))))
(gnus-group-mail-2-empty ((,class (:inherit gnus-group-mail-2 :foreground ,comment))))
(gnus-group-mail-3-empty ((,class (:inherit gnus-group-mail-3 :foreground ,comment))))
(gnus-group-mail-4-empty ((,class (:inherit gnus-group-mail-4 :foreground ,comment))))
(gnus-group-mail-5-empty ((,class (:inherit gnus-group-mail-5 :foreground ,comment))))
(gnus-group-mail-6-empty ((,class (:inherit gnus-group-mail-6 :foreground ,comment))))
(gnus-group-news-1 ((,class (:foreground nil :weight normal :inherit outline-5))))
(gnus-group-news-2 ((,class (:foreground nil :weight normal :inherit outline-6))))
(gnus-group-news-3 ((,class (:foreground nil :weight normal :inherit outline-7))))
(gnus-group-news-4 ((,class (:foreground nil :weight normal :inherit outline-8))))
(gnus-group-news-5 ((,class (:foreground nil :weight normal :inherit outline-1))))
(gnus-group-news-6 ((,class (:foreground nil :weight normal :inherit outline-2))))
(gnus-group-news-1-empty ((,class (:inherit gnus-group-news-1 :foreground ,comment))))
(gnus-group-news-2-empty ((,class (:inherit gnus-group-news-2 :foreground ,comment))))
(gnus-group-news-3-empty ((,class (:inherit gnus-group-news-3 :foreground ,comment))))
(gnus-group-news-4-empty ((,class (:inherit gnus-group-news-4 :foreground ,comment))))
(gnus-group-news-5-empty ((,class (:inherit gnus-group-news-5 :foreground ,comment))))
(gnus-group-news-6-empty ((,class (:inherit gnus-group-news-6 :foreground ,comment))))
(erc-direct-msg-face ((,class (:foreground ,orange))))
(erc-error-face ((,class (:foreground ,red))))
(erc-header-face ((,class (:foreground ,foreground :background ,selection))))
(erc-input-face ((,class (:foreground ,green))))
(erc-keyword-face ((,class (:foreground ,yellow))))
(erc-current-nick-face ((,class (:foreground ,green))))
(erc-my-nick-face ((,class (:foreground ,green))))
(erc-nick-default-face ((,class (:weight normal :foreground ,purple))))
(erc-nick-msg-face ((,class (:weight normal :foreground ,yellow))))
(erc-notice-face ((,class (:foreground ,comment))))
(erc-pal-face ((,class (:foreground ,orange))))
(erc-prompt-face ((,class (:foreground ,blue))))
(erc-timestamp-face ((,class (:foreground ,aqua))))
(custom-variable-tag ((,class (:foreground ,blue))))
(custom-group-tag ((,class (:foreground ,blue))))
(custom-state ((,class (:foreground ,green))))
)))
(defmacro color-theme-tomorrow--frame-parameter-specs ()
"Return a backquote which defines a list of frame parameter specs.
These are required by color-theme's `color-theme-install', but
not by the new `deftheme' mechanism. It expects to be evaluated
in a scope in which the various color names to which it refers
are bound."
(quote
`(((background-color . ,background)
(background-mode . light)
(border-color . ,foreground)
(cursor-color . ,purple)
(foreground-color . ,foreground)
(mouse-color . ,aqua)))))
(defun color-theme-tomorrow--theme-name (mode)
(intern (format "tomorrow-%s" (symbol-name mode))))
(defmacro color-theme-tomorrow--define-theme (mode)
"Define a theme for the tomorrow variant `MODE'."
(let ((name (color-theme-tomorrow--theme-name mode))
(doc (format "tomorrow-%s" mode)))
`(progn
(deftheme ,name ,doc)
(color-theme-tomorrow--with-colors
',mode
(apply 'custom-theme-set-faces ',name
(color-theme-tomorrow--face-specs))
(custom-theme-set-variables
',name
`(fci-rule-color ,current-line)
`(ansi-color-names-vector (vector ,foreground ,red ,green ,yellow ,blue ,purple ,aqua ,background))
'(ansi-color-faces-vector [default bold shadow italic underline bold bold-italic bold])))
(provide-theme ',name))))
(defun color-theme-tomorrow-real (mode)
"Apply the tomorrow variant theme."
(if (fboundp 'load-theme)
(let ((name (color-theme-tomorrow--theme-name mode)))
(if (> emacs-major-version 23)
(load-theme name t)
(load-theme name)))
(progn
(require 'color-theme)
(color-theme-tomorrow--with-colors
mode
(color-theme-install
`(,(intern (concat "color-theme-tomorrow-" (symbol-name mode)))
,@(color-theme-tomorrow--frame-parameter-specs)
,@(color-theme-tomorrow--face-specs)))
;; ansi-color - comint and other modes that handle terminal color escape sequences
(setq ansi-color-names-vector (vector foreground red green yellow blue purple aqua background))
(setq ansi-color-faces-vector [default bold shadow italic underline bold bold-italic bold])))))
;;;###autoload
(when (boundp 'custom-theme-load-path)
(add-to-list 'custom-theme-load-path
(file-name-as-directory (file-name-directory load-file-name))))
;;;###autoload
(defun color-theme-tomorrow-night ()
(interactive)
(color-theme-tomorrow-real 'night))
;;;###autoload
(defun color-theme-tomorrow ()
(interactive)
(color-theme-tomorrow-real 'day))
;;;###autoload
(defun color-theme-tomorrow-night-bright ()
(interactive)
(color-theme-tomorrow-real 'night-bright))
;;;###autoload
(defun color-theme-tomorrow-night-eighties ()
(interactive)
(color-theme-tomorrow-real 'night-eighties))
;;;###autoload
(defun color-theme-tomorrow-night-blue ()
(interactive)
(color-theme-tomorrow-real 'night-blue))
(provide 'color-theme-tomorrow)
;; Local Variables:
;; byte-compile-warnings: (not cl-functions)
;; End:
;;; color-theme-tomorrow.el ends here

2
conf/emacs.d/themes/tomorrow-day-theme.el Normal file
View File

@ -0,0 +1,2 @@
(require 'color-theme-tomorrow)
(color-theme-tomorrow--define-theme day)

2
conf/emacs.d/themes/tomorrow-night-blue-theme.el Normal file
View File

@ -0,0 +1,2 @@
(require 'color-theme-tomorrow)
(color-theme-tomorrow--define-theme night-blue)

2
conf/emacs.d/themes/tomorrow-night-bright-theme.el Normal file
View File

@ -0,0 +1,2 @@
(require 'color-theme-tomorrow)
(color-theme-tomorrow--define-theme night-bright)

2
conf/emacs.d/themes/tomorrow-night-eighties-theme.el Normal file
View File

@ -0,0 +1,2 @@
(require 'color-theme-tomorrow)
(color-theme-tomorrow--define-theme night-eighties)

2
conf/emacs.d/themes/tomorrow-night-theme.el Normal file
View File

@ -0,0 +1,2 @@
(require 'color-theme-tomorrow)
(color-theme-tomorrow--define-theme night)