forked from FG42/FG42
Rails support added, with tomorrow theme
This commit is contained in:
parent
7fe81704e9
commit
8e3362f944
32
conf/dotkuso
32
conf/dotkuso
|
@ -9,11 +9,10 @@
|
|||
(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 -----------------------------------------------------
|
||||
|
@ -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)
|
||||
|
|
|
@ -1,5 +0,0 @@
|
|||
*.elc
|
||||
*~
|
||||
/TAGS
|
||||
/html-help/
|
||||
/info-help/
|
|
@ -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)
|
|
@ -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)
|
|
@ -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)
|
|
@ -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)
|
|
@ -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)
|
|
@ -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)
|
|
@ -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
|
|
@ -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)
|
|
@ -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
|
|
@ -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
|
|
@ -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'
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -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")
|
|
@ -0,0 +1,7 @@
|
|||
class Chicken
|
||||
|
||||
def gizzards
|
||||
|
||||
end
|
||||
|
||||
end
|
|
@ -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
|
|
@ -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
|
|
@ -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)
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
File diff suppressed because it is too large
Load Diff
|
@ -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
|
|
@ -0,0 +1,3 @@
|
|||
;; Note: don't auto-indent this; it needs to be badly-indented for the tests.
|
||||
(hello
|
||||
world)
|
|
@ -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)
|
|
@ -0,0 +1,2 @@
|
|||
(hello (world
|
||||
'elisp)
|
|
@ -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>"))
|
|
@ -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
|
|
@ -0,0 +1,2 @@
|
|||
(require 'color-theme-tomorrow)
|
||||
(color-theme-tomorrow--define-theme day)
|
|
@ -0,0 +1,2 @@
|
|||
(require 'color-theme-tomorrow)
|
||||
(color-theme-tomorrow--define-theme night-blue)
|
|
@ -0,0 +1,2 @@
|
|||
(require 'color-theme-tomorrow)
|
||||
(color-theme-tomorrow--define-theme night-bright)
|
|
@ -0,0 +1,2 @@
|
|||
(require 'color-theme-tomorrow)
|
||||
(color-theme-tomorrow--define-theme night-eighties)
|
|
@ -0,0 +1,2 @@
|
|||
(require 'color-theme-tomorrow)
|
||||
(color-theme-tomorrow--define-theme night)
|
Loading…
Reference in New Issue