From 539a920cda27cad65e298535ec082aa52e86daa2 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 11 Jul 2013 20:54:57 -0700 Subject: [PATCH] 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. --- lisp/ChangeLog | 26 +++++++++++++++++ lisp/doc-view.el | 14 ++------- lisp/edmacro.el | 73 +++++++++-------------------------------------- lisp/filesets.el | 6 ++-- lisp/progmodes/ebrowse.el | 23 ++++----------- lisp/shadowfile.el | 23 ++++----------- 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 @@ +2013-07-12 Glenn Morris + + * 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. + + * edmacro.el: Require cl-lib at runtime too. + (edmacro-format-keys, edmacro-parse-keys): Use cl-mismatch, cl-subseq. + (edmacro-mismatch, edmacro-subseq): Remove. + + * shadowfile.el: Require cl-lib. + (shadow-remove-if): Remove. + (shadow-set-cluster, shadow-shadows-of-1, shadow-remove-from-todo): + Use cl-remove-if. + + * wid-edit.el: Require cl-lib. + (widget-choose): Use cl-remove-if. + (widget-remove-if): Remove. + + * 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. + 2013-07-12 Juanma Barranquero * 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 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (require 'dired) (require 'image-mode) (require 'jka-compr) @@ -698,14 +698,6 @@ It's a subdirectory of `doc-view-cache-directory'." (md5 (current-buffer))))) doc-view-cache-directory))))) -(defun doc-view-remove-if (predicate list) - "Return LIST with all items removed that satisfy PREDICATE." - (let (new-list) - (dolist (item list) - (when (not (funcall predicate item)) - (setq new-list (cons item new-list)))) - (nreverse new-list))) - ;;;###autoload (defun doc-view-mode-p (type) "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." (defun doc-view-search-next-match (arg) "Go to the ARGth next matching page." (interactive "p") - (let* ((next-pages (doc-view-remove-if + (let* ((next-pages (cl-remove-if (lambda (i) (<= (car i) (doc-view-current-page))) doc-view--current-search-matches)) (page (car (nth (1- arg) next-pages)))) @@ -1502,7 +1494,7 @@ If BACKWARD is non-nil, jump to the previous match." (defun doc-view-search-previous-match (arg) "Go to the ARGth previous matching page." (interactive "p") - (let* ((prev-pages (doc-view-remove-if + (let* ((prev-pages (cl-remove-if (lambda (i) (>= (car i) (doc-view-current-page))) doc-view--current-search-matches)) (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 @@ ;; macro in a more concise way that omits the comments. ;;; Code: - -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) (require 'kmacro) ;;; The user-level commands for editing macros. @@ -444,14 +443,14 @@ doubt, use whitespace." (let* ((prefix (or (and (integerp (aref rest-mac 0)) (memq (aref rest-mac 0) mdigs) - (memq (key-binding (edmacro-subseq rest-mac 0 1)) + (memq (key-binding (cl-subseq rest-mac 0 1)) '(digit-argument negative-argument)) (let ((i 1)) (while (memq (aref rest-mac i) (cdr mdigs)) (cl-incf i)) (and (not (memq (aref rest-mac i) pkeys)) - (prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ") - (cl-callf edmacro-subseq rest-mac i))))) + (prog1 (vconcat "M-" (cl-subseq rest-mac 0 i) " ") + (cl-callf cl-subseq rest-mac i))))) (and (eq (aref rest-mac 0) ?\C-u) (eq (key-binding [?\C-u]) 'universal-argument) (let ((i 1)) @@ -459,7 +458,7 @@ doubt, use whitespace." (cl-incf i)) (and (not (memq (aref rest-mac i) pkeys)) (prog1 (cl-loop repeat i concat "C-u ") - (cl-callf edmacro-subseq rest-mac i))))) + (cl-callf cl-subseq rest-mac i))))) (and (eq (aref rest-mac 0) ?\C-u) (eq (key-binding [?\C-u]) 'universal-argument) (let ((i 1)) @@ -469,18 +468,18 @@ doubt, use whitespace." '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) (cl-incf i)) (and (not (memq (aref rest-mac i) pkeys)) - (prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ") - (cl-callf edmacro-subseq rest-mac i))))))) + (prog1 (vconcat "C-u " (cl-subseq rest-mac 1 i) " ") + (cl-callf cl-subseq rest-mac i))))))) (bind-len (apply 'max 1 (cl-loop for map in maps for b = (lookup-key map rest-mac) when b collect b))) - (key (edmacro-subseq rest-mac 0 bind-len)) + (key (cl-subseq rest-mac 0 bind-len)) (fkey nil) tlen tkey (bind (or (cl-loop for map in maps for b = (lookup-key map key) thereis (and (not (integerp b)) b)) (and (setq fkey (lookup-key local-function-key-map rest-mac)) - (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen) + (setq tlen fkey tkey (cl-subseq rest-mac 0 tlen) fkey (lookup-key local-function-key-map tkey)) (cl-loop for map in maps for b = (lookup-key map fkey) @@ -507,7 +506,7 @@ doubt, use whitespace." (> first 32) (<= first maxkey) (/= first 92) (progn (if (> text 30) (setq text 30)) - (setq desc (concat (edmacro-subseq rest-mac 0 text))) + (setq desc (concat (cl-subseq rest-mac 0 text))) (when (string-match "^[ACHMsS]-." desc) (setq text 2) (cl-callf substring desc 0 2)) @@ -524,7 +523,7 @@ doubt, use whitespace." (> text bind-len) (memq (aref rest-mac text) '(return 13)) (progn - (setq desc (concat (edmacro-subseq rest-mac bind-len text))) + (setq desc (concat (cl-subseq rest-mac bind-len text))) (commandp (intern-soft desc)))) (if (commandp (intern-soft desc)) (setq bind desc)) (setq desc (format "<<%s>>" desc)) @@ -562,14 +561,14 @@ doubt, use whitespace." (setq desc (concat (edmacro-sanitize-for-string prefix) desc))) (unless (string-match " " desc) (let ((times 1) (pos bind-len)) - (while (not (edmacro-mismatch rest-mac rest-mac + (while (not (cl-mismatch rest-mac rest-mac 0 bind-len pos (+ bind-len pos))) (cl-incf times) (cl-incf pos bind-len)) (when (> times 1) (setq desc (format "%d*%s" times desc)) (setq bind-len (* bind-len times))))) - (setq rest-mac (edmacro-subseq rest-mac bind-len)) + (setq rest-mac (cl-subseq rest-mac bind-len)) (if verbose (progn (unless (equal res "") (cl-callf concat res "\n")) @@ -590,50 +589,6 @@ doubt, use whitespace." (cl-incf len (length desc))))) res)) -(defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2) - "Compare SEQ1 with SEQ2, return index of first mismatching element. -Return nil if the sequences match. If one sequence is a prefix of the -other, the return value indicates the end of the shorted sequence. -\n(fn SEQ1 SEQ2 START1 END1 START2 END2)" - (or cl-end1 (setq cl-end1 (length cl-seq1))) - (or cl-end2 (setq cl-end2 (length cl-seq2))) - (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1))) - (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2)))) - (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) - (eql (if cl-p1 (car cl-p1) - (aref cl-seq1 cl-start1)) - (if cl-p2 (car cl-p2) - (aref cl-seq2 cl-start2)))) - (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2) - cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2))) - (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) - cl-start1))) - -(defun edmacro-subseq (seq start &optional end) - "Return the subsequence of SEQ from START to END. -If END is omitted, it defaults to the length of the sequence. -If START or END is negative, it counts from the end." - (if (stringp seq) (substring seq start end) - (let (len) - (and end (< end 0) (setq end (+ end (setq len (length seq))))) - (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) - (cond ((listp seq) - (if (> start 0) (setq seq (nthcdr start seq))) - (if end - (let ((res nil)) - (while (>= (setq end (1- end)) start) - (push (pop seq) res)) - (nreverse res)) - (copy-sequence seq))) - (t - (or end (setq end (or len (length seq)))) - (let ((res (make-vector (max (- end start) 0) nil)) - (i 0)) - (while (< start end) - (aset res i (aref seq start)) - (setq i (1+ i) start (1+ start))) - res)))))) - (defun edmacro-sanitize-for-string (seq) "Convert a key sequence vector SEQ into a string. 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." (eq (aref res 1) ?\() (eq (aref res (- (length res) 2)) ?\C-x) (eq (aref res (- (length res) 1)) ?\))) - (setq res (edmacro-subseq res 2 -2))) + (setq res (cl-subseq res 2 -2))) (if (and (not need-vector) (cl-loop for ch across res 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.") (defun filesets-filter-list (lst cond-fn) "Remove all elements not conforming to COND-FN from list LST. COND-FN takes one argument: the current element." -; (remove* 'dummy lst :test (lambda (dummy elt) +; (cl-remove 'dummy lst :test (lambda (dummy elt) ; (not (funcall cond-fn elt))))) (let ((rv nil)) (dolist (elt lst rv) @@ -175,7 +175,7 @@ Like `some', return the first value of FSS-PRED that is non-nil." (let ((fss-rv (funcall fss-pred fss-this))) (when fss-rv (throw 'exit fss-rv)))))) -;(fset 'filesets-some 'some) ;; or use the cl function +;(fset 'filesets-some 'cl-some) ;; or use the cl function (defun filesets-member (fsm-item fsm-lst &rest fsm-keys) "Find the first occurrence of FSM-ITEM in FSM-LST. @@ -186,7 +186,7 @@ key is supported." (filesets-ormap (lambda (fsm-this) (funcall fsm-test fsm-item fsm-this)) fsm-lst))) -;(fset 'filesets-member 'member*) ;; or use the cl function +;(fset 'filesets-member 'cl-member) ;; or use the cl function (defun filesets-sublist (lst beg &optional end) "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 @@ ;;; Code: +(require 'cl-lib) (require 'easymenu) (require 'view) (require 'ebuff-menu) (eval-when-compile - (require 'cl-lib) (require 'helper)) @@ -233,19 +233,6 @@ Compare items with `eq' or TEST if specified." found)) -(defun ebrowse-delete-if-not (predicate list) - "Remove elements not satisfying PREDICATE from LIST and return the result. -This is a destructive operation." - (let (result) - (while list - (let ((next (cdr list))) - (when (funcall predicate (car list)) - (setq result (nconc result list)) - (setf (cdr list) nil)) - (setq list next))) - result)) - - (defmacro ebrowse-output (&rest body) "Eval BODY with a writable current buffer. Preserve buffer's modified state." @@ -1310,17 +1297,17 @@ With PREFIX, insert that many filenames." (defun ebrowse-browser-buffer-list () "Return a list of all tree or member buffers." - (ebrowse-delete-if-not 'ebrowse-buffer-p (buffer-list))) + (cl-delete-if-not 'ebrowse-buffer-p (buffer-list))) (defun ebrowse-member-buffer-list () "Return a list of all member buffers." - (ebrowse-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) + (cl-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) (defun ebrowse-tree-buffer-list () "Return a list of all tree buffers." - (ebrowse-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) + (cl-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) (defun ebrowse-known-class-trees-buffer-list () @@ -1341,7 +1328,7 @@ one buffer. Prefer tree buffers over member buffers." (defun ebrowse-same-tree-member-buffer-list () "Return a list of members buffers with same tree as current buffer." - (ebrowse-delete-if-not + (cl-delete-if-not (lambda (buffer) (eq (buffer-local-value 'ebrowse--tree buffer) 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 @@ ;;; Code: +(require 'cl-lib) (require 'ange-ftp) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -180,15 +181,6 @@ created by `shadow-define-regexp-group'.") (setq list (cdr list))) (car list)) -(defun shadow-remove-if (func list) - "Remove elements satisfying FUNC from LIST. -Nondestructive; actually returns a copy of the list with the elements removed." - (if list - (if (funcall func (car list)) - (shadow-remove-if func (cdr list)) - (cons (car list) (shadow-remove-if func (cdr list)))) - nil)) - (defun shadow-regexp-superquote (string) "Like `regexp-quote', but includes the ^ and $. This makes sure regexp matches nothing but STRING." @@ -238,9 +230,8 @@ instead." Replace old definition, if any. PRIMARY and REGEXP are the information defining the cluster. For interactive use, call `shadow-define-cluster' instead." - (let ((rest (shadow-remove-if - (function (lambda (x) (equal name (car x)))) - shadow-clusters))) + (let ((rest (cl-remove-if (lambda (x) (equal name (car x))) + shadow-clusters))) (setq shadow-clusters (cons (shadow-make-cluster name primary regexp) rest)))) @@ -602,9 +593,8 @@ and to are absolute file names." Consider them as regular expressions if third arg REGEXP is true." (if groups (let ((nonmatching - (shadow-remove-if - (function (lambda (x) (shadow-file-match x file regexp))) - (car groups)))) + (cl-remove-if (lambda (x) (shadow-file-match x file regexp)) + (car groups)))) (append (cond ((equal nonmatching (car groups)) nil) (regexp (let ((realname (nth 2 (shadow-parse-fullname file)))) @@ -635,8 +625,7 @@ Consider them as regular expressions if third arg REGEXP is true." "Remove PAIR from `shadow-files-to-copy'. PAIR must be `eq' to one of the elements of that list." (setq shadow-files-to-copy - (shadow-remove-if (function (lambda (s) (eq s pair))) - shadow-files-to-copy))) + (cl-remove-if (lambda (s) (eq s pair)) shadow-files-to-copy))) (defun shadow-read-files () "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 @@ ;; See `widget.el'. ;;; Code: +(require 'cl-lib) ;;; Compatibility. @@ -221,7 +222,7 @@ minibuffer." ((or widget-menu-minibuffer-flag (> (length items) widget-menu-max-shortcuts)) ;; Read the choice of name from the minibuffer. - (setq items (widget-remove-if 'stringp items)) + (setq items (cl-remove-if 'stringp items)) (let ((val (completing-read (concat title ": ") items nil t))) (if (stringp val) (let ((try (try-completion val items))) @@ -295,14 +296,6 @@ minibuffer." (error "Canceled")) value)))) -(defun widget-remove-if (predicate list) - (let (result (tail list)) - (while tail - (or (funcall predicate (car tail)) - (setq result (cons (car tail) result))) - (setq tail (cdr tail))) - (nreverse result))) - ;;; Widget text specifications. ;; ;; These functions are for specifying text properties. -- 2.11.4.GIT