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
|
;;; geiser-base.el --- Shared bits -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2010, 2012, 2013, 2015, 2016, 2019, 2024 Jose Antonio Ortega Ruiz
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the Modified BSD License. You should
;; have received a copy of the license along with this program. If
;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
;;; Commentary:
;; Settings and variables shared by all geiser modules, including
;; little utilities and emacsen compatibility bits.
;;; Code:
;;; Emacs compatibility:
(require 'ring)
(unless (fboundp 'ring-member)
(defun ring-member (ring item)
(catch 'found
(dotimes (ind (ring-length ring))
(when (equal item (ring-ref ring ind))
(throw 'found ind))))))
(unless (fboundp 'looking-at-p)
(defsubst looking-at-p (regexp)
(with-no-warnings
(let ((inhibit-changing-match-data t))
(looking-at regexp)))))
(defalias 'geiser--font-lock-ensure
(if (fboundp 'font-lock-ensure)
#'font-lock-ensure
(with-no-warnings
(lambda (&optional _beg _end)
(when font-lock-mode
(font-lock-fontify-buffer))))))
;;; 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--save-msg (&rest body)
(let ((msg (make-symbol "msg")))
`(let ((,msg (current-message)))
,@body
(message "%s" ,msg))))
(put 'geiser--save-msg 'lisp-indent-function 0)
(defun geiser--del-dups (lst)
(let (result)
(dolist (e lst (nreverse result))
(unless (member e result) (push e result)))))
(defsubst geiser--symbol-at-point ()
(let ((thing (thing-at-point 'symbol)))
(and thing (make-symbol thing))))
(defun geiser--cut-version (v)
(when (string-match "\\([0-9]+\\(?:\\.[0-9]+\\)*\\).*" v)
(match-string 1 v)))
(defun geiser--version< (v1 v2)
(let ((v1 (geiser--cut-version v1))
(v2 (geiser--cut-version v2)))
(and v1 v2 (version< v1 v2))))
(provide 'geiser-base)
|
