blob: 4133245e74124c4bb95a809821c21081506be41c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
;;; geiser-base.el --- shared bits
;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
;; Keywords: languages, tools
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Settings and vars shared by all geiser modules, including little
;; utilities and emacsen compatibility bits.
;;; Code:
;;; Versioning:
(defconst geiser-version-major 0
"Geiser's major version number.")
(defconst geiser-version-minor 1
"Geiser's minor version number.")
(defun geiser-version-string ()
"Geiser's version as a string."
(format "%s.%s" geiser-version-major geiser-version-minor))
(defun geiser-version ()
"Echoes Geiser's version."
(interactive)
(message "Geiser %s" (geiser-version-string)))
;;; Emacs compatibility:
(eval-after-load "ring"
'(when (not (fboundp 'ring-member))
(defun ring-member (ring item)
(catch 'found
(dotimes (ind (ring-length ring) nil)
(when (equal item (ring-ref ring ind))
(throw 'found ind)))))))
(when (not (fboundp 'completion-table-dynamic))
(defun completion-table-dynamic (fun)
(require 'cl)
(lexical-let ((fun fun))
(lambda (string pred action)
(with-current-buffer (let ((win (minibuffer-selected-window)))
(if (window-live-p win) (window-buffer win)
(current-buffer)))
(complete-with-action action (funcall fun string) string pred))))))
(when (not (fboundp 'looking-at-p))
(defsubst looking-at-p (regexp)
(let ((inhibit-changing-match-data t))
(looking-at regexp))))
;;; Utilities:
(defsubst geiser--chomp (str)
(if (string-match-p ".*\n$" str) (substring str 0 -1) str))
(defun geiser--shorten-str (str len &optional sep)
(let ((str-len (length str)))
(if (<= str-len len)
str
(let* ((sep (or sep " ... "))
(sep-len (length sep))
(prefix-len (/ (- str-len sep-len) 2))
(prefix (substring str 0 prefix-len))
(suffix (substring str (- str-len prefix-len))))
(format "%s%s%s" prefix sep suffix)))))
(defun geiser--region-to-string (begin &optional end)
(let ((end (or end (point))))
(when (< begin end)
(let* ((str (buffer-substring-no-properties begin end))
(pieces (split-string str nil t)))
(mapconcat 'identity pieces " ")))))
(defun geiser--insert-with-face (str face)
(let ((p (point)))
(insert str)
(put-text-property p (point) 'face face)))
(defmacro geiser--scheme-indent (&rest pairs)
`(progn ,@(mapcar (lambda (p)
`(put ',(car p) 'scheme-indent-function ',(cadr p)))
pairs)))
(provide 'geiser-base)
;;; geiser-base.el ends here
|
