geiser-base.el (2856B)
1 ;;; geiser-base.el --- shared bits 2 3 ;; Copyright (C) 2009, 2010, 2012, 2013, 2015, 2016, 2019 Jose Antonio Ortega Ruiz 4 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>. 9 10 ;; Settings and vars shared by all geiser modules, including little 11 ;; utilities and emacsen compatibility bits. 12 13 14 ;;; Code: 15 ;;; Emacs compatibility: 16 17 (require 'ring) 18 19 (eval-after-load "ring" 20 '(when (not (fboundp 'ring-member)) 21 (defun ring-member (ring item) 22 (catch 'found 23 (dotimes (ind (ring-length ring) nil) 24 (when (equal item (ring-ref ring ind)) 25 (throw 'found ind))))))) 26 27 (when (not (fboundp 'looking-at-p)) 28 (defsubst looking-at-p (regexp) 29 (with-no-warnings 30 (let ((inhibit-changing-match-data t)) 31 (looking-at regexp))))) 32 33 (defalias 'geiser--font-lock-ensure 34 (if (fboundp 'font-lock-ensure) 35 #'font-lock-ensure 36 (with-no-warnings 37 (lambda (&optional _beg _end) 38 (when font-lock-mode 39 (font-lock-fontify-buffer)))))) 40 41 ;;; Utilities: 42 43 (defsubst geiser--chomp (str) 44 (if (string-match-p ".*\n$" str) (substring str 0 -1) str)) 45 46 (defun geiser--shorten-str (str len &optional sep) 47 (let ((str-len (length str))) 48 (if (<= str-len len) 49 str 50 (let* ((sep (or sep " ... ")) 51 (sep-len (length sep)) 52 (prefix-len (/ (- str-len sep-len) 2)) 53 (prefix (substring str 0 prefix-len)) 54 (suffix (substring str (- str-len prefix-len)))) 55 (format "%s%s%s" prefix sep suffix))))) 56 57 (defun geiser--region-to-string (begin &optional end) 58 (let ((end (or end (point)))) 59 (when (< begin end) 60 (let* ((str (buffer-substring-no-properties begin end)) 61 (pieces (split-string str nil t))) 62 (mapconcat 'identity pieces " "))))) 63 64 (defun geiser--insert-with-face (str face) 65 (let ((p (point))) 66 (insert str) 67 (put-text-property p (point) 'face face))) 68 69 70 (defmacro geiser--save-msg (&rest body) 71 (let ((msg (make-symbol "msg"))) 72 `(let ((,msg (current-message))) 73 ,@body 74 (message ,msg)))) 75 76 (put 'geiser--save-msg 'lisp-indent-function 0) 77 78 (defun geiser--del-dups (lst) 79 (let (result) 80 (dolist (e lst (nreverse result)) 81 (unless (member e result) (push e result))))) 82 83 (defsubst geiser--symbol-at-point () 84 (let ((thing (thing-at-point 'symbol))) 85 (and thing (make-symbol thing)))) 86 87 (defun geiser--cut-version (v) 88 (when (string-match "\\([0-9]+\\(?:\\.[0-9]+\\)*\\).*" v) 89 (match-string 1 v))) 90 91 (defun geiser--version< (v1 v2) 92 (let ((v1 (geiser--cut-version v1)) 93 (v2 (geiser--cut-version v2))) 94 (and v1 v2 (version< v1 v2)))) 95 96 (provide 'geiser-base)