rails-lib.el
1 ;;; rails-lib.el --- 2 3 ;; Copyright (C) 2006 Dmitry Galinsky <dima dot exe at gmail dot com> 4 5 ;; Authors: Dmitry Galinsky <dima dot exe at gmail dot com>, 6 ;; Rezikov Peter <crazypit13 (at) gmail.com> 7 ;; Howard Yeh <hayeah at gmail dot com> 8 9 ;; Keywords: ruby rails languages oop 10 ;; $URL: svn://rubyforge.org/var/svn/emacs-rails/trunk/rails-lib.el $ 11 ;; $Id: rails-lib.el 168 2007-04-06 19:10:55Z dimaexe $ 12 13 ;;; License 14 15 ;; This program is free software; you can redistribute it and/or 16 ;; modify it under the terms of the GNU General Public License 17 ;; as published by the Free Software Foundation; either version 2 18 ;; of the License, or (at your option) any later version. 19 20 ;; This program is distributed in the hope that it will be useful, 21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 23 ;; GNU General Public License for more details. 24 25 ;; You should have received a copy of the GNU General Public License 26 ;; along with this program; if not, write to the Free Software 27 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 28 29 ;;; Code: 30 31 (defun rails-lib:run-primary-switch () 32 "Run the primary switch function." 33 (interactive) 34 (if rails-primary-switch-func 35 (apply rails-primary-switch-func nil))) 36 37 (defun rails-lib:run-secondary-switch () 38 "Run the secondary switch function." 39 (interactive) 40 (if rails-secondary-switch-func 41 (apply rails-secondary-switch-func nil))) 42 43 ;;;;; Non Rails realted helper functions ;;;;; 44 45 ;; Syntax macro 46 47 (defmacro* when-bind ((var expr) &rest body) 48 "Binds VAR to the result of EXPR. 49 If EXPR is not nil exeutes BODY. 50 51 (when-bind (var (func foo)) 52 (do-somth (with var)))." 53 `(let ((,var ,expr)) 54 (when ,var 55 ,@body))) 56 57 ;; Lists 58 59 (defun list->alist (list) 60 "Convert ((a . b) c d) to ((a . b) (c . c) (d . d))." 61 (mapcar 62 #'(lambda (el) 63 (if (listp el) el(cons el el))) 64 list)) 65 66 (defun uniq-list (list) 67 "Return a list of unique elements." 68 (let ((result '())) 69 (dolist (elem list) 70 (when (not (member elem result)) 71 (push elem result))) 72 (nreverse result))) 73 74 ;; Strings 75 76 (defun string-repeat (char num) 77 (let ((len num) 78 (str "")) 79 (while (not (zerop len)) 80 (setq len (- len 1)) 81 (setq str (concat char str))) 82 str)) 83 84 85 (defmacro string=~ (regex string &rest body) 86 "regex matching similar to the =~ operator found in other languages." 87 (let ((str (gensym))) 88 `(lexical-let ((,str ,string)) 89 ;; Use lexical-let to make closures (in flet). 90 (when (string-match ,regex ,str) 91 (symbol-macrolet ,(loop for i to 9 collect 92 (let ((sym (intern (concat "$" (number-to-string i))))) 93 `(,sym (match-string ,i ,str)))) 94 (flet (($ (i) (match-string i ,str)) 95 (sub (replacement &optional (i 0) &key fixedcase literal-string) 96 (replace-match replacement fixedcase literal-string ,str i))) 97 (symbol-macrolet ( ;;before 98 ($b (substring ,str 0 (match-beginning 0))) 99 ;;match 100 ($m (match-string 0 ,str)) 101 ;;after 102 ($a (substring ,str (match-end 0) (length ,str)))) 103 ,@body))))))) 104 105 (defun string-not-empty (str) ;(+) 106 "Return t if string STR is not empty." 107 (and (stringp str) (not (or (string-equal "" str) 108 (string-match "^ +$" str))))) 109 110 (defun yml-value (name) 111 "Return the value of the parameter named NAME in the current 112 buffer or an empty string." 113 (save-excursion 114 (goto-char (point-min)) 115 (if (search-forward-regexp (format "%s:[ ]*\\(.*\\)[ ]*$" name) nil t) 116 (match-string 1) 117 ""))) 118 119 (defun current-line-string () 120 "Return the string value of the current line." 121 (buffer-substring-no-properties 122 (progn (beginning-of-line) (point)) 123 (progn (end-of-line) (point)))) 124 125 (defun remove-prefix (word prefix) 126 "Remove the PREFIX string in WORD if it exists. 127 PrefixBla -> Bla." 128 (replace-regexp-in-string (format "^%s" prefix) "" word)) 129 130 (defun remove-postfix (word postfix) 131 "Remove the POSTFIX string in WORD if it exists. 132 BlaPostfix -> Bla." 133 (replace-regexp-in-string (format "%s$" postfix) "" word)) 134 135 (defun strings-join (separator strings) 136 "Join all STRINGS using a SEPARATOR." 137 (mapconcat 'identity strings separator)) 138 139 (defalias 'string-join 'strings-join) 140 141 (defun capital-word-p (word) 142 "Return t if first letter of WORD is uppercased." 143 (= (elt word 0) 144 (elt (capitalize word) 0))) 145 146 ;;;;;;;; def-snips stuff ;;;; 147 148 (defun snippet-abbrev-function-name (abbrev-table abbrev-name) 149 "Return the name of the snippet abbreviation function in the 150 ABBREV-TABLE for the abbreviation ABBREV-NAME." 151 (intern (concat "snippet-abbrev-" 152 (snippet-strip-abbrev-table-suffix 153 (symbol-name abbrev-table)) 154 "-" 155 abbrev-name))) 156 157 (defun snippet-menu-description-variable (table name) 158 "Return a variable for the menu description of the snippet ABBREV-NAME in ABBREV-TABLE." 159 (intern 160 (concat 161 (symbol-name (snippet-abbrev-function-name table name)) 162 "-menu-description"))) 163 164 (defmacro* def-snips ((&rest abbrev-tables) &rest snips) 165 "Generate snippets with menu documentaion in several ABBREV-TABLES. 166 167 (def-snip (some-mode-abbrev-table other-mode-abbrev-table) 168 (\"abbr\" \"some snip $${foo}\" \"menu documentation\") 169 (\"anabr\" \"other snip $${bar}\" \"menu documentation\") 170 " 171 `(progn 172 ,@(loop for table in abbrev-tables 173 collect 174 `(snippet-with-abbrev-table ',table 175 ,@(loop for (name template desc) in snips collect 176 `(,name . ,template))) 177 append 178 (loop for (name template desc) in snips collect 179 `(setf ,(snippet-menu-description-variable table name) 180 ,desc))))) 181 182 (defun snippet-menu-description (abbrev-table name) 183 "Return the menu descripton for the snippet named NAME in 184 ABBREV-TABLE." 185 (symbol-value (snippet-menu-description-variable abbrev-table name))) 186 187 (defun snippet-menu-line (abbrev-table name) 188 "Generate a menu line for the snippet NAME in ABBREV-TABLE." 189 (cons 190 (concat name "\t" (snippet-menu-description abbrev-table name)) 191 (lexical-let ((func-name (snippet-abbrev-function-name abbrev-table name))) 192 (lambda () (interactive) (funcall func-name))))) 193 194 ;;; Define keys 195 196 (defmacro define-keys (key-map &rest key-funcs) 197 "Define key bindings for KEY-MAP (create KEY-MAP, if it does 198 not exist." 199 `(progn 200 (unless (boundp ',key-map) 201 (setf ,key-map (make-keymap))) 202 ,@(mapcar 203 #'(lambda (key-func) 204 `(define-key ,key-map ,(first key-func) ,(second key-func))) 205 key-funcs))) 206 207 ;; Files 208 209 (defun append-string-to-file (file string) 210 "Append a string to end of a file." 211 (write-region string nil file t)) 212 213 (defun write-string-to-file (file string) 214 "Write a string to a file (erasing the previous content)." 215 (write-region string nil file)) 216 217 (defun read-from-file (file-name) 218 "Read sexpr from a file named FILE-NAME." 219 (with-temp-buffer 220 (insert-file-contents file-name) 221 (read (current-buffer)))) 222 223 ;; File hierarchy functions 224 225 (defun find-recursive-files (file-regexp directory) 226 "Return a list of files, found in DIRECTORY and match them to FILE-REGEXP." 227 (find-recursive-filter-out 228 find-recursive-exclude-files 229 (find-recursive-directory-relative-files directory "" file-regexp))) 230 231 (defun directory-name (path) 232 "Return the name of a directory with a given path. 233 For example, (path \"/foo/bar/baz/../\") returns bar." 234 ;; Rewrite me 235 (let ((old-path default-directory)) 236 (cd path) 237 (let ((dir (pwd))) 238 (cd old-path) 239 (replace-regexp-in-string "^Directory[ ]*" "" dir)))) 240 241 (defun find-or-ask-to-create (question file) 242 "Open file if it exists. If it does not exist, ask to create 243 it." 244 (if (file-exists-p file) 245 (find-file file) 246 (when (y-or-n-p question) 247 (when (string-match "\\(.*\\)/[^/]+$" file) 248 (make-directory (match-string 1 file) t)) 249 (find-file file)))) 250 251 (defun directory-of-file (file-name) 252 "Return the parent directory of a file named FILE-NAME." 253 (replace-regexp-in-string "[^/]*$" "" file-name)) 254 255 ;; Buffers 256 257 (defun buffer-string-by-name (buffer-name) 258 "Return the content of buffer named BUFFER-NAME as a string." 259 (interactive) 260 (save-excursion 261 (set-buffer buffer-name) 262 (buffer-string))) 263 264 (defun buffer-visible-p (buffer-name) 265 (if (get-buffer-window buffer-name) t nil)) 266 267 ;; Misc 268 269 (defun rails-browse-api-url (url) 270 "Browse preferentially with Emacs w3m browser." 271 (if rails-browse-api-with-w3m 272 (when (fboundp 'w3m-find-file) 273 (w3m-find-file (remove-prefix url "file://"))) 274 (rails-alternative-browse-url url))) 275 276 (defun rails-alternative-browse-url (url &rest args) 277 "Fix a problem with Internet Explorer not being able to load 278 URLs with anchors via ShellExecute. It will only be invoked it 279 the user explicit sets `rails-use-alternative-browse-url'." 280 (if (and (eq system-type 'windows-nt) rails-use-alternative-browse-url) 281 (w32-shell-execute "open" "iexplore" url) 282 (browse-url url args))) 283 284 ;; abbrev 285 ;; from http://www.opensource.apple.com/darwinsource/Current/emacs-59/emacs/lisp/derived.el 286 (defun merge-abbrev-tables (old new) 287 "Merge an old abbrev table into a new one. 288 This function requires internal knowledge of how abbrev tables work, 289 presuming that they are obarrays with the abbrev as the symbol, the expansion 290 as the value of the symbol, and the hook as the function definition." 291 (when old 292 (mapatoms 293 (lambda(it) 294 (or (intern-soft (symbol-name it) new) 295 (define-abbrev new 296 (symbol-name it) 297 (symbol-value it) 298 (symbol-function it) 299 nil 300 t))) 301 old))) 302 303 ;; Colorize 304 305 (defun apply-colorize-to-buffer (name) 306 (let ((buffer (current-buffer))) 307 (set-buffer name) 308 (make-local-variable 'after-change-functions) 309 (add-hook 'after-change-functions 310 '(lambda (start end len) 311 (ansi-color-apply-on-region start end))) 312 (set-buffer buffer))) 313 314 ;; completion-read 315 (defun rails-completing-read (prompt table history require-match) 316 (let ((history-value (symbol-value history))) 317 (list (completing-read 318 (format "%s?%s: " 319 prompt 320 (if (car history-value) 321 (format " (%s)" (car history-value)) 322 "")) 323 (list->alist table) ; table 324 nil ; predicate 325 require-match ; require-match 326 nil ; initial input 327 history ; hist 328 (car history-value))))) ;def 329 330 ;; MMM 331 332 ;; (defvar mmm-indent-sandbox-finish-position nil) 333 334 ;; (defun mmm-run-indent-with-sandbox (indent-func) 335 ;; (interactive) 336 ;; (let* ((fragment-name "*mmm-indent-sandbox*") 337 ;; (ovl (mmm-overlay-at (point))) 338 ;; (current (when ovl (overlay-buffer ovl))) 339 ;; (start (when ovl (overlay-start ovl))) 340 ;; (end (when ovl (overlay-end ovl))) 341 ;; (current-pos (when ovl (point))) 342 ;; (ovl-line-start (when start 343 ;; (progn (goto-char start) 344 ;; (line-beginning-position)))) 345 ;; (current-line-start (when current-pos 346 ;; (progn (goto-char current-pos) 347 ;; (line-beginning-position)))) 348 ;; (fragment-pos (when (and start end) (- (point) (- start 1)))) 349 ;; (ovl-offset (when ovl (- (progn 350 ;; (goto-char start) 351 ;; (while (not (looking-at "<")) 352 ;; (goto-char (- (point) 1))) 353 ;; (point)) 354 ;; ovl-line-start))) 355 ;; (content (when (and start end) (buffer-substring-no-properties start end))) 356 ;; (fragment (when content (get-buffer-create fragment-name)))) 357 ;; (when fragment 358 ;; (setq mmm-indent-sandbox-finish-position nil) 359 ;; (save-excursion 360 ;; (set-buffer fragment-name) 361 ;; (beginning-of-buffer) 362 ;; (insert content) 363 ;; (goto-char fragment-pos) 364 ;; (funcall indent-func t) 365 ;; (let ((start-line) 366 ;; (end-line) 367 ;; (kill-after-start) 368 ;; (finish-pos (- (+ start (point)) 1)) 369 ;; (indented (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) 370 ;; (set-buffer current) 371 ;; (kill-buffer fragment-name) 372 ;; (princ ovl-offset) 373 ;; (goto-char current-pos) 374 ;; (setq start-line (line-beginning-position)) 375 ;; (setq end-line (line-end-position)) 376 ;; (when (> start start-line) 377 ;; (setq start-line (+ start 1)) 378 ;; (setq kill-after-start t)) 379 ;; (when (> end-line end) 380 ;; (setq end-line end)) 381 ;; (kill-region start-line end-line) 382 ;; (goto-char start-line) 383 ;; (unless (= ovl-line-start current-line-start) 384 ;; (dotimes (i ovl-offset) 385 ;; (setq indented (concat " " indented)))) 386 ;; ;; (insert-char (string-to-char " ") ovl-offset)) 387 ;; (insert indented) 388 ;; (when kill-after-start 389 ;; (goto-char (+ start 1)) 390 ;; (backward-delete-char 1)) 391 ;; ;; (setq mmm-indent-sandbox-finish-position finish-pos))) 392 ;; (if (= ovl-line-start current-line-start) 393 ;; (setq mmm-indent-sandbox-finish-position finish-pos) 394 ;; (setq mmm-indent-sandbox-finish-position (+ finish-pos ovl-offset))))) 395 ;; (goto-char mmm-indent-sandbox-finish-position)))) 396 397 ;; (defadvice ruby-indent-line (around mmm-sandbox-ruby-indent-line) 398 ;; (if (and (fboundp 'mmm-overlay-at) 399 ;; (mmm-overlay-at (point))) 400 ;; (mmm-run-indent-with-sandbox 'ruby-indent-line) 401 ;; ad-do-it)) 402 ;; (ad-activate 'ruby-indent-line) 403 404 405 ;; Cross define functions from my rc files 406 407 (provide 'rails-lib)