forked from FG42/FG42
Rails support added, with tomorrow theme
This commit is contained in:
parent
7fe81704e9
commit
8e3362f944
34
conf/dotkuso
34
conf/dotkuso
|
@ -9,12 +9,11 @@
|
||||||
(global-linum-mode)
|
(global-linum-mode)
|
||||||
|
|
||||||
;; Setting up color them -------------------------------------------------------
|
;; Setting up color them -------------------------------------------------------
|
||||||
(require 'color-theme)
|
|
||||||
(eval-after-load "color-theme"
|
(eval-after-load "color-theme"
|
||||||
'(progn
|
'(progn
|
||||||
(color-theme-initialize)
|
(color-theme-initialize)
|
||||||
(color-theme-arjen)
|
(color-theme-tomorrow-night-eighties)
|
||||||
))
|
))
|
||||||
|
|
||||||
;; Setting up customization -----------------------------------------------------
|
;; Setting up customization -----------------------------------------------------
|
||||||
(custom-set-variables
|
(custom-set-variables
|
||||||
|
@ -270,3 +269,32 @@ l;; css flymake ----------------------------------------------------------------
|
||||||
(global-set-key (kbd "C-x p") 'git-gutter:previous-diff)
|
(global-set-key (kbd "C-x p") 'git-gutter:previous-diff)
|
||||||
(global-set-key (kbd "C-x n") 'git-gutter:next-diff)
|
(global-set-key (kbd "C-x n") 'git-gutter:next-diff)
|
||||||
;;/git-gutter;;
|
;;/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