[Emacs-diffs] trunk r113385: Remove some more reimplementations of cl-lib functions

[Glenn Morris]

------------------------------------------------------------
revno: 113385
revision-id: address@hidden
parent: address@hidden
committer: Glenn Morris <address@hidden>
branch nick: trunk
timestamp: Thu 2013-07-11 20:54:57 -0700
message:
  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.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/doc-view.el               docview.el-20091113204419-o5vbwnq5f7feedwu-6334
  lisp/edmacro.el                edmacro.el-20091113204419-o5vbwnq5f7feedwu-146
  lisp/filesets.el               
filesets.el-20091113204419-o5vbwnq5f7feedwu-2414
  lisp/progmodes/ebrowse.el      ebrowse.el-20091113204419-o5vbwnq5f7feedwu-1799
  lisp/shadowfile.el             
shadowfile.el-20091113204419-o5vbwnq5f7feedwu-641
  lisp/wid-edit.el               widedit.el-20091113204419-o5vbwnq5f7feedwu-1095

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-07-12 01:11:22 +0000
+++ b/lisp/ChangeLog    2013-07-12 03:54:57 +0000
@@ -1,3 +1,29 @@
+2013-07-12  Glenn Morris  <address@hidden>
+
+       * 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  <address@hidden>
 
        * emacs-lisp/cl-macs.el (cl-multiple-value-bind, cl-multiple-value-setq)

=== modified file 'lisp/doc-view.el'
--- a/lisp/doc-view.el  2013-05-27 01:08:43 +0000
+++ b/lisp/doc-view.el  2013-07-12 03:54:57 +0000
@@ -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 @@
                        (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 @@
 (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 @@
 (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)))))

=== modified file 'lisp/edmacro.el'
--- a/lisp/edmacro.el   2013-01-01 09:11:05 +0000
+++ b/lisp/edmacro.el   2013-07-12 03:54:57 +0000
@@ -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 @@
       (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 @@
                           (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 @@
                                      '(?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 @@
                    (> 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 @@
                    (> 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 @@
            (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 @@
          (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 @@
               (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)

=== modified file 'lisp/filesets.el'
--- a/lisp/filesets.el  2013-03-05 17:13:01 +0000
+++ b/lisp/filesets.el  2013-07-12 03:54:57 +0000
@@ -149,7 +149,7 @@
 (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 @@
       (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 @@
     (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."

=== modified file 'lisp/progmodes/ebrowse.el'
--- a/lisp/progmodes/ebrowse.el 2013-01-01 09:11:05 +0000
+++ b/lisp/progmodes/ebrowse.el 2013-07-12 03:54:57 +0000
@@ -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 @@
     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 @@
 
 (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 @@
 
 (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))

=== modified file 'lisp/shadowfile.el'
--- a/lisp/shadowfile.el        2013-03-12 02:08:21 +0000
+++ b/lisp/shadowfile.el        2013-07-12 03:54:57 +0000
@@ -74,6 +74,7 @@
 
 ;;; Code:
 
+(require 'cl-lib)
 (require 'ange-ftp)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -180,15 +181,6 @@
     (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 @@
 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 @@
 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 @@
   "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'.

=== modified file 'lisp/wid-edit.el'
--- a/lisp/wid-edit.el  2013-07-01 05:00:50 +0000
+++ b/lisp/wid-edit.el  2013-07-12 03:54:57 +0000
@@ -55,6 +55,7 @@
 ;; See `widget.el'.
 
 ;;; Code:
+(require 'cl-lib)
 
 ;;; Compatibility.
 
@@ -221,7 +222,7 @@
        ((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 @@
             (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.