diff options
| author | Glenn Morris | 2013-07-11 20:54:57 -0700 |
|---|---|---|
| committer | Glenn Morris | 2013-07-11 20:54:57 -0700 |
| commit | 539a920cda27cad65e298535ec082aa52e86daa2 (patch) | |
| tree | 5f86925daa5b06b3f8b7ece87cfec3d20ff30afa | |
| parent | bacba3c26522ef297662bace31947d3e4f47c87a (diff) | |
| download | emacs-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/ChangeLog | 26 | ||||
| -rw-r--r-- | lisp/doc-view.el | 14 | ||||
| -rw-r--r-- | lisp/edmacro.el | 73 | ||||
| -rw-r--r-- | lisp/filesets.el | 6 | ||||
| -rw-r--r-- | lisp/progmodes/ebrowse.el | 23 | ||||
| -rw-r--r-- | lisp/shadowfile.el | 23 | ||||
| -rw-r--r-- | lisp/wid-edit.el | 11 |
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 @@ | |||
| 1 | 2013-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 | |||
| 1 | 2013-07-12 Juanma Barranquero <lekktu@gmail.com> | 27 | 2013-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. | ||
| 595 | Return nil if the sequences match. If one sequence is a prefix of the | ||
| 596 | other, 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. | ||
| 614 | If END is omitted, it defaults to the length of the sequence. | ||
| 615 | If 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. |
| 639 | The string represents the same events; Meta is indicated by bit 7. | 594 | The 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. |
| 151 | COND-FN takes one argument: the current element." | 151 | COND-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. | ||
| 238 | This 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. |
| 251 | Preserve buffer's modified state." | 238 | Preserve 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. | ||
| 185 | Nondestructive; 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 $. |
| 194 | This makes sure regexp matches nothing but STRING." | 186 | This makes sure regexp matches nothing but STRING." |
| @@ -238,9 +230,8 @@ instead." | |||
| 238 | Replace old definition, if any. PRIMARY and REGEXP are the | 230 | Replace old definition, if any. PRIMARY and REGEXP are the |
| 239 | information defining the cluster. For interactive use, call | 231 | information 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." | |||
| 602 | Consider them as regular expressions if third arg REGEXP is true." | 593 | Consider 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'. |
| 636 | PAIR must be `eq' to one of the elements of that list." | 626 | PAIR 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. |