racket: indentation for module*
[geiser.git] / elisp / geiser-base.el
blob2569034fedd7e7f84ab8ed4198866866ad1ebb14
1 ;;; geiser-base.el --- shared bits
3 ;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz
5 ;; This program is free software; you can redistribute it and/or
6 ;; modify it under the terms of the Modified BSD License. You should
7 ;; have received a copy of the license along with this program. If
8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
12 ;; Settings and vars shared by all geiser modules, including little
13 ;; utilities and emacsen compatibility bits.
15 ;;; Emacs compatibility:
17 (eval-after-load "ring"
18 '(when (not (fboundp 'ring-member))
19 (defun ring-member (ring item)
20 (catch 'found
21 (dotimes (ind (ring-length ring) nil)
22 (when (equal item (ring-ref ring ind))
23 (throw 'found ind)))))))
25 (when (not (fboundp 'looking-at-p))
26 (defsubst looking-at-p (regexp)
27 (let ((inhibit-changing-match-data t))
28 (looking-at regexp))))
31 ;;; Utilities:
33 (defsubst geiser--chomp (str)
34 (if (string-match-p ".*\n$" str) (substring str 0 -1) str))
36 (defun geiser--shorten-str (str len &optional sep)
37 (let ((str-len (length str)))
38 (if (<= str-len len)
39 str
40 (let* ((sep (or sep " ... "))
41 (sep-len (length sep))
42 (prefix-len (/ (- str-len sep-len) 2))
43 (prefix (substring str 0 prefix-len))
44 (suffix (substring str (- str-len prefix-len))))
45 (format "%s%s%s" prefix sep suffix)))))
47 (defun geiser--region-to-string (begin &optional end)
48 (let ((end (or end (point))))
49 (when (< begin end)
50 (let* ((str (buffer-substring-no-properties begin end))
51 (pieces (split-string str nil t)))
52 (mapconcat 'identity pieces " ")))))
54 (defun geiser--insert-with-face (str face)
55 (let ((p (point)))
56 (insert str)
57 (put-text-property p (point) 'face face)))
60 (defmacro geiser--save-msg (&rest body)
61 (let ((msg (make-symbol "msg")))
62 `(let ((,msg (current-message)))
63 ,@body
64 (message ,msg))))
66 (put 'geiser--save-msg 'lisp-indent-function 0)
68 (defun geiser--del-dups (lst)
69 (let (result)
70 (dolist (e lst (nreverse result))
71 (unless (member e result) (push e result)))))
73 (defsubst geiser--symbol-at-point ()
74 (let ((thing (thing-at-point 'symbol)))
75 (and thing (make-symbol thing))))
78 (provide 'geiser-base)