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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
;;; cider-compat.el --- Functions from newer Emacs versions for compatibility -*- lexical-binding: t -*-
;; Copyright © 2012-2016 Tim King, Phil Hagelberg
;; Copyright © 2013-2016 Bozhidar Batsov, Hugo Duncan, Steve Purcell
;;
;; 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/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Pretty much everything here's copied from subr-x for compatibility with
;; Emacs 24.3 and 24.4.
;;; Code:
(eval-and-compile
(unless (fboundp 'thread-first )
(defmacro internal--thread-argument (first? &rest forms)
"Internal implementation for `thread-first' and `thread-last'.
When Argument FIRST? is non-nil argument is threaded first, else
last. FORMS are the expressions to be threaded."
(pcase forms
(`(,x (,f . ,args) . ,rest)
`(internal--thread-argument
,first? ,(if first? `(,f ,x ,@args) `(,f ,@args ,x)) ,@rest))
(`(,x ,f . ,rest) `(internal--thread-argument ,first? (,f ,x) ,@rest))
(_ (car forms))))
(defmacro thread-first (&rest forms)
"Thread FORMS elements as the first argument of their successor.
Example:
(thread-first
5
(+ 20)
(/ 25)
-
(+ 40))
Is equivalent to:
(+ (- (/ (+ 5 20) 25)) 40)
Note how the single `-' got converted into a list before
threading."
(declare (indent 1)
(debug (form &rest [&or symbolp (sexp &rest form)])))
`(internal--thread-argument t ,@forms)))
(unless (fboundp 'thread-last )
(defmacro thread-last (&rest forms)
"Thread FORMS elements as the last argument of their successor.
Example:
(thread-last
5
(+ 20)
(/ 25)
-
(+ 40))
Is equivalent to:
(+ 40 (- (/ 25 (+ 20 5))))
Note how the single `-' got converted into a list before
threading."
(declare (indent 1) (debug thread-first))
`(internal--thread-argument nil ,@forms))))
(eval-and-compile
(unless (fboundp 'internal--listify)
(defsubst internal--listify (elt)
"Wrap ELT in a list if it is not one."
(if (not (listp elt))
(list elt)
elt)))
(unless (fboundp 'internal--check-binding)
(defsubst internal--check-binding (binding)
"Check BINDING is properly formed."
(when (> (length binding) 2)
(signal
'error
(cons "`let' bindings can have only one value-form" binding)))
binding))
(unless (fboundp 'internal--build-binding-value-form)
(defsubst internal--build-binding-value-form (binding prev-var)
"Build the conditional value form for BINDING using PREV-VAR."
`(,(car binding) (and ,prev-var ,(cadr binding)))))
(unless (fboundp 'internal--build-binding)
(defun internal--build-binding (binding prev-var)
"Check and build a single BINDING with PREV-VAR."
(thread-first
binding
internal--listify
internal--check-binding
(internal--build-binding-value-form prev-var))))
(unless (fboundp 'internal--build-bindings)
(defun internal--build-bindings (bindings)
"Check and build conditional value forms for BINDINGS."
(let ((prev-var t))
(mapcar (lambda (binding)
(let ((binding (internal--build-binding binding prev-var)))
(setq prev-var (car binding))
binding))
bindings)))))
(eval-and-compile
(unless (fboundp 'if-let)
(defmacro if-let (bindings then &rest else)
"Process BINDINGS and if all values are non-nil eval THEN, else ELSE.
Argument BINDINGS is a list of tuples whose car is a symbol to be
bound and (optionally) used in THEN, and its cadr is a sexp to be
evalled to set symbol's value. In the special case you only want
to bind a single value, BINDINGS can just be a plain tuple."
(declare (indent 2)
(debug ([&or (&rest (symbolp form)) (symbolp form)] form body)))
(when (and (<= (length bindings) 2)
(not (listp (car bindings))))
;; Adjust the single binding case
(setq bindings (list bindings)))
`(let* ,(internal--build-bindings bindings)
(if ,(car (internal--listify (car (last bindings))))
,then
,@else)))
(defmacro when-let (bindings &rest body)
"Process BINDINGS and if all values are non-nil eval BODY.
Argument BINDINGS is a list of tuples whose car is a symbol to be
bound and (optionally) used in BODY, and its cadr is a sexp to be
evalled to set symbol's value. In the special case you only want
to bind a single value, BINDINGS can just be a plain tuple."
(declare (indent 1) (debug if-let))
(list 'if-let bindings (macroexp-progn body)))))
(provide 'cider-compat)
;;; cider-compat.el ends here
|
