1 ;;; geiser-base.el --- shared bits
3 ;; Copyright (C) 2009, 2010, 2012, 2013, 2015 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:
19 (eval-after-load "ring"
20 '(when (not (fboundp 'ring-member
))
21 (defun ring-member (ring item
)
23 (dotimes (ind (ring-length ring
) nil
)
24 (when (equal item
(ring-ref ring ind
))
25 (throw 'found ind
)))))))
27 (when (not (fboundp 'looking-at-p
))
28 (defsubst looking-at-p
(regexp)
29 (let ((inhibit-changing-match-data t
))
30 (looking-at regexp
))))
35 (defsubst geiser--chomp
(str)
36 (if (string-match-p ".*\n$" str
) (substring str
0 -
1) str
))
38 (defun geiser--shorten-str (str len
&optional sep
)
39 (let ((str-len (length str
)))
42 (let* ((sep (or sep
" ... "))
43 (sep-len (length sep
))
44 (prefix-len (/ (- str-len sep-len
) 2))
45 (prefix (substring str
0 prefix-len
))
46 (suffix (substring str
(- str-len prefix-len
))))
47 (format "%s%s%s" prefix sep suffix
)))))
49 (defun geiser--region-to-string (begin &optional end
)
50 (let ((end (or end
(point))))
52 (let* ((str (buffer-substring-no-properties begin end
))
53 (pieces (split-string str nil t
)))
54 (mapconcat 'identity pieces
" ")))))
56 (defun geiser--insert-with-face (str face
)
59 (put-text-property p
(point) 'face face
)))
62 (defmacro geiser--save-msg
(&rest body
)
63 (let ((msg (make-symbol "msg")))
64 `(let ((,msg
(current-message)))
68 (put 'geiser--save-msg
'lisp-indent-function
0)
70 (defun geiser--del-dups (lst)
72 (dolist (e lst
(nreverse result
))
73 (unless (member e result
) (push e result
)))))
75 (defsubst geiser--symbol-at-point
()
76 (let ((thing (thing-at-point 'symbol
)))
77 (and thing
(make-symbol thing
))))
79 (defun geiser--cut-version (v)
80 (when (string-match "\\([0-9]+\\.[0-9]\\(?:\\.[0-9]+\\)?\\).*" v
)
83 (defun geiser--version< (v1 v2
)
84 (let ((v1 (geiser--cut-version v1
))
85 (v2 (geiser--cut-version v2
)))
86 (and v1 v2
(version< v1 v2
))))
89 (provide 'geiser-base
)