ghc-mod/elisp/ghc-func.el

88 lines
2.2 KiB
EmacsLisp
Raw Normal View History

2010-01-06 05:38:06 +00:00
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ghc-func.el
;;;
;; Author: Kazu Yamamoto <Kazu@Mew.org>
;; Created: Sep 25, 2009
;;; Code:
2010-05-04 07:35:40 +00:00
(defvar ghc-module-command "ghc-mod")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2010-01-06 05:38:06 +00:00
(defun ghc-replace-character (string from to)
"Replace characters equal to FROM to TO in STRING."
2010-03-10 07:51:42 +00:00
(let ((ret (copy-sequence string)))
(dotimes (cnt (length ret) ret)
(if (char-equal (aref ret cnt) from)
(aset ret cnt to)))))
2010-01-06 05:38:06 +00:00
2010-05-04 07:35:40 +00:00
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro ghc-add (sym val)
`(setq ,sym (cons ,val ,sym)))
(defun ghc-set (vars vals)
(dolist (var vars)
(if var (set var (car vals))) ;; var can be nil to skip
(setq vals (cdr vals))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2010-05-04 08:52:16 +00:00
(defun ghc-filter (pred lst)
(let (ret)
(dolist (x lst (reverse ret))
(if (funcall pred x) (ghc-add ret x)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2010-01-06 05:38:06 +00:00
(defun ghc-which (cmd)
(catch 'loop
2010-03-30 03:05:35 +00:00
(dolist (suffix '("" ".exe"))
(let ((cmds (concat cmd suffix)))
(dolist (dir exec-path)
(let ((path (expand-file-name cmds dir)))
(if (file-exists-p path)
(throw 'loop path))))))))
2010-01-06 05:38:06 +00:00
2010-05-04 07:35:40 +00:00
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2010-01-06 05:38:06 +00:00
(defun ghc-uniq-lol (lol)
(let ((hash (make-hash-table :test 'equal))
ret)
(dolist (lst lol)
(dolist (key lst)
(puthash key key hash)))
2010-05-04 07:35:40 +00:00
(maphash (lambda (key val) (ghc-add ret key)) hash)
2010-01-06 05:38:06 +00:00
ret))
2010-05-04 07:35:40 +00:00
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2010-01-06 05:38:06 +00:00
(defun ghc-read-lisp (func)
(with-temp-buffer
(funcall func)
(goto-char (point-min))
(condition-case nil
(read (current-buffer))
(error ()))))
2010-05-04 03:49:22 +00:00
(defun ghc-read-lisp-list (func n)
(with-temp-buffer
(funcall func)
(goto-char (point-min))
(condition-case nil
(let ((m (set-marker (make-marker) 1 (current-buffer)))
ret)
2010-05-04 08:52:16 +00:00
(dotimes (i n (nreverse ret))
(ghc-add ret (read m))))
2010-05-04 03:49:22 +00:00
(error ()))))
2010-05-06 06:29:55 +00:00
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst ghc-null 0)
(defconst ghc-newline 10)
2010-01-06 05:38:06 +00:00
(provide 'ghc-func)