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>.
10 ;; Settings and vars shared by all geiser modules, including little
11 ;; utilities and emacsen compatibility bits.
13 ;;; Emacs compatibility:
17 (eval-after-load "ring"
18 '(when (not (fboundp 'ring-member
))
19 (defun ring-member (ring item
)
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
))))
32 (defsubst geiser--chomp
(str)
33 (if (string-match-p ".*\n$" str
) (substring str
0 -
1) str
))
35 (defun geiser--shorten-str (str len
&optional sep
)
36 (let ((str-len (length str
)))
39 (let* ((sep (or sep
" ... "))
40 (sep-len (length sep
))
41 (prefix-len (/ (- str-len sep-len
) 2))
42 (prefix (substring str
0 prefix-len
))
43 (suffix (substring str
(- str-len prefix-len
))))
44 (format "%s%s%s" prefix sep suffix
)))))
46 (defun geiser--region-to-string (begin &optional end
)
47 (let ((end (or end
(point))))
49 (let* ((str (buffer-substring-no-properties begin end
))
50 (pieces (split-string str nil t
)))
51 (mapconcat 'identity pieces
" ")))))
53 (defun geiser--insert-with-face (str face
)
56 (put-text-property p
(point) 'face face
)))
59 (defmacro geiser--save-msg
(&rest body
)
60 (let ((msg (make-symbol "msg")))
61 `(let ((,msg
(current-message)))
65 (put 'geiser--save-msg
'lisp-indent-function
0)
67 (defun geiser--del-dups (lst)
69 (dolist (e lst
(nreverse result
))
70 (unless (member e result
) (push e result
)))))
72 (defsubst geiser--symbol-at-point
()
73 (let ((thing (thing-at-point 'symbol
)))
74 (and thing
(make-symbol thing
))))
76 (defun geiser--cut-version (v)
77 (when (string-match "\\([0-9]+\\(?:\\.[0-9]+\\)*\\).*" v
)
80 (defun geiser--version< (v1 v2
)
81 (let ((v1 (geiser--cut-version v1
))
82 (v2 (geiser--cut-version v2
)))
83 (and v1 v2
(version< v1 v2
))))
85 (provide 'geiser-base
)