aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2013-07-11 20:54:57 -0700
committerGlenn Morris2013-07-11 20:54:57 -0700
commit539a920cda27cad65e298535ec082aa52e86daa2 (patch)
tree5f86925daa5b06b3f8b7ece87cfec3d20ff30afa
parentbacba3c26522ef297662bace31947d3e4f47c87a (diff)
downloademacs-539a920cda27cad65e298535ec082aa52e86daa2.tar.gz
emacs-539a920cda27cad65e298535ec082aa52e86daa2.zip
Remove some more reimplementations of cl-lib functions
* lisp/doc-view.el: Require cl-lib at runtime too. (doc-view-remove-if): Remove. (doc-view-search-next-match, doc-view-search-previous-match): Use cl-remove-if. * lisp/edmacro.el: Require cl-lib at runtime too. (edmacro-format-keys, edmacro-parse-keys): Use cl-mismatch, cl-subseq. (edmacro-mismatch, edmacro-subseq): Remove. * lisp/filesets.el: Comments. * lisp/shadowfile.el: Require cl-lib. (shadow-remove-if): Remove. (shadow-set-cluster, shadow-shadows-of-1, shadow-remove-from-todo): Use cl-remove-if. * lisp/wid-edit.el: Require cl-lib. (widget-choose): Use cl-remove-if. (widget-remove-if): Remove. * lisp/progmodes/ebrowse.el: Require cl-lib at runtime too. (ebrowse-delete-if-not): Remove. (ebrowse-browser-buffer-list, ebrowse-member-buffer-list) (ebrowse-tree-buffer-list, ebrowse-same-tree-member-buffer-list): Use cl-delete-if-not.
-rw-r--r--lisp/ChangeLog26
-rw-r--r--lisp/doc-view.el14
-rw-r--r--lisp/edmacro.el73
-rw-r--r--lisp/filesets.el6
-rw-r--r--lisp/progmodes/ebrowse.el23
-rw-r--r--lisp/shadowfile.el23
-rw-r--r--lisp/wid-edit.el11
7 files changed, 59 insertions, 117 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fabbfdf1737..c9957d29911 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,29 @@
12013-07-12 Glenn Morris <rgm@gnu.org>
2
3 * doc-view.el: Require cl-lib at runtime too.
4 (doc-view-remove-if): Remove.
5 (doc-view-search-next-match, doc-view-search-previous-match):
6 Use cl-remove-if.
7
8 * edmacro.el: Require cl-lib at runtime too.
9 (edmacro-format-keys, edmacro-parse-keys): Use cl-mismatch, cl-subseq.
10 (edmacro-mismatch, edmacro-subseq): Remove.
11
12 * shadowfile.el: Require cl-lib.
13 (shadow-remove-if): Remove.
14 (shadow-set-cluster, shadow-shadows-of-1, shadow-remove-from-todo):
15 Use cl-remove-if.
16
17 * wid-edit.el: Require cl-lib.
18 (widget-choose): Use cl-remove-if.
19 (widget-remove-if): Remove.
20
21 * progmodes/ebrowse.el: Require cl-lib at runtime too.
22 (ebrowse-delete-if-not): Remove.
23 (ebrowse-browser-buffer-list, ebrowse-member-buffer-list)
24 (ebrowse-tree-buffer-list, ebrowse-same-tree-member-buffer-list):
25 Use cl-delete-if-not.
26
12013-07-12 Juanma Barranquero <lekktu@gmail.com> 272013-07-12 Juanma Barranquero <lekktu@gmail.com>
2 28
3 * emacs-lisp/cl-macs.el (cl-multiple-value-bind, cl-multiple-value-setq) 29 * emacs-lisp/cl-macs.el (cl-multiple-value-bind, cl-multiple-value-setq)
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index e4434c3a0d8..10968f7f8dd 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -136,7 +136,7 @@
136 136
137;;; Code: 137;;; Code:
138 138
139(eval-when-compile (require 'cl-lib)) 139(require 'cl-lib)
140(require 'dired) 140(require 'dired)
141(require 'image-mode) 141(require 'image-mode)
142(require 'jka-compr) 142(require 'jka-compr)
@@ -698,14 +698,6 @@ It's a subdirectory of `doc-view-cache-directory'."
698 (md5 (current-buffer))))) 698 (md5 (current-buffer)))))
699 doc-view-cache-directory))))) 699 doc-view-cache-directory)))))
700 700
701(defun doc-view-remove-if (predicate list)
702 "Return LIST with all items removed that satisfy PREDICATE."
703 (let (new-list)
704 (dolist (item list)
705 (when (not (funcall predicate item))
706 (setq new-list (cons item new-list))))
707 (nreverse new-list)))
708
709;;;###autoload 701;;;###autoload
710(defun doc-view-mode-p (type) 702(defun doc-view-mode-p (type)
711 "Return non-nil if document type TYPE is available for `doc-view'. 703 "Return non-nil if document type TYPE is available for `doc-view'.
@@ -1488,7 +1480,7 @@ If BACKWARD is non-nil, jump to the previous match."
1488(defun doc-view-search-next-match (arg) 1480(defun doc-view-search-next-match (arg)
1489 "Go to the ARGth next matching page." 1481 "Go to the ARGth next matching page."
1490 (interactive "p") 1482 (interactive "p")
1491 (let* ((next-pages (doc-view-remove-if 1483 (let* ((next-pages (cl-remove-if
1492 (lambda (i) (<= (car i) (doc-view-current-page))) 1484 (lambda (i) (<= (car i) (doc-view-current-page)))
1493 doc-view--current-search-matches)) 1485 doc-view--current-search-matches))
1494 (page (car (nth (1- arg) next-pages)))) 1486 (page (car (nth (1- arg) next-pages))))
@@ -1502,7 +1494,7 @@ If BACKWARD is non-nil, jump to the previous match."
1502(defun doc-view-search-previous-match (arg) 1494(defun doc-view-search-previous-match (arg)
1503 "Go to the ARGth previous matching page." 1495 "Go to the ARGth previous matching page."
1504 (interactive "p") 1496 (interactive "p")
1505 (let* ((prev-pages (doc-view-remove-if 1497 (let* ((prev-pages (cl-remove-if
1506 (lambda (i) (>= (car i) (doc-view-current-page))) 1498 (lambda (i) (>= (car i) (doc-view-current-page)))
1507 doc-view--current-search-matches)) 1499 doc-view--current-search-matches))
1508 (page (car (nth (1- arg) (nreverse prev-pages))))) 1500 (page (car (nth (1- arg) (nreverse prev-pages)))))
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 6ef2e29dc83..67992d16527 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -62,9 +62,8 @@
62;; macro in a more concise way that omits the comments. 62;; macro in a more concise way that omits the comments.
63 63
64;;; Code: 64;;; Code:
65
66(eval-when-compile (require 'cl-lib))
67 65
66(require 'cl-lib)
68(require 'kmacro) 67(require 'kmacro)
69 68
70;;; The user-level commands for editing macros. 69;;; The user-level commands for editing macros.
@@ -444,14 +443,14 @@ doubt, use whitespace."
444 (let* ((prefix 443 (let* ((prefix
445 (or (and (integerp (aref rest-mac 0)) 444 (or (and (integerp (aref rest-mac 0))
446 (memq (aref rest-mac 0) mdigs) 445 (memq (aref rest-mac 0) mdigs)
447 (memq (key-binding (edmacro-subseq rest-mac 0 1)) 446 (memq (key-binding (cl-subseq rest-mac 0 1))
448 '(digit-argument negative-argument)) 447 '(digit-argument negative-argument))
449 (let ((i 1)) 448 (let ((i 1))
450 (while (memq (aref rest-mac i) (cdr mdigs)) 449 (while (memq (aref rest-mac i) (cdr mdigs))
451 (cl-incf i)) 450 (cl-incf i))
452 (and (not (memq (aref rest-mac i) pkeys)) 451 (and (not (memq (aref rest-mac i) pkeys))
453 (prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ") 452 (prog1 (vconcat "M-" (cl-subseq rest-mac 0 i) " ")
454 (cl-callf edmacro-subseq rest-mac i))))) 453 (cl-callf cl-subseq rest-mac i)))))
455 (and (eq (aref rest-mac 0) ?\C-u) 454 (and (eq (aref rest-mac 0) ?\C-u)
456 (eq (key-binding [?\C-u]) 'universal-argument) 455 (eq (key-binding [?\C-u]) 'universal-argument)
457 (let ((i 1)) 456 (let ((i 1))
@@ -459,7 +458,7 @@ doubt, use whitespace."
459 (cl-incf i)) 458 (cl-incf i))
460 (and (not (memq (aref rest-mac i) pkeys)) 459 (and (not (memq (aref rest-mac i) pkeys))
461 (prog1 (cl-loop repeat i concat "C-u ") 460 (prog1 (cl-loop repeat i concat "C-u ")
462 (cl-callf edmacro-subseq rest-mac i))))) 461 (cl-callf cl-subseq rest-mac i)))))
463 (and (eq (aref rest-mac 0) ?\C-u) 462 (and (eq (aref rest-mac 0) ?\C-u)
464 (eq (key-binding [?\C-u]) 'universal-argument) 463 (eq (key-binding [?\C-u]) 'universal-argument)
465 (let ((i 1)) 464 (let ((i 1))
@@ -469,18 +468,18 @@ doubt, use whitespace."
469 '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) 468 '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
470 (cl-incf i)) 469 (cl-incf i))
471 (and (not (memq (aref rest-mac i) pkeys)) 470 (and (not (memq (aref rest-mac i) pkeys))
472 (prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ") 471 (prog1 (vconcat "C-u " (cl-subseq rest-mac 1 i) " ")
473 (cl-callf edmacro-subseq rest-mac i))))))) 472 (cl-callf cl-subseq rest-mac i)))))))
474 (bind-len (apply 'max 1 473 (bind-len (apply 'max 1
475 (cl-loop for map in maps 474 (cl-loop for map in maps
476 for b = (lookup-key map rest-mac) 475 for b = (lookup-key map rest-mac)
477 when b collect b))) 476 when b collect b)))
478 (key (edmacro-subseq rest-mac 0 bind-len)) 477 (key (cl-subseq rest-mac 0 bind-len))
479 (fkey nil) tlen tkey 478 (fkey nil) tlen tkey
480 (bind (or (cl-loop for map in maps for b = (lookup-key map key) 479 (bind (or (cl-loop for map in maps for b = (lookup-key map key)
481 thereis (and (not (integerp b)) b)) 480 thereis (and (not (integerp b)) b))
482 (and (setq fkey (lookup-key local-function-key-map rest-mac)) 481 (and (setq fkey (lookup-key local-function-key-map rest-mac))
483 (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen) 482 (setq tlen fkey tkey (cl-subseq rest-mac 0 tlen)
484 fkey (lookup-key local-function-key-map tkey)) 483 fkey (lookup-key local-function-key-map tkey))
485 (cl-loop for map in maps 484 (cl-loop for map in maps
486 for b = (lookup-key map fkey) 485 for b = (lookup-key map fkey)
@@ -507,7 +506,7 @@ doubt, use whitespace."
507 (> first 32) (<= first maxkey) (/= first 92) 506 (> first 32) (<= first maxkey) (/= first 92)
508 (progn 507 (progn
509 (if (> text 30) (setq text 30)) 508 (if (> text 30) (setq text 30))
510 (setq desc (concat (edmacro-subseq rest-mac 0 text))) 509 (setq desc (concat (cl-subseq rest-mac 0 text)))
511 (when (string-match "^[ACHMsS]-." desc) 510 (when (string-match "^[ACHMsS]-." desc)
512 (setq text 2) 511 (setq text 2)
513 (cl-callf substring desc 0 2)) 512 (cl-callf substring desc 0 2))
@@ -524,7 +523,7 @@ doubt, use whitespace."
524 (> text bind-len) 523 (> text bind-len)
525 (memq (aref rest-mac text) '(return 13)) 524 (memq (aref rest-mac text) '(return 13))
526 (progn 525 (progn
527 (setq desc (concat (edmacro-subseq rest-mac bind-len text))) 526 (setq desc (concat (cl-subseq rest-mac bind-len text)))
528 (commandp (intern-soft desc)))) 527 (commandp (intern-soft desc))))
529 (if (commandp (intern-soft desc)) (setq bind desc)) 528 (if (commandp (intern-soft desc)) (setq bind desc))
530 (setq desc (format "<<%s>>" desc)) 529 (setq desc (format "<<%s>>" desc))
@@ -562,14 +561,14 @@ doubt, use whitespace."
562 (setq desc (concat (edmacro-sanitize-for-string prefix) desc))) 561 (setq desc (concat (edmacro-sanitize-for-string prefix) desc)))
563 (unless (string-match " " desc) 562 (unless (string-match " " desc)
564 (let ((times 1) (pos bind-len)) 563 (let ((times 1) (pos bind-len))
565 (while (not (edmacro-mismatch rest-mac rest-mac 564 (while (not (cl-mismatch rest-mac rest-mac
566 0 bind-len pos (+ bind-len pos))) 565 0 bind-len pos (+ bind-len pos)))
567 (cl-incf times) 566 (cl-incf times)
568 (cl-incf pos bind-len)) 567 (cl-incf pos bind-len))
569 (when (> times 1) 568 (when (> times 1)
570 (setq desc (format "%d*%s" times desc)) 569 (setq desc (format "%d*%s" times desc))
571 (setq bind-len (* bind-len times))))) 570 (setq bind-len (* bind-len times)))))
572 (setq rest-mac (edmacro-subseq rest-mac bind-len)) 571 (setq rest-mac (cl-subseq rest-mac bind-len))
573 (if verbose 572 (if verbose
574 (progn 573 (progn
575 (unless (equal res "") (cl-callf concat res "\n")) 574 (unless (equal res "") (cl-callf concat res "\n"))
@@ -590,50 +589,6 @@ doubt, use whitespace."
590 (cl-incf len (length desc))))) 589 (cl-incf len (length desc)))))
591 res)) 590 res))
592 591
593(defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2)
594 "Compare SEQ1 with SEQ2, return index of first mismatching element.
595Return nil if the sequences match. If one sequence is a prefix of the
596other, the return value indicates the end of the shorted sequence.
597\n(fn SEQ1 SEQ2 START1 END1 START2 END2)"
598 (or cl-end1 (setq cl-end1 (length cl-seq1)))
599 (or cl-end2 (setq cl-end2 (length cl-seq2)))
600 (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
601 (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
602 (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
603 (eql (if cl-p1 (car cl-p1)
604 (aref cl-seq1 cl-start1))
605 (if cl-p2 (car cl-p2)
606 (aref cl-seq2 cl-start2))))
607 (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
608 cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
609 (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
610 cl-start1)))
611
612(defun edmacro-subseq (seq start &optional end)
613 "Return the subsequence of SEQ from START to END.
614If END is omitted, it defaults to the length of the sequence.
615If START or END is negative, it counts from the end."
616 (if (stringp seq) (substring seq start end)
617 (let (len)
618 (and end (< end 0) (setq end (+ end (setq len (length seq)))))
619 (if (< start 0) (setq start (+ start (or len (setq len (length seq))))))
620 (cond ((listp seq)
621 (if (> start 0) (setq seq (nthcdr start seq)))
622 (if end
623 (let ((res nil))
624 (while (>= (setq end (1- end)) start)
625 (push (pop seq) res))
626 (nreverse res))
627 (copy-sequence seq)))
628 (t
629 (or end (setq end (or len (length seq))))
630 (let ((res (make-vector (max (- end start) 0) nil))
631 (i 0))
632 (while (< start end)
633 (aset res i (aref seq start))
634 (setq i (1+ i) start (1+ start)))
635 res))))))
636
637(defun edmacro-sanitize-for-string (seq) 592(defun edmacro-sanitize-for-string (seq)
638 "Convert a key sequence vector SEQ into a string. 593 "Convert a key sequence vector SEQ into a string.
639The string represents the same events; Meta is indicated by bit 7. 594The string represents the same events; Meta is indicated by bit 7.
@@ -760,7 +715,7 @@ This function assumes that the events can be stored in a string."
760 (eq (aref res 1) ?\() 715 (eq (aref res 1) ?\()
761 (eq (aref res (- (length res) 2)) ?\C-x) 716 (eq (aref res (- (length res) 2)) ?\C-x)
762 (eq (aref res (- (length res) 1)) ?\))) 717 (eq (aref res (- (length res) 1)) ?\)))
763 (setq res (edmacro-subseq res 2 -2))) 718 (setq res (cl-subseq res 2 -2)))
764 (if (and (not need-vector) 719 (if (and (not need-vector)
765 (cl-loop for ch across res 720 (cl-loop for ch across res
766 always (and (characterp ch) 721 always (and (characterp ch)
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 978512bd3a4..fbf28dbecbc 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -149,7 +149,7 @@ is loaded before custom.el, set this variable to t.")
149(defun filesets-filter-list (lst cond-fn) 149(defun filesets-filter-list (lst cond-fn)
150 "Remove all elements not conforming to COND-FN from list LST. 150 "Remove all elements not conforming to COND-FN from list LST.
151COND-FN takes one argument: the current element." 151COND-FN takes one argument: the current element."
152; (remove* 'dummy lst :test (lambda (dummy elt) 152; (cl-remove 'dummy lst :test (lambda (dummy elt)
153; (not (funcall cond-fn elt))))) 153; (not (funcall cond-fn elt)))))
154 (let ((rv nil)) 154 (let ((rv nil))
155 (dolist (elt lst rv) 155 (dolist (elt lst rv)
@@ -175,7 +175,7 @@ Like `some', return the first value of FSS-PRED that is non-nil."
175 (let ((fss-rv (funcall fss-pred fss-this))) 175 (let ((fss-rv (funcall fss-pred fss-this)))
176 (when fss-rv 176 (when fss-rv
177 (throw 'exit fss-rv)))))) 177 (throw 'exit fss-rv))))))
178;(fset 'filesets-some 'some) ;; or use the cl function 178;(fset 'filesets-some 'cl-some) ;; or use the cl function
179 179
180(defun filesets-member (fsm-item fsm-lst &rest fsm-keys) 180(defun filesets-member (fsm-item fsm-lst &rest fsm-keys)
181 "Find the first occurrence of FSM-ITEM in FSM-LST. 181 "Find the first occurrence of FSM-ITEM in FSM-LST.
@@ -186,7 +186,7 @@ key is supported."
186 (filesets-ormap (lambda (fsm-this) 186 (filesets-ormap (lambda (fsm-this)
187 (funcall fsm-test fsm-item fsm-this)) 187 (funcall fsm-test fsm-item fsm-this))
188 fsm-lst))) 188 fsm-lst)))
189;(fset 'filesets-member 'member*) ;; or use the cl function 189;(fset 'filesets-member 'cl-member) ;; or use the cl function
190 190
191(defun filesets-sublist (lst beg &optional end) 191(defun filesets-sublist (lst beg &optional end)
192 "Get the sublist of LST from BEG to END - 1." 192 "Get the sublist of LST from BEG to END - 1."
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index 4957b58d469..6a71ab330a8 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -33,12 +33,12 @@
33 33
34;;; Code: 34;;; Code:
35 35
36(require 'cl-lib)
36(require 'easymenu) 37(require 'easymenu)
37(require 'view) 38(require 'view)
38(require 'ebuff-menu) 39(require 'ebuff-menu)
39 40
40(eval-when-compile 41(eval-when-compile
41 (require 'cl-lib)
42 (require 'helper)) 42 (require 'helper))
43 43
44 44
@@ -233,19 +233,6 @@ Compare items with `eq' or TEST if specified."
233 found)) 233 found))
234 234
235 235
236(defun ebrowse-delete-if-not (predicate list)
237 "Remove elements not satisfying PREDICATE from LIST and return the result.
238This is a destructive operation."
239 (let (result)
240 (while list
241 (let ((next (cdr list)))
242 (when (funcall predicate (car list))
243 (setq result (nconc result list))
244 (setf (cdr list) nil))
245 (setq list next)))
246 result))
247
248
249(defmacro ebrowse-output (&rest body) 236(defmacro ebrowse-output (&rest body)
250 "Eval BODY with a writable current buffer. 237 "Eval BODY with a writable current buffer.
251Preserve buffer's modified state." 238Preserve buffer's modified state."
@@ -1310,17 +1297,17 @@ With PREFIX, insert that many filenames."
1310 1297
1311(defun ebrowse-browser-buffer-list () 1298(defun ebrowse-browser-buffer-list ()
1312 "Return a list of all tree or member buffers." 1299 "Return a list of all tree or member buffers."
1313 (ebrowse-delete-if-not 'ebrowse-buffer-p (buffer-list))) 1300 (cl-delete-if-not 'ebrowse-buffer-p (buffer-list)))
1314 1301
1315 1302
1316(defun ebrowse-member-buffer-list () 1303(defun ebrowse-member-buffer-list ()
1317 "Return a list of all member buffers." 1304 "Return a list of all member buffers."
1318 (ebrowse-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) 1305 (cl-delete-if-not 'ebrowse-member-buffer-p (buffer-list)))
1319 1306
1320 1307
1321(defun ebrowse-tree-buffer-list () 1308(defun ebrowse-tree-buffer-list ()
1322 "Return a list of all tree buffers." 1309 "Return a list of all tree buffers."
1323 (ebrowse-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) 1310 (cl-delete-if-not 'ebrowse-tree-buffer-p (buffer-list)))
1324 1311
1325 1312
1326(defun ebrowse-known-class-trees-buffer-list () 1313(defun ebrowse-known-class-trees-buffer-list ()
@@ -1341,7 +1328,7 @@ one buffer. Prefer tree buffers over member buffers."
1341 1328
1342(defun ebrowse-same-tree-member-buffer-list () 1329(defun ebrowse-same-tree-member-buffer-list ()
1343 "Return a list of members buffers with same tree as current buffer." 1330 "Return a list of members buffers with same tree as current buffer."
1344 (ebrowse-delete-if-not 1331 (cl-delete-if-not
1345 (lambda (buffer) 1332 (lambda (buffer)
1346 (eq (buffer-local-value 'ebrowse--tree buffer) 1333 (eq (buffer-local-value 'ebrowse--tree buffer)
1347 ebrowse--tree)) 1334 ebrowse--tree))
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index ec6e6e7ff10..3e7789069f9 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -74,6 +74,7 @@
74 74
75;;; Code: 75;;; Code:
76 76
77(require 'cl-lib)
77(require 'ange-ftp) 78(require 'ange-ftp)
78 79
79;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 80;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -180,15 +181,6 @@ created by `shadow-define-regexp-group'.")
180 (setq list (cdr list))) 181 (setq list (cdr list)))
181 (car list)) 182 (car list))
182 183
183(defun shadow-remove-if (func list)
184 "Remove elements satisfying FUNC from LIST.
185Nondestructive; actually returns a copy of the list with the elements removed."
186 (if list
187 (if (funcall func (car list))
188 (shadow-remove-if func (cdr list))
189 (cons (car list) (shadow-remove-if func (cdr list))))
190 nil))
191
192(defun shadow-regexp-superquote (string) 184(defun shadow-regexp-superquote (string)
193 "Like `regexp-quote', but includes the ^ and $. 185 "Like `regexp-quote', but includes the ^ and $.
194This makes sure regexp matches nothing but STRING." 186This makes sure regexp matches nothing but STRING."
@@ -238,9 +230,8 @@ instead."
238Replace old definition, if any. PRIMARY and REGEXP are the 230Replace old definition, if any. PRIMARY and REGEXP are the
239information defining the cluster. For interactive use, call 231information defining the cluster. For interactive use, call
240`shadow-define-cluster' instead." 232`shadow-define-cluster' instead."
241 (let ((rest (shadow-remove-if 233 (let ((rest (cl-remove-if (lambda (x) (equal name (car x)))
242 (function (lambda (x) (equal name (car x)))) 234 shadow-clusters)))
243 shadow-clusters)))
244 (setq shadow-clusters 235 (setq shadow-clusters
245 (cons (shadow-make-cluster name primary regexp) 236 (cons (shadow-make-cluster name primary regexp)
246 rest)))) 237 rest))))
@@ -602,9 +593,8 @@ and to are absolute file names."
602Consider them as regular expressions if third arg REGEXP is true." 593Consider them as regular expressions if third arg REGEXP is true."
603 (if groups 594 (if groups
604 (let ((nonmatching 595 (let ((nonmatching
605 (shadow-remove-if 596 (cl-remove-if (lambda (x) (shadow-file-match x file regexp))
606 (function (lambda (x) (shadow-file-match x file regexp))) 597 (car groups))))
607 (car groups))))
608 (append (cond ((equal nonmatching (car groups)) nil) 598 (append (cond ((equal nonmatching (car groups)) nil)
609 (regexp 599 (regexp
610 (let ((realname (nth 2 (shadow-parse-fullname file)))) 600 (let ((realname (nth 2 (shadow-parse-fullname file))))
@@ -635,8 +625,7 @@ Consider them as regular expressions if third arg REGEXP is true."
635 "Remove PAIR from `shadow-files-to-copy'. 625 "Remove PAIR from `shadow-files-to-copy'.
636PAIR must be `eq' to one of the elements of that list." 626PAIR must be `eq' to one of the elements of that list."
637 (setq shadow-files-to-copy 627 (setq shadow-files-to-copy
638 (shadow-remove-if (function (lambda (s) (eq s pair))) 628 (cl-remove-if (lambda (s) (eq s pair)) shadow-files-to-copy)))
639 shadow-files-to-copy)))
640 629
641(defun shadow-read-files () 630(defun shadow-read-files ()
642 "Visit and load `shadow-info-file' and `shadow-todo-file'. 631 "Visit and load `shadow-info-file' and `shadow-todo-file'.
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 2dc1e502171..b351d896911 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -55,6 +55,7 @@
55;; See `widget.el'. 55;; See `widget.el'.
56 56
57;;; Code: 57;;; Code:
58(require 'cl-lib)
58 59
59;;; Compatibility. 60;;; Compatibility.
60 61
@@ -221,7 +222,7 @@ minibuffer."
221 ((or widget-menu-minibuffer-flag 222 ((or widget-menu-minibuffer-flag
222 (> (length items) widget-menu-max-shortcuts)) 223 (> (length items) widget-menu-max-shortcuts))
223 ;; Read the choice of name from the minibuffer. 224 ;; Read the choice of name from the minibuffer.
224 (setq items (widget-remove-if 'stringp items)) 225 (setq items (cl-remove-if 'stringp items))
225 (let ((val (completing-read (concat title ": ") items nil t))) 226 (let ((val (completing-read (concat title ": ") items nil t)))
226 (if (stringp val) 227 (if (stringp val)
227 (let ((try (try-completion val items))) 228 (let ((try (try-completion val items)))
@@ -295,14 +296,6 @@ minibuffer."
295 (error "Canceled")) 296 (error "Canceled"))
296 value)))) 297 value))))
297 298
298(defun widget-remove-if (predicate list)
299 (let (result (tail list))
300 (while tail
301 (or (funcall predicate (car tail))
302 (setq result (cons (car tail) result)))
303 (setq tail (cdr tail)))
304 (nreverse result)))
305
306;;; Widget text specifications. 299;;; Widget text specifications.
307;; 300;;
308;; These functions are for specifying text properties. 301;; These functions are for specifying text properties.