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.
This commit is contained in:
Glenn Morris
parent
bacba3c265
commit
539a920cda
7 changed files with 59 additions and 117 deletions
|
|
@ -1,3 +1,29 @@
|
|||
2013-07-12 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* 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 <lekktu@gmail.com>
|
||||
|
||||
* emacs-lisp/cl-macs.el (cl-multiple-value-bind, cl-multiple-value-setq)
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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'.
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue