summaryrefslogtreecommitdiff
path: root/lisp/progmodes
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2012-07-11 19:13:41 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2012-07-11 19:13:41 -0400
commita464a6c73acf27b0d633d428919a36bc16a9d442 (patch)
treebcba70ce0242bfd5987356c750ba4eb6b58820b1 /lisp/progmodes
parentc214e35e489145bd3a8ab7a353671f947368a7ae (diff)
downloademacs-a464a6c73acf27b0d633d428919a36bc16a9d442.tar.gz
emacs-a464a6c73acf27b0d633d428919a36bc16a9d442.tar.bz2
emacs-a464a6c73acf27b0d633d428919a36bc16a9d442.zip
More CL cleanups and reduction of use of cl.el.
* woman.el, winner.el, vc/vc-rcs.el, vc/vc-hooks.el, vc/vc-hg.el: * vc/vc-git.el, vc/vc-dir.el, vc/vc-bzr.el, vc/vc-annotate.el: * textmodes/tex-mode.el, textmodes/sgml-mode.el, tar-mode.el: * strokes.el, ses.el, server.el, progmodes/js.el, progmodes/gdb-mi.el: * progmodes/flymake.el, progmodes/ebrowse.el, progmodes/compile.el: * play/tetris.el, play/snake.el, play/pong.el, play/landmark.el: * play/hanoi.el, play/decipher.el, play/5x5.el, nxml/nxml-mode.el: * net/secrets.el, net/quickurl.el, midnight.el, mail/footnote.el: * image-dired.el, ibuffer.el, ibuf-macs.el, ibuf-ext.el, hexl.el: * eshell/eshell.el, eshell/esh-io.el, eshell/esh-ext.el: * eshell/esh-cmd.el, eshell/em-ls.el, eshell/em-hist.el: * eshell/em-cmpl.el, eshell/em-banner.el: * url/url.el, url/url-queue.el, url/url-parse.el, url/url-http.el: * url/url-future.el, url/url-dav.el, url/url-cookie.el: * calendar/parse-time.el, test/eshell.el: Use cl-lib. * wid-browse.el, wdired.el, vc/vc.el, vc/vc-mtn.el, vc/vc-cvs.el: * vc/vc-arch.el, tree-widget.el, textmodes/texinfo.el: * textmodes/refill.el, textmodes/css-mode.el, term/tvi970.el: * term/ns-win.el, term.el, shell.el, ps-samp.el: * progmodes/perl-mode.el, progmodes/pascal.el, progmodes/gud.el: * progmodes/glasses.el, progmodes/etags.el, progmodes/cwarn.el: * play/gamegrid.el, play/bubbles.el, novice.el, notifications.el: * net/zeroconf.el, net/xesam.el, net/snmp-mode.el, net/mairix.el: * net/ldap.el, net/eudc.el, net/browse-url.el, man.el: * mail/mailheader.el, mail/feedmail.el: * url/url-util.el, url/url-privacy.el, url/url-nfs.el, url/url-misc.el: * url/url-methods.el, url/url-gw.el, url/url-file.el, url/url-expand.el: Dont use CL. * ibuf-ext.el (ibuffer-mark-old-buffers): Use float-time. * eshell/esh-opt.el (eshell-eval-using-options): Quote code with `lambda' rather than with `quote'. (eshell-do-opt): Adjust accordingly. (eshell-process-option): Simplify. * eshell/esh-var.el: * eshell/em-script.el: Require `esh-opt' for eshell-eval-using-options. * emacs-pcase.el (pcase--dontcare-upats, pcase--let*) (pcase--expand, pcase--u1): Rename pcase's internal `dontcare' pattern to `pcase--dontcare'. * emacs-cl.el (labels): Mark obsolete. (cl--letf, letf): Move to cl-lib. (cl--letf*, letf*): Remove. * emacs-cl-lib.el (cl-nth-value): Use defalias. * emacs-cl-macs.el (cl-dolist, cl-dotimes): Add indent rule. (cl-progv): Rewrite. (cl--letf, cl-letf): Move from cl.el. (cl-letf*): New macro. * emacs-cl-extra.el (cl--progv-before, cl--progv-after): Remove.
Diffstat (limited to 'lisp/progmodes')
-rw-r--r--lisp/progmodes/compile.el16
-rw-r--r--lisp/progmodes/cwarn.el2
-rw-r--r--lisp/progmodes/ebrowse.el700
-rw-r--r--lisp/progmodes/etags.el2
-rw-r--r--lisp/progmodes/flymake.el4
-rw-r--r--lisp/progmodes/gdb-mi.el11
-rw-r--r--lisp/progmodes/glasses.el4
-rw-r--r--lisp/progmodes/gud.el28
-rw-r--r--lisp/progmodes/js.el1004
-rw-r--r--lisp/progmodes/pascal.el1
-rw-r--r--lisp/progmodes/perl-mode.el1
11 files changed, 879 insertions, 894 deletions
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 61dc371c087..c008e1c4da3 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -30,7 +30,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'tool-bar)
(require 'comint)
@@ -791,7 +791,7 @@ info, are considered errors."
3)))
(setq compilation-skip-threshold level)
(message "Skipping %s"
- (case compilation-skip-threshold
+ (pcase compilation-skip-threshold
(0 "Nothing")
(1 "Info messages")
(2 "Warnings and info"))))
@@ -826,7 +826,7 @@ from a different message."
;; modified using the same *compilation* buffer. this necessitates
;; re-parsing markers.
-;; (defstruct (compilation--loc
+;; (cl-defstruct (compilation--loc
;; (:constructor nil)
;; (:copier nil)
;; (:constructor compilation--make-loc
@@ -875,7 +875,7 @@ from a different message."
;; These are the value of the `compilation-message' text-properties in the
;; compilation buffer.
-(defstruct (compilation--message
+(cl-defstruct (compilation--message
(:constructor nil)
(:copier nil)
;; (:type list) ;Old representation.
@@ -1212,7 +1212,7 @@ FMTS is a list of format specs for transforming the file name.
(goto-char end)
(unless (bolp)
;; We generally don't like to parse partial lines.
- (assert (eobp))
+ (cl-assert (eobp))
(when (let ((proc (get-buffer-process (current-buffer))))
(and proc (memq (process-status proc) '(run open))))
(setq end (line-beginning-position))))
@@ -2415,7 +2415,7 @@ region and the first line of the next region."
(push fs compilation-gcpro)
(let ((loc (compilation-assq (or line 1) (cdr fs))))
(setq loc (compilation-assq col loc))
- (assert (null (cdr loc)))
+ (cl-assert (null (cdr loc)))
(setcdr loc (compilation--make-cdrloc line fs marker))
loc)))
@@ -2685,8 +2685,8 @@ The file-structure looks like this:
(defun compilation--flush-file-structure (file)
(or (consp file) (setq file (list file)))
(let ((fs (compilation-get-file-structure file)))
- (assert (eq fs (gethash file compilation-locs)))
- (assert (eq fs (gethash (cons (caar fs) (cadr (car fs)))
+ (cl-assert (eq fs (gethash file compilation-locs)))
+ (cl-assert (eq fs (gethash (cons (caar fs) (cadr (car fs)))
compilation-locs)))
(maphash (lambda (k v)
(if (eq v fs) (remhash k compilation-locs)))
diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el
index 09c7e908806..9ea71ad36f5 100644
--- a/lisp/progmodes/cwarn.el
+++ b/lisp/progmodes/cwarn.el
@@ -105,8 +105,6 @@
;;{{{ Dependencies
-(eval-when-compile (require 'cl))
-
(require 'custom)
(require 'font-lock)
(require 'cc-mode)
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index ce190d25157..1d29011762e 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -38,7 +38,7 @@
(require 'ebuff-menu)
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'helper))
@@ -249,6 +249,7 @@ This is a destructive operation."
(defmacro ebrowse-output (&rest body)
"Eval BODY with a writable current buffer.
Preserve buffer's modified state."
+ (declare (indent 0) (debug t))
(let ((modified (make-symbol "--ebrowse-output--")))
`(let (buffer-read-only (,modified (buffer-modified-p)))
(unwind-protect
@@ -258,35 +259,30 @@ Preserve buffer's modified state."
(defmacro ebrowse-ignoring-completion-case (&rest body)
"Eval BODY with `completion-ignore-case' bound to t."
+ (declare (indent 0) (debug t))
`(let ((completion-ignore-case t))
,@body))
-
(defmacro ebrowse-save-selective (&rest body)
"Eval BODY with `selective-display' restored at the end."
- (let ((var (make-symbol "var")))
- `(let ((,var selective-display))
- (unwind-protect
- (progn ,@body)
- (setq selective-display ,var)))))
-
+ (declare (indent 0) (debug t))
+ ;; FIXME: Don't use selective-display.
+ `(let ((selective-display selective-display))
+ ,@body))
(defmacro ebrowse-for-all-trees (spec &rest body)
"For all trees in SPEC, eval BODY."
+ (declare (indent 1) (debug ((sexp form) body)))
(let ((var (make-symbol "var"))
(spec-var (car spec))
(array (cadr spec)))
- `(loop for ,var being the symbols of ,array
- as ,spec-var = (get ,var 'ebrowse-root) do
- (when (vectorp ,spec-var)
- ,@body))))
+ `(cl-loop for ,var being the symbols of ,array
+ as ,spec-var = (get ,var 'ebrowse-root) do
+ (when (vectorp ,spec-var)
+ ,@body))))
;;; Set indentation for macros above.
-(put 'ebrowse-output 'lisp-indent-hook 0)
-(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0)
-(put 'ebrowse-save-selective 'lisp-indent-hook 0)
-(put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
(defsubst ebrowse-set-face (start end face)
@@ -307,17 +303,6 @@ is STRING, but point is placed POSITION characters into the string."
(ebrowse-ignoring-completion-case
(completing-read prompt table nil t initial-input)))
-
-(defun ebrowse-value-in-buffer (sym buffer)
- "Return the value of SYM in BUFFER."
- (let ((old-buffer (current-buffer)))
- (unwind-protect
- (progn
- (set-buffer buffer)
- (symbol-value sym))
- (set-buffer old-buffer))))
-
-
(defun ebrowse-rename-buffer (new-name)
"Rename current buffer to NEW-NAME.
If a buffer with name NEW-NAME already exists, delete it first."
@@ -333,9 +318,9 @@ If a buffer with name NEW-NAME already exists, delete it first."
Replace sequences of newlines with a single space."
(when (string-match "^[ \t\n\r]+" string)
(setq string (substring string (match-end 0))))
- (loop while (string-match "[\n]+" string)
- finally return string do
- (setq string (replace-match " " nil t string))))
+ (cl-loop while (string-match "[\n]+" string)
+ finally return string do
+ (setq string (replace-match " " nil t string))))
(defun ebrowse-width-of-drawable-area ()
@@ -350,7 +335,7 @@ otherwise use the current frame's width."
;;; Structure definitions
-(defstruct (ebrowse-hs (:type vector) :named)
+(cl-defstruct (ebrowse-hs (:type vector) :named)
"Header structure found at the head of BROWSE files."
;; A version string that is compared against the version number of
;; the Lisp package when the file is loaded. This is done to
@@ -367,7 +352,7 @@ otherwise use the current frame's width."
member-table)
-(defstruct (ebrowse-ts (:type vector) :named)
+(cl-defstruct (ebrowse-ts (:type vector) :named)
"Tree structure.
Following the header structure, a BROWSE file contains a number
of `ebrowse-ts' structures, each one describing one root class of
@@ -387,7 +372,7 @@ the class hierarchy with all its subclasses."
mark)
-(defstruct (ebrowse-bs (:type vector) :named)
+(cl-defstruct (ebrowse-bs (:type vector) :named)
"Common sub-structure.
A common structure defining an occurrence of some name in the
source files."
@@ -414,14 +399,14 @@ source files."
point)
-(defstruct (ebrowse-cs (:include ebrowse-bs) (:type vector) :named)
+(cl-defstruct (ebrowse-cs (:include ebrowse-bs) (:type vector) :named)
"Class structure.
This is the structure stored in the CLASS slot of a `ebrowse-ts'
structure. It describes the location of the class declaration."
source-file)
-(defstruct (ebrowse-ms (:include ebrowse-bs) (:type vector) :named)
+(cl-defstruct (ebrowse-ms (:include ebrowse-bs) (:type vector) :named)
"Member structure.
This is the structure describing a single member. The `ebrowse-ts'
structure contains various lists for the different types of
@@ -691,7 +676,7 @@ MARKED-ONLY non-nil means include marked classes only."
(ebrowse-for-all-trees (tree ebrowse--tree-obarray)
(when (or (not marked-only) (ebrowse-ts-mark tree))
(let ((class (ebrowse-ts-class tree)))
- (when (zerop (% (incf i) 20))
+ (when (zerop (% (cl-incf i) 20))
(ebrowse-show-progress "Preparing file list" (zerop i)))
;; Add files mentioned in class description
(let ((source-file (ebrowse-cs-source-file class))
@@ -701,14 +686,14 @@ MARKED-ONLY non-nil means include marked classes only."
(when file
(puthash file file files))
;; For all member lists in this class
- (loop for accessor in ebrowse-member-list-accessors do
- (loop for m in (funcall accessor tree)
- for file = (ebrowse-ms-file m)
- for def-file = (ebrowse-ms-definition-file m) do
- (when file
- (puthash file file files))
- (when def-file
- (puthash def-file def-file files))))))))
+ (dolist (accessor ebrowse-member-list-accessors)
+ (cl-loop for m in (funcall accessor tree)
+ for file = (ebrowse-ms-file m)
+ for def-file = (ebrowse-ms-definition-file m) do
+ (when file
+ (puthash file file files))
+ (when def-file
+ (puthash def-file def-file files))))))))
files))
@@ -721,11 +706,11 @@ MARKED-ONLY non-nil means include marked classes only."
list))
-(defun* ebrowse-marked-classes-p ()
+(cl-defun ebrowse-marked-classes-p ()
"Value is non-nil if any class in the current class tree is marked."
(ebrowse-for-all-trees (tree ebrowse--tree-obarray)
(when (ebrowse-ts-mark tree)
- (return-from ebrowse-marked-classes-p tree))))
+ (cl-return-from ebrowse-marked-classes-p tree))))
(defsubst ebrowse-globals-tree-p (tree)
@@ -752,12 +737,13 @@ The class tree is found in the buffer-local variable `ebrowse--tree-obarray'."
(if qualified-names-p
(ebrowse-for-all-trees (tree ebrowse--tree-obarray)
(setq alist
- (acons (ebrowse-qualified-class-name (ebrowse-ts-class tree))
- tree alist)))
+ (cl-acons (ebrowse-qualified-class-name
+ (ebrowse-ts-class tree))
+ tree alist)))
(ebrowse-for-all-trees (tree ebrowse--tree-obarray)
(setq alist
- (acons (ebrowse-cs-name (ebrowse-ts-class tree))
- tree alist))))
+ (cl-acons (ebrowse-cs-name (ebrowse-ts-class tree))
+ tree alist))))
alist))
@@ -792,15 +778,15 @@ This function must be used instead of the struct slot
computes this information lazily."
(or (ebrowse-ts-base-classes tree)
(setf (ebrowse-ts-base-classes tree)
- (loop with to-search = (list tree)
- with result = nil
- as search = (pop to-search)
- while search finally return result
- do (ebrowse-for-all-trees (ti ebrowse--tree-obarray)
- (when (memq search (ebrowse-ts-subclasses ti))
- (unless (memq ti result)
- (setq result (nconc result (list ti))))
- (push ti to-search)))))))
+ (cl-loop with to-search = (list tree)
+ with result = nil
+ as search = (pop to-search)
+ while search finally return result
+ do (ebrowse-for-all-trees (ti ebrowse--tree-obarray)
+ (when (memq search (ebrowse-ts-subclasses ti))
+ (unless (memq ti result)
+ (setq result (nconc result (list ti))))
+ (push ti to-search)))))))
(defun ebrowse-direct-base-classes (tree)
@@ -820,8 +806,8 @@ computes this information lazily."
ACCESSOR is the accessor function for the member list.
Elements of the result have the form (NAME . ACCESSOR), where NAME
is the member name."
- (loop for member in (funcall accessor tree)
- collect (cons (ebrowse-ms-name member) accessor)))
+ (cl-loop for member in (funcall accessor tree)
+ collect (cons (ebrowse-ms-name member) accessor)))
(defun ebrowse-name/accessor-alist-for-visible-members ()
@@ -834,10 +820,10 @@ structure. The list includes inherited members if these are visible."
ebrowse--accessor)))
(if ebrowse--show-inherited-flag
(nconc list
- (loop for tree in (ebrowse-base-classes
- ebrowse--displayed-class)
- nconc (ebrowse-name/accessor-alist
- tree ebrowse--accessor)))
+ (cl-loop for tree in (ebrowse-base-classes
+ ebrowse--displayed-class)
+ nconc (ebrowse-name/accessor-alist
+ tree ebrowse--accessor)))
list)))
@@ -908,8 +894,7 @@ and TREE is a list of `ebrowse-ts' structures forming the class tree."
See that variable's documentation for the meaning of IGNORE-AUTO-SAVE and
NOCONFIRM."
(when (or noconfirm (yes-or-no-p "Revert tree from disk? "))
- (loop for member-buffer in (ebrowse-same-tree-member-buffer-list)
- do (kill-buffer member-buffer))
+ (mapc #'kill-buffer (ebrowse-same-tree-member-buffer-list))
(erase-buffer)
(with-no-warnings
(insert-file (or buffer-file-name ebrowse--tags-file-name)))
@@ -934,9 +919,9 @@ Return the buffer created."
ebrowse--frozen-flag nil)
(ebrowse-redraw-tree)
(set-buffer-modified-p nil)
- (case pop
- (switch (switch-to-buffer name))
- (pop (pop-to-buffer name)))
+ (pcase pop
+ (`switch (switch-to-buffer name))
+ (`pop (pop-to-buffer name)))
(current-buffer)))
@@ -962,14 +947,14 @@ type `ebrowse-hs' is set to the resulting obarray."
(garbage-collect)
;; For all classes...
(ebrowse-for-all-trees (c ebrowse--tree-obarray)
- (when (zerop (% (incf i) 10))
+ (when (zerop (% (cl-incf i) 10))
(ebrowse-show-progress "Preparing member lookup" (zerop i)))
- (loop for f in ebrowse-member-list-accessors do
- (loop for m in (funcall f c) do
- (let* ((member-name (ebrowse-ms-name m))
- (value (gethash member-name members)))
- (push (list c f m) value)
- (puthash member-name value members)))))
+ (dolist (f ebrowse-member-list-accessors)
+ (dolist (m (funcall f c))
+ (let* ((member-name (ebrowse-ms-name m))
+ (value (gethash member-name members)))
+ (push (list c f m) value)
+ (puthash member-name value members)))))
(setf (ebrowse-hs-member-table ebrowse--header) members)))
@@ -977,11 +962,11 @@ type `ebrowse-hs' is set to the resulting obarray."
"Return the member obarray. Build it if it hasn't been set up yet.
HEADER is the tree header structure of the class tree."
(when (null (ebrowse-hs-member-table header))
- (loop for buffer in (ebrowse-browser-buffer-list)
- until (eq header (ebrowse-value-in-buffer 'ebrowse--header buffer))
- finally do
- (with-current-buffer buffer
- (ebrowse-fill-member-table))))
+ (cl-loop for buffer in (ebrowse-browser-buffer-list)
+ until (eq header (buffer-local-value 'ebrowse--header buffer))
+ finally do
+ (with-current-buffer buffer
+ (ebrowse-fill-member-table))))
(ebrowse-hs-member-table header))
@@ -993,11 +978,12 @@ HEADER is the tree header structure of the class tree."
Build obarray of all classes in TREE."
(let ((classes (make-vector 127 0)))
;; Add root classes...
- (loop for root in tree
- as sym =
- (intern (ebrowse-qualified-class-name (ebrowse-ts-class root)) classes)
- do (unless (get sym 'ebrowse-root)
- (setf (get sym 'ebrowse-root) root)))
+ (cl-loop for root in tree
+ as sym =
+ (intern (ebrowse-qualified-class-name (ebrowse-ts-class root))
+ classes)
+ do (unless (get sym 'ebrowse-root)
+ (setf (get sym 'ebrowse-root) root)))
;; Process subclasses
(ebrowse-insert-supers tree classes)
classes))
@@ -1015,29 +1001,30 @@ beginning of the base-class list.
We have to be cautious here not to end up in an infinite recursion
if for some reason a circle is in the inheritance graph."
- (loop for class in tree
- as subclasses = (ebrowse-ts-subclasses class) do
- ;; Make sure every class is represented by a unique object
- (loop for subclass on subclasses
- as sym = (intern
- (ebrowse-qualified-class-name (ebrowse-ts-class (car subclass)))
- classes)
- as next = nil
- do
- ;; Replace the subclass tree with the one found in
- ;; CLASSES if there is already an entry for that class
- ;; in it. Otherwise make a new entry.
- ;;
- ;; CAVEAT: If by some means (e.g., use of the
- ;; preprocessor in class declarations, a name is marked
- ;; as a subclass of itself on some path, we would end up
- ;; in an endless loop. We have to omit subclasses from
- ;; the recursion that already have been processed.
- (if (get sym 'ebrowse-root)
- (setf (car subclass) (get sym 'ebrowse-root))
- (setf (get sym 'ebrowse-root) (car subclass))))
- ;; Process subclasses
- (ebrowse-insert-supers subclasses classes)))
+ (cl-loop for class in tree
+ as subclasses = (ebrowse-ts-subclasses class) do
+ ;; Make sure every class is represented by a unique object
+ (cl-loop for subclass on subclasses
+ as sym = (intern
+ (ebrowse-qualified-class-name
+ (ebrowse-ts-class (car subclass)))
+ classes)
+ as next = nil
+ do
+ ;; Replace the subclass tree with the one found in
+ ;; CLASSES if there is already an entry for that class
+ ;; in it. Otherwise make a new entry.
+ ;;
+ ;; CAVEAT: If by some means (e.g., use of the
+ ;; preprocessor in class declarations, a name is marked
+ ;; as a subclass of itself on some path, we would end up
+ ;; in an endless loop. We have to omit subclasses from
+ ;; the recursion that already have been processed.
+ (if (get sym 'ebrowse-root)
+ (setf (car subclass) (get sym 'ebrowse-root))
+ (setf (get sym 'ebrowse-root) (car subclass))))
+ ;; Process subclasses
+ (ebrowse-insert-supers subclasses classes)))
;;; Tree buffers
@@ -1111,7 +1098,7 @@ Tree mode key bindings:
(unless (zerop (buffer-size))
(goto-char (point-min))
- (multiple-value-setq (header tree) (values-list (ebrowse-read)))
+ (cl-multiple-value-setq (header tree) (cl-values-list (ebrowse-read)))
(message "Sorting. Please be patient...")
(setq tree (ebrowse-sort-tree-list tree))
(erase-buffer)
@@ -1199,32 +1186,32 @@ If given a numeric N-TIMES argument, mark that many classes."
;; Get the classes whose mark must be toggled. Note that
;; ebrowse-tree-at-point might issue an error.
(ignore-errors
- (loop repeat (or n-times 1)
- as tree = (ebrowse-tree-at-point)
- do (progn
- (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree)))
- (forward-line 1)
- (push tree to-change))))
+ (cl-loop repeat (or n-times 1)
+ as tree = (ebrowse-tree-at-point)
+ do (progn
+ (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree)))
+ (forward-line 1)
+ (push tree to-change))))
(save-excursion
;; For all these classes, reverse the mark char in the display
;; by a regexp replace over the whole buffer. The reason for this
;; is that classes might have multiple base classes. If this is
;; the case, they are displayed more than once in the tree.
(ebrowse-output
- (loop for tree in to-change
- as regexp = (concat "^.*\\b"
- (regexp-quote
- (ebrowse-cs-name (ebrowse-ts-class tree)))
- "\\b")
- do
- (goto-char (point-min))
- (loop while (re-search-forward regexp nil t)
- do (progn
- (goto-char (match-beginning 0))
- (delete-char 1)
- (insert-char (if (ebrowse-ts-mark tree) ?> ? ) 1)
- (ebrowse-set-mark-props (1- (point)) (point) tree)
- (goto-char (match-end 0)))))))))
+ (cl-loop
+ for tree in to-change
+ as regexp = (concat "^.*\\b"
+ (regexp-quote
+ (ebrowse-cs-name (ebrowse-ts-class tree)))
+ "\\b")
+ do
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (goto-char (match-beginning 0))
+ (delete-char 1)
+ (insert-char (if (ebrowse-ts-mark tree) ?> ? ) 1)
+ (ebrowse-set-mark-props (1- (point)) (point) tree)
+ (goto-char (match-end 0))))))))
(defun ebrowse-mark-all-classes (prefix)
@@ -1345,7 +1332,7 @@ one buffer. Prefer tree buffers over member buffers."
(set (make-hash-table))
result)
(dolist (buffer buffers)
- (let ((tree (ebrowse-value-in-buffer 'ebrowse--tree buffer)))
+ (let ((tree (buffer-local-value 'ebrowse--tree buffer)))
(unless (gethash tree set)
(push buffer result))
(puthash tree t set)))
@@ -1356,7 +1343,7 @@ one buffer. Prefer tree buffers over member buffers."
"Return a list of members buffers with same tree as current buffer."
(ebrowse-delete-if-not
(lambda (buffer)
- (eq (ebrowse-value-in-buffer 'ebrowse--tree buffer)
+ (eq (buffer-local-value 'ebrowse--tree buffer)
ebrowse--tree))
(ebrowse-member-buffer-list)))
@@ -1367,7 +1354,7 @@ one buffer. Prefer tree buffers over member buffers."
Switch to buffer if prefix ARG.
If no member buffer exists, make one."
(interactive "P")
- (let ((buf (or (first (ebrowse-same-tree-member-buffer-list))
+ (let ((buf (or (cl-first (ebrowse-same-tree-member-buffer-list))
(get-buffer ebrowse-member-buffer-name)
(ebrowse-tree-command:show-member-functions))))
(when buf
@@ -1391,9 +1378,9 @@ If no member buffer exists, make one."
(defun ebrowse-kill-member-buffers-displaying (tree)
"Kill all member buffers displaying TREE."
- (loop for buffer in (ebrowse-member-buffer-list)
- as class = (ebrowse-value-in-buffer 'ebrowse--displayed-class buffer)
- when (eq class tree) do (kill-buffer buffer)))
+ (cl-loop for buffer in (ebrowse-member-buffer-list)
+ as class = (buffer-local-value 'ebrowse--displayed-class buffer)
+ when (eq class tree) do (kill-buffer buffer)))
(defun ebrowse-frozen-tree-buffer-name (tags-file)
@@ -1429,7 +1416,7 @@ Pop to member buffer if no prefix ARG, to tree buffer otherwise."
(int-to-string ebrowse--indentation)
"): ")
nil nil ebrowse--indentation))))
- (when (plusp width)
+ (when (cl-plusp width)
(set (make-local-variable 'ebrowse--indentation) width)
(ebrowse-redraw-tree))))
@@ -1504,7 +1491,7 @@ Read a class name from the minibuffer if CLASS is nil."
(error "Not on a class")))
-(defun* ebrowse-view/find-class-declaration (&key view where)
+(cl-defun ebrowse-view/find-class-declaration (&key view where)
"View or find the declarator of the class point is on.
VIEW non-nil means view it. WHERE is additional position info."
(let* ((class (ebrowse-ts-class (ebrowse-tree-at-point)))
@@ -1583,9 +1570,9 @@ and possibly kill the viewed buffer."
exit-action ebrowse--view-exit-action))
;; Delete the frame in which we viewed.
(mapc 'delete-frame
- (loop for frame in (frame-list)
- when (not (assq frame original-frame-configuration))
- collect frame))
+ (cl-loop for frame in (frame-list)
+ when (not (assq frame original-frame-configuration))
+ collect frame))
(when exit-action
(funcall exit-action buffer))))
@@ -1639,15 +1626,15 @@ specifies where to find/view the result."
(unless (boundp 'view-mode-hook)
(setq view-mode-hook nil))
(push 'ebrowse-find-pattern view-mode-hook)
- (case where
- (other-window (view-file-other-window file))
- (other-frame (ebrowse-view-file-other-frame file))
- (t (view-file file))))
+ (pcase where
+ (`other-window (view-file-other-window file))
+ (`other-frame (ebrowse-view-file-other-frame file))
+ (_ (view-file file))))
(t
- (case where
- (other-window (find-file-other-window file))
- (other-frame (find-file-other-frame file))
- (t (find-file file)))
+ (pcase where
+ (`other-window (find-file-other-window file))
+ (`other-frame (find-file-other-frame file))
+ (_ (find-file file)))
(ebrowse-find-pattern struc info))))
@@ -1657,14 +1644,14 @@ This is `regexp-quote' for most symbols, except for operator names
which may contain whitespace. For these symbols, replace white
space in the symbol name (generated by BROWSE) with a regular
expression matching any number of whitespace characters."
- (loop with regexp = (regexp-quote name)
- with start = 0
- finally return regexp
- while (string-match "[ \t]+" regexp start)
- do (setq regexp (concat (substring regexp 0 (match-beginning 0))
- "[ \t]*"
- (substring regexp (match-end 0)))
- start (+ (match-beginning 0) 5))))
+ (cl-loop with regexp = (regexp-quote name)
+ with start = 0
+ finally return regexp
+ while (string-match "[ \t]+" regexp start)
+ do (setq regexp (concat (substring regexp 0 (match-beginning 0))
+ "[ \t]*"
+ (substring regexp (match-end 0)))
+ start (+ (match-beginning 0) 5))))
(defun ebrowse-class-declaration-regexp (name)
@@ -1692,7 +1679,7 @@ expression matching any number of whitespace characters."
(concat "^[ \t]*#[ \t]*define[ \t]+" (regexp-quote name)))
-(defun* ebrowse-find-pattern (&optional position info &aux viewing)
+(cl-defun ebrowse-find-pattern (&optional position info &aux viewing)
"Find a pattern.
This is a kluge: Ebrowse allows you to find or view a file containing
@@ -1711,25 +1698,26 @@ INFO is a list (TREE-HEADER TREE-OR-MEMBER MEMBER-LIST)."
(start (ebrowse-bs-point position))
(offset 100)
found)
- (destructuring-bind (header class-or-member member-list) info
+ (pcase-let ((`(,header ,class-or-member ,member-list) info))
;; If no pattern is specified, construct one from the member name.
(when (stringp pattern)
(setq pattern (concat "^.*" (regexp-quote pattern))))
;; Construct a regular expression if none given.
(unless pattern
- (typecase class-or-member
+ (cl-typecase class-or-member
(ebrowse-ms
- (case member-list
- ((ebrowse-ts-member-variables
- ebrowse-ts-static-variables
- ebrowse-ts-types)
- (setf pattern (ebrowse-variable-declaration-regexp
- (ebrowse-bs-name position))))
- (otherwise
- (if (ebrowse-define-p class-or-member)
- (setf pattern (ebrowse-pp-define-regexp (ebrowse-bs-name position)))
- (setf pattern (ebrowse-function-declaration/definition-regexp
- (ebrowse-bs-name position)))))))
+ (setf pattern
+ (pcase member-list
+ ((or `ebrowse-ts-member-variables
+ `ebrowse-ts-static-variables
+ `ebrowse-ts-types)
+ (ebrowse-variable-declaration-regexp
+ (ebrowse-bs-name position)))
+ (_
+ (if (ebrowse-define-p class-or-member)
+ (ebrowse-pp-define-regexp (ebrowse-bs-name position))
+ (ebrowse-function-declaration/definition-regexp
+ (ebrowse-bs-name position)))))))
(ebrowse-cs
(setf pattern (ebrowse-class-declaration-regexp
(ebrowse-bs-name position))))))
@@ -1743,10 +1731,11 @@ INFO is a list (TREE-HEADER TREE-OR-MEMBER MEMBER-LIST)."
(y-or-n-p (format "start = %d? " start))
(y-or-n-p pattern))
(setf found
- (loop do (goto-char (max (point-min) (- start offset)))
- when (re-search-forward pattern (+ start offset) t) return t
- never (bobp)
- do (incf offset offset)))
+ (cl-loop do (goto-char (max (point-min) (- start offset)))
+ when (re-search-forward pattern (+ start offset) t)
+ return t
+ never (bobp)
+ do (cl-incf offset offset)))
(cond (found
(beginning-of-line)
(run-hooks 'ebrowse-view/find-hook))
@@ -1790,57 +1779,57 @@ TREE denotes the class shown."
(ebrowse-set-face start end 'ebrowse-tree-mark))
-(defun* ebrowse-draw-tree-fn (&aux stack1 stack2 start)
+(cl-defun ebrowse-draw-tree-fn (&aux stack1 stack2 start)
"Display a single class and recursively its subclasses.
This function may look weird, but this is faster than recursion."
(setq stack1 (make-list (length ebrowse--tree) 0)
stack2 (copy-sequence ebrowse--tree))
- (loop while stack2
- as level = (pop stack1)
- as tree = (pop stack2)
- as class = (ebrowse-ts-class tree) do
- (let ((start-of-line (point))
- start-of-class-name end-of-class-name)
- ;; Insert mark
- (insert (if (ebrowse-ts-mark tree) ">" " "))
-
- ;; Indent and insert class name
- (indent-to (+ (* level ebrowse--indentation)
- ebrowse-tree-left-margin))
- (setq start (point))
- (insert (ebrowse-qualified-class-name class))
-
- ;; If template class, add <>
- (when (ebrowse-template-p class)
- (insert "<>"))
- (ebrowse-set-face start (point) (if (zerop level)
- 'ebrowse-root-class
- 'ebrowse-default))
- (setf start-of-class-name start
- end-of-class-name (point))
- ;; If filenames are to be displayed...
- (when ebrowse--show-file-names-flag
- (indent-to ebrowse-source-file-column)
- (setq start (point))
- (insert "("
- (or (ebrowse-cs-file class)
- "unknown")
- ")")
- (ebrowse-set-face start (point) 'ebrowse-file-name))
- (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree)
- (add-text-properties
- start-of-class-name end-of-class-name
- `(mouse-face highlight ebrowse-what class-name
- ebrowse-tree ,tree
- help-echo "double-mouse-1: (un)expand tree; mouse-2: member functions, mouse-3: menu"))
- (insert "\n"))
- ;; Push subclasses, if any.
- (when (ebrowse-ts-subclasses tree)
- (setq stack2
- (nconc (copy-sequence (ebrowse-ts-subclasses tree)) stack2)
- stack1
- (nconc (make-list (length (ebrowse-ts-subclasses tree))
- (1+ level)) stack1)))))
+ (cl-loop while stack2
+ as level = (pop stack1)
+ as tree = (pop stack2)
+ as class = (ebrowse-ts-class tree) do
+ (let ((start-of-line (point))
+ start-of-class-name end-of-class-name)
+ ;; Insert mark
+ (insert (if (ebrowse-ts-mark tree) ">" " "))
+
+ ;; Indent and insert class name
+ (indent-to (+ (* level ebrowse--indentation)
+ ebrowse-tree-left-margin))
+ (setq start (point))
+ (insert (ebrowse-qualified-class-name class))
+
+ ;; If template class, add <>
+ (when (ebrowse-template-p class)
+ (insert "<>"))
+ (ebrowse-set-face start (point) (if (zerop level)
+ 'ebrowse-root-class
+ 'ebrowse-default))
+ (setf start-of-class-name start
+ end-of-class-name (point))
+ ;; If filenames are to be displayed...
+ (when ebrowse--show-file-names-flag
+ (indent-to ebrowse-source-file-column)
+ (setq start (point))
+ (insert "("
+ (or (ebrowse-cs-file class)
+ "unknown")
+ ")")
+ (ebrowse-set-face start (point) 'ebrowse-file-name))
+ (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree)
+ (add-text-properties
+ start-of-class-name end-of-class-name
+ `(mouse-face highlight ebrowse-what class-name
+ ebrowse-tree ,tree
+ help-echo "double-mouse-1: (un)expand tree; mouse-2: member functions, mouse-3: menu"))
+ (insert "\n"))
+ ;; Push subclasses, if any.
+ (when (ebrowse-ts-subclasses tree)
+ (setq stack2
+ (nconc (copy-sequence (ebrowse-ts-subclasses tree)) stack2)
+ stack1
+ (nconc (make-list (length (ebrowse-ts-subclasses tree))
+ (1+ level)) stack1)))))
@@ -2096,8 +2085,8 @@ See 'Electric-command-loop' for a description of STATE and CONDITION."
"Read a browser buffer name from the minibuffer and return that buffer."
(let* ((buffers (ebrowse-known-class-trees-buffer-list)))
(if buffers
- (if (not (second buffers))
- (first buffers)
+ (if (not (cl-second buffers))
+ (cl-first buffers)
(or (ebrowse-electric-choose-tree) (error "No tree buffer")))
(let* ((insert-default-directory t)
(file (read-file-name "Find tree: " nil nil t)))
@@ -2283,7 +2272,7 @@ The new width is read from the minibuffer."
ebrowse--decl-column
ebrowse--column-width))
"): ")))))
- (when (plusp width)
+ (when (cl-plusp width)
(if ebrowse--long-display-flag
(setq ebrowse--decl-column width)
(setq ebrowse--column-width width))
@@ -2323,15 +2312,15 @@ make one."
(let ((index (ebrowse-position ebrowse--accessor
ebrowse-member-list-accessors)))
(setf ebrowse--accessor
- (cond ((plusp incr)
+ (cond ((cl-plusp incr)
(or (nth (1+ index)
ebrowse-member-list-accessors)
- (first ebrowse-member-list-accessors)))
- ((minusp incr)
- (or (and (>= (decf index) 0)
+ (cl-first ebrowse-member-list-accessors)))
+ ((cl-minusp incr)
+ (or (and (>= (cl-decf index) 0)
(nth index
ebrowse-member-list-accessors))
- (first (last ebrowse-member-list-accessors))))))
+ (cl-first (last ebrowse-member-list-accessors))))))
(ebrowse-display-member-list-for-accessor ebrowse--accessor)))
@@ -2516,7 +2505,7 @@ find file in another frame."
(ebrowse-view/find-member-declaration/definition prefix t))
-(defun* ebrowse-view/find-member-declaration/definition
+(cl-defun ebrowse-view/find-member-declaration/definition
(prefix view &optional definition info header tags-file)
"Find or view a member declaration or definition.
With PREFIX 4. find file in another window, with prefix 5
@@ -2536,15 +2525,15 @@ TAGS-FILE is the file name of the BROWSE file."
;; If not given as parameters, get the necessary information
;; out of the member buffer.
(if info
- (setq tree (first info)
- accessor (second info)
- member (third info))
- (multiple-value-setq (tree member on-class)
- (values-list (ebrowse-member-info-from-point)))
+ (setq tree (cl-first info)
+ accessor (cl-second info)
+ member (cl-third info))
+ (cl-multiple-value-setq (tree member on-class)
+ (cl-values-list (ebrowse-member-info-from-point)))
(setq accessor ebrowse--accessor))
;; View/find class if on a line containing a class name.
(when on-class
- (return-from ebrowse-view/find-member-declaration/definition
+ (cl-return-from ebrowse-view/find-member-declaration/definition
(ebrowse-view/find-file-and-search-pattern
(ebrowse-ts-class tree)
(list ebrowse--header (ebrowse-ts-class tree) nil)
@@ -2802,11 +2791,11 @@ TREE is the class tree in which the members are found."
mouse-face highlight
ebrowse-tree ,tree
help-echo "mouse-2: view definition; mouse-3: menu"))
- (incf i)
+ (cl-incf i)
(when (>= i ebrowse--n-columns)
(setf i 0)
(insert "\n")))))
- (when (plusp i)
+ (when (cl-plusp i)
(insert "\n"))
(goto-char (point-min))))
@@ -2884,7 +2873,7 @@ REPEAT, if specified, says repeat the search REPEAT times."
(error "Not found"))))
-(defun* ebrowse-move-point-to-member (name &optional count &aux member)
+(cl-defun ebrowse-move-point-to-member (name &optional count &aux member)
"Set point on member NAME in the member buffer
COUNT, if specified, says search the COUNT'th member with the same name."
(goto-char (point-min))
@@ -2905,8 +2894,8 @@ COUNT, if specified, says search the COUNT'th member with the same name."
"Switch member buffer to a class read from the minibuffer.
Use TITLE as minibuffer prompt.
COMPL-LIST is a completion list to use."
- (let* ((initial (unless (second compl-list)
- (first (first compl-list))))
+ (let* ((initial (unless (cl-second compl-list)
+ (cl-first (cl-first compl-list))))
(class (or (ebrowse-completing-read-value title compl-list initial)
(error "Not found"))))
(setf ebrowse--displayed-class class
@@ -2926,14 +2915,14 @@ COMPL-LIST is a completion list to use."
(interactive "P")
(let ((supers (or (ebrowse-direct-base-classes ebrowse--displayed-class)
(error "No base classes"))))
- (if (and arg (second supers))
- (let ((alist (loop for s in supers
- collect (cons (ebrowse-qualified-class-name
- (ebrowse-ts-class s))
- s))))
+ (if (and arg (cl-second supers))
+ (let ((alist (cl-loop for s in supers
+ collect (cons (ebrowse-qualified-class-name
+ (ebrowse-ts-class s))
+ s))))
(ebrowse-switch-member-buffer-to-other-class
"Goto base class: " alist))
- (setq ebrowse--displayed-class (first supers)
+ (setq ebrowse--displayed-class (cl-first supers)
ebrowse--member-list
(funcall ebrowse--accessor ebrowse--displayed-class))
(ebrowse-redisplay-member-buffer))))
@@ -2958,20 +2947,21 @@ Prefix arg INC specifies which one."
index cls
(supers (ebrowse-direct-base-classes ebrowse--displayed-class)))
(cl-flet ((trees-alist (trees)
- (loop for tr in trees
- collect (cons (ebrowse-cs-name
- (ebrowse-ts-class tr)) tr))))
+ (cl-loop for tr in trees
+ collect (cons (ebrowse-cs-name
+ (ebrowse-ts-class tr))
+ tr))))
(when supers
- (let ((tree (if (second supers)
+ (let ((tree (if (cl-second supers)
(ebrowse-completing-read-value
"Relative to base class: "
(trees-alist supers) nil)
- (first supers))))
+ (cl-first supers))))
(unless tree (error "Not found"))
(setq containing-list (ebrowse-ts-subclasses tree)))))
(setq index (+ inc (ebrowse-position ebrowse--displayed-class
containing-list)))
- (cond ((minusp index) (message "No previous class"))
+ (cond ((cl-minusp index) (message "No previous class"))
((null (nth index containing-list)) (message "No next class")))
(setq index (max 0 (min index (1- (length containing-list)))))
(setq cls (nth index containing-list))
@@ -2986,16 +2976,16 @@ Prefix arg ARG says which class should be displayed. Default is
the first derived class."
(interactive "P")
(cl-flet ((ebrowse-tree-obarray-as-alist ()
- (loop for s in (ebrowse-ts-subclasses
- ebrowse--displayed-class)
- collect (cons (ebrowse-cs-name
- (ebrowse-ts-class s)) s))))
+ (cl-loop for s in (ebrowse-ts-subclasses
+ ebrowse--displayed-class)
+ collect (cons (ebrowse-cs-name
+ (ebrowse-ts-class s)) s))))
(let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class)
(error "No derived classes"))))
- (if (and arg (second subs))
+ (if (and arg (cl-second subs))
(ebrowse-switch-member-buffer-to-other-class
"Goto derived class: " (ebrowse-tree-obarray-as-alist))
- (setq ebrowse--displayed-class (first subs)
+ (setq ebrowse--displayed-class (cl-first subs)
ebrowse--member-list
(funcall ebrowse--accessor ebrowse--displayed-class))
(ebrowse-redisplay-member-buffer)))))
@@ -3191,15 +3181,15 @@ the first derived class."
EVENT is the mouse event."
(interactive "e")
(mouse-set-point event)
- (case (event-click-count event)
+ (pcase (event-click-count event)
(2 (ebrowse-find-member-definition))
- (1 (case (get-text-property (posn-point (event-start event))
- 'ebrowse-what)
- (member-name
+ (1 (pcase (get-text-property (posn-point (event-start event))
+ 'ebrowse-what)
+ (`member-name
(ebrowse-popup-menu ebrowse-member-name-object-menu event))
- (class-name
+ (`class-name
(ebrowse-popup-menu ebrowse-member-class-name-object-menu event))
- (t
+ (_
(ebrowse-popup-menu ebrowse-member-buffer-object-menu event))))))
@@ -3208,11 +3198,11 @@ EVENT is the mouse event."
EVENT is the mouse event."
(interactive "e")
(mouse-set-point event)
- (case (event-click-count event)
+ (pcase (event-click-count event)
(2 (ebrowse-find-member-definition))
- (1 (case (get-text-property (posn-point (event-start event))
+ (1 (pcase (get-text-property (posn-point (event-start event))
'ebrowse-what)
- (member-name
+ (`member-name
(ebrowse-view-member-definition 0))))))
@@ -3233,11 +3223,11 @@ member was found. The CDR of the acons is described in function
alist)
(when name
(dolist (info (gethash name table) alist)
- (unless (memq (first info) known-classes)
- (setf alist (acons (ebrowse-qualified-class-name
- (ebrowse-ts-class (first info)))
- info alist)
- known-classes (cons (first info) known-classes)))))))
+ (unless (memq (cl-first info) known-classes)
+ (setf alist (cl-acons (ebrowse-qualified-class-name
+ (ebrowse-ts-class (cl-first info)))
+ info alist)
+ known-classes (cons (cl-first info) known-classes)))))))
(defun ebrowse-choose-tree ()
@@ -3247,8 +3237,8 @@ the one he wants. Value is (TREE HEADER BUFFER), with TREE being
the class tree, HEADER the header structure of the tree, and BUFFER
being the tree or member buffer containing the tree."
(let* ((buffer (ebrowse-choose-from-browser-buffers)))
- (if buffer (list (ebrowse-value-in-buffer 'ebrowse--tree buffer)
- (ebrowse-value-in-buffer 'ebrowse--header buffer)
+ (if buffer (list (buffer-local-value 'ebrowse--tree buffer)
+ (buffer-local-value 'ebrowse--header buffer)
buffer))))
@@ -3259,8 +3249,8 @@ Prompt with PROMPT. Insert into the minibuffer a C++ identifier read
from point as default. Value is a list (CLASS-NAME MEMBER-NAME)."
(save-excursion
(let ((members (ebrowse-member-table header)))
- (multiple-value-bind (class-name member-name)
- (values-list (ebrowse-tags-read-member+class-name))
+ (cl-multiple-value-bind (class-name member-name)
+ (cl-values-list (ebrowse-tags-read-member+class-name))
(unless member-name
(error "No member name at point"))
(if members
@@ -3272,7 +3262,7 @@ from point as default. Value is a list (CLASS-NAME MEMBER-NAME)."
(unless (gethash name members)
(if (y-or-n-p "No exact match found. Try substrings? ")
(setq name
- (or (first (ebrowse-list-of-matching-members
+ (or (cl-first (ebrowse-list-of-matching-members
members (regexp-quote name) name))
(error "Sorry, nothing found")))
(error "Canceled")))
@@ -3305,15 +3295,15 @@ Value is a list (TREE ACCESSOR MEMBER) for the member."
(let ((alist (or (ebrowse-class-alist-for-member header name)
(error "No classes with member `%s' found" name))))
(ebrowse-ignoring-completion-case
- (if (null (second alist))
- (cdr (first alist))
+ (if (null (cl-second alist))
+ (cdr (cl-first alist))
(push ?\? unread-command-events)
(cdr (assoc (completing-read "In class: "
alist nil t initial-class-name)
alist))))))
-(defun* ebrowse-tags-view/find-member-decl/defn
+(cl-defun ebrowse-tags-view/find-member-decl/defn
(prefix &key view definition member-name)
"If VIEW is t, view, else find an occurrence of MEMBER-NAME.
@@ -3324,16 +3314,16 @@ of all classes containing a member with the given name and lets
the user choose the class to use. As a last step, a tags search
is performed that positions point on the member declaration or
definition."
- (multiple-value-bind
- (tree header tree-buffer) (values-list (ebrowse-choose-tree))
+ (cl-multiple-value-bind
+ (tree header tree-buffer) (cl-values-list (ebrowse-choose-tree))
(unless tree (error "No class tree"))
(let* ((marker (point-marker))
class-name
(name member-name)
info)
(unless name
- (multiple-value-setq (class-name name)
- (values-list
+ (cl-multiple-value-setq (class-name name)
+ (cl-values-list
(ebrowse-tags-read-name
header
(concat (if view "View" "Find") " member "
@@ -3344,7 +3334,7 @@ definition."
(ebrowse-view/find-member-declaration/definition
prefix view definition info
header
- (ebrowse-value-in-buffer 'ebrowse--tags-file-name tree-buffer))
+ (buffer-local-value 'ebrowse--tags-file-name tree-buffer))
;; Record position jumped to
(ebrowse-push-position (point-marker) info t))))
@@ -3439,14 +3429,14 @@ It is a list (TREE ACCESSOR MEMBER)."
(cond ((null buffer)
(set-buffer tree-buffer)
(switch-to-buffer (ebrowse-display-member-buffer
- (second info) nil (first info))))
+ (cl-second info) nil (cl-first info))))
(t
(switch-to-buffer buffer)
- (setq ebrowse--displayed-class (first info)
- ebrowse--accessor (second info)
+ (setq ebrowse--displayed-class (cl-first info)
+ ebrowse--accessor (cl-second info)
ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class))
(ebrowse-redisplay-member-buffer)))
- (ebrowse-move-point-to-member (ebrowse-ms-name (third info)))))
+ (ebrowse-move-point-to-member (ebrowse-ms-name (cl-third info)))))
(defun ebrowse-tags-display-member-buffer (&optional fix-name)
@@ -3454,13 +3444,13 @@ It is a list (TREE ACCESSOR MEMBER)."
FIX-NAME non-nil means display the buffer for that member.
Otherwise read a member name from point."
(interactive)
- (multiple-value-bind
- (tree header tree-buffer) (values-list (ebrowse-choose-tree))
+ (cl-multiple-value-bind
+ (tree header tree-buffer) (cl-values-list (ebrowse-choose-tree))
(unless tree (error "No class tree"))
(let* ((marker (point-marker)) class-name (name fix-name) info)
(unless name
- (multiple-value-setq (class-name name)
- (values-list
+ (cl-multiple-value-setq (class-name name)
+ (cl-values-list
(ebrowse-tags-read-name header
(concat "Find member list of: ")))))
(setq info (ebrowse-tags-choose-class tree header name class-name))
@@ -3487,7 +3477,7 @@ are not performed."
(interactive)
(let* ((buffer (or (ebrowse-choose-from-browser-buffers)
(error "No tree buffer")))
- (header (ebrowse-value-in-buffer 'ebrowse--header buffer))
+ (header (buffer-local-value 'ebrowse--header buffer))
(members (ebrowse-member-table header))
temp-buffer-setup-hook
(regexp (read-from-minibuffer "List members matching regexp: ")))
@@ -3495,9 +3485,9 @@ are not performed."
(set-buffer standard-output)
(erase-buffer)
(insert "Members matching `" regexp "'\n\n")
- (loop for s in (ebrowse-list-of-matching-members members regexp) do
- (loop for info in (gethash s members) do
- (ebrowse-draw-file-member-info info))))))
+ (cl-loop for s in (ebrowse-list-of-matching-members members regexp) do
+ (cl-loop for info in (gethash s members) do
+ (ebrowse-draw-file-member-info info))))))
(defun ebrowse-tags-list-members-in-file ()
@@ -3508,50 +3498,50 @@ The file name is read from the minibuffer."
(error "No tree buffer")))
(files (with-current-buffer buffer (ebrowse-files-table)))
(file (completing-read "List members in file: " files nil t))
- (header (ebrowse-value-in-buffer 'ebrowse--header buffer))
+ (header (buffer-local-value 'ebrowse--header buffer))
temp-buffer-setup-hook
(members (ebrowse-member-table header)))
(with-output-to-temp-buffer (concat "*Members in file " file "*")
(set-buffer standard-output)
(maphash
(lambda (_member-name list)
- (loop for info in list
- as member = (third info)
- as class = (ebrowse-ts-class (first info))
- when (or (and (null (ebrowse-ms-file member))
- (string= (ebrowse-cs-file class) file))
- (string= file (ebrowse-ms-file member)))
- do (ebrowse-draw-file-member-info info "decl.")
- when (or (and (null (ebrowse-ms-definition-file member))
- (string= (ebrowse-cs-source-file class) file))
- (string= file (ebrowse-ms-definition-file member)))
- do (ebrowse-draw-file-member-info info "defn.")))
+ (cl-loop for info in list
+ as member = (cl-third info)
+ as class = (ebrowse-ts-class (cl-first info))
+ when (or (and (null (ebrowse-ms-file member))
+ (string= (ebrowse-cs-file class) file))
+ (string= file (ebrowse-ms-file member)))
+ do (ebrowse-draw-file-member-info info "decl.")
+ when (or (and (null (ebrowse-ms-definition-file member))
+ (string= (ebrowse-cs-source-file class) file))
+ (string= file (ebrowse-ms-definition-file member)))
+ do (ebrowse-draw-file-member-info info "defn.")))
members))))
-(defun* ebrowse-draw-file-member-info (info &optional (kind ""))
+(cl-defun ebrowse-draw-file-member-info (info &optional (kind ""))
"Display a line in the members info buffer.
INFO describes the member. It has the form (TREE ACCESSOR MEMBER).
TREE is the class of the member to display.
ACCESSOR is the accessor symbol of its member list.
MEMBER is the member structure.
KIND is an additional string printed in the buffer."
- (let* ((tree (first info))
+ (let* ((tree (cl-first info))
(globals-p (ebrowse-globals-tree-p tree)))
(unless globals-p
(insert (ebrowse-cs-name (ebrowse-ts-class tree))))
- (insert "::" (ebrowse-ms-name (third info)))
+ (insert "::" (ebrowse-ms-name (cl-third info)))
(indent-to 40)
(insert kind)
(indent-to 50)
- (insert (case (second info)
- (ebrowse-ts-member-functions "member function")
- (ebrowse-ts-member-variables "member variable")
- (ebrowse-ts-static-functions "static function")
- (ebrowse-ts-static-variables "static variable")
- (ebrowse-ts-friends (if globals-p "define" "friend"))
- (ebrowse-ts-types "type")
- (t "unknown"))
+ (insert (pcase (cl-second info)
+ (`ebrowse-ts-member-functions "member function")
+ (`ebrowse-ts-member-variables "member variable")
+ (`ebrowse-ts-static-functions "static function")
+ (`ebrowse-ts-static-variables "static variable")
+ (`ebrowse-ts-friends (if globals-p "define" "friend"))
+ (`ebrowse-ts-types "type")
+ (_ "unknown"))
"\n")))
(defvar ebrowse-last-completion nil
@@ -3582,11 +3572,11 @@ KIND is an additional string printed in the buffer."
If there's only one tree loaded, use that. Otherwise let the
use choose a tree."
(let* ((buffers (ebrowse-known-class-trees-buffer-list))
- (buffer (cond ((and (first buffers) (not (second buffers)))
- (first buffers))
+ (buffer (cond ((and (cl-first buffers) (not (cl-second buffers)))
+ (cl-first buffers))
(t (or (ebrowse-electric-choose-tree)
(error "No tree buffer")))))
- (header (ebrowse-value-in-buffer 'ebrowse--header buffer)))
+ (header (buffer-local-value 'ebrowse--header buffer)))
(ebrowse-member-table header)))
@@ -3594,13 +3584,13 @@ use choose a tree."
"Return the item following STRING in LIST.
If STRING is the last element, return the first element as successor."
(or (nth (1+ (ebrowse-position string list 'string=)) list)
- (first list)))
+ (cl-first list)))
;;; Symbol completion
;;;###autoload
-(defun* ebrowse-tags-complete-symbol (prefix)
+(cl-defun ebrowse-tags-complete-symbol (prefix)
"Perform completion on the C++ symbol preceding point.
A second call of this function without changing point inserts the next match.
A call with prefix PREFIX reads the symbol to insert from the minibuffer with
@@ -3640,7 +3630,7 @@ completion."
;; buffer: Start new completion.
(t
(let* ((members (ebrowse-some-member-table))
- (completion (first (all-completions pattern members nil))))
+ (completion (cl-first (all-completions pattern members nil))))
(cond ((eq completion t))
((null completion)
(error "Can't find completion for `%s'" pattern))
@@ -3766,15 +3756,15 @@ Searches in all files mentioned in a class tree for something that
looks like a function call to the member."
(interactive)
;; Choose the tree to use if there is more than one.
- (multiple-value-bind (tree header tree-buffer)
- (values-list (ebrowse-choose-tree))
+ (cl-multiple-value-bind (tree header tree-buffer)
+ (cl-values-list (ebrowse-choose-tree))
(unless tree
(error "No class tree"))
;; Get the member name NAME (class-name is ignored).
(let ((name fix-name) class-name regexp)
(unless name
- (multiple-value-setq (class-name name)
- (values-list (ebrowse-tags-read-name header "Find calls of: "))))
+ (cl-multiple-value-setq (class-name name)
+ (cl-values-list (ebrowse-tags-read-name header "Find calls of: "))))
;; Set tags loop form to search for member and begin loop.
(setq regexp (concat "\\<" name "[ \t]*(")
ebrowse-tags-loop-form (list 're-search-forward regexp nil t))
@@ -3786,7 +3776,7 @@ looks like a function call to the member."
;;; Structures of this kind are the elements of the position stack.
-(defstruct (ebrowse-position (:type vector) :named)
+(cl-defstruct (ebrowse-position (:type vector) :named)
file-name ; in which file
point ; point in file
target ; t if target of a jump
@@ -3806,8 +3796,8 @@ looks like a function call to the member."
The string is printed in the electric position list buffer."
(let ((info (ebrowse-position-info position)))
(concat (if (ebrowse-position-target position) "at " "to ")
- (ebrowse-cs-name (ebrowse-ts-class (first info)))
- "::" (ebrowse-ms-name (third info)))))
+ (ebrowse-cs-name (ebrowse-ts-class (cl-first info)))
+ "::" (ebrowse-ms-name (cl-third info)))))
(defun ebrowse-view/find-position (position &optional view)
@@ -3837,7 +3827,7 @@ Positions in buffers that have no file names are not saved."
(let ((too-much (- (length ebrowse-position-stack)
ebrowse-max-positions)))
;; Do not let the stack grow to infinity.
- (when (plusp too-much)
+ (when (cl-plusp too-much)
(setq ebrowse-position-stack
(butlast ebrowse-position-stack too-much)))
;; Push the position.
@@ -4108,9 +4098,9 @@ Otherwise, FILE-NAME specifies the file to save the tree in."
(let ((tree-file (buffer-file-name))
temp-buffer-setup-hook)
(with-output-to-temp-buffer "*Tree Statistics*"
- (multiple-value-bind (classes member-functions member-variables
+ (cl-multiple-value-bind (classes member-functions member-variables
static-functions static-variables)
- (values-list (ebrowse-gather-statistics))
+ (cl-values-list (ebrowse-gather-statistics))
(set-buffer standard-output)
(erase-buffer)
(insert "STATISTICS FOR TREE " (or tree-file "unknown") ":\n\n")
@@ -4142,11 +4132,11 @@ NUMBER-OF-STATIC-VARIABLES:"
(let ((classes 0) (member-functions 0) (member-variables 0)
(static-functions 0) (static-variables 0))
(ebrowse-for-all-trees (tree ebrowse--tree-obarray)
- (incf classes)
- (incf member-functions (length (ebrowse-ts-member-functions tree)))
- (incf member-variables (length (ebrowse-ts-member-variables tree)))
- (incf static-functions (length (ebrowse-ts-static-functions tree)))
- (incf static-variables (length (ebrowse-ts-static-variables tree))))
+ (cl-incf classes)
+ (cl-incf member-functions (length (ebrowse-ts-member-functions tree)))
+ (cl-incf member-variables (length (ebrowse-ts-member-variables tree)))
+ (cl-incf static-functions (length (ebrowse-ts-static-functions tree)))
+ (cl-incf static-variables (length (ebrowse-ts-static-variables tree))))
(list classes member-functions member-variables
static-functions static-variables)))
@@ -4390,12 +4380,12 @@ EVENT is the mouse event."
(mouse-set-point event)
(let* ((where (posn-point (event-start event)))
(property (get-text-property where 'ebrowse-what)))
- (case (event-click-count event)
+ (pcase (event-click-count event)
(1
- (case property
- (class-name
+ (pcase property
+ (`class-name
(ebrowse-popup-menu ebrowse-tree-buffer-class-object-menu event))
- (t
+ (_
(ebrowse-popup-menu ebrowse-tree-buffer-object-menu event)))))))
@@ -4406,9 +4396,9 @@ EVENT is the mouse event."
(mouse-set-point event)
(let* ((where (posn-point (event-start event)))
(property (get-text-property where 'ebrowse-what)))
- (case (event-click-count event)
- (1 (case property
- (class-name
+ (pcase (event-click-count event)
+ (1 (pcase property
+ (`class-name
(ebrowse-tree-command:show-member-functions)))))))
@@ -4419,13 +4409,13 @@ EVENT is the mouse event."
(mouse-set-point event)
(let* ((where (posn-point (event-start event)))
(property (get-text-property where 'ebrowse-what)))
- (case (event-click-count event)
- (2 (case property
- (class-name
+ (pcase (event-click-count event)
+ (2 (pcase property
+ (`class-name
(let ((collapsed (save-excursion (skip-chars-forward "^\r\n")
(looking-at "\r"))))
(ebrowse-collapse-fn (not collapsed))))
- (mark
+ (`mark
(ebrowse-toggle-mark-at-point 1)))))))
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 2664b51eea9..071a0fb6037 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -26,8 +26,6 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
(require 'ring)
(require 'button)
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index a410f45eeb4..85f8b64cf44 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -35,7 +35,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(if (featurep 'xemacs) (require 'overlay))
(defvar flymake-is-running nil
@@ -684,7 +684,7 @@ It's flymake process filter."
(defun flymake-er-get-line-err-info-list (err-info)
(nth 1 err-info))
-(defstruct (flymake-ler
+(cl-defstruct (flymake-ler
(:constructor nil)
(:constructor flymake-ler-make-ler (file line type text &optional full-file)))
file line type text full-file)
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 5ea0f6a3fd2..23a34b85194 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -91,7 +91,7 @@
(require 'gud)
(require 'json)
(require 'bindat)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(declare-function speedbar-change-initial-expansion-list
"speedbar" (new-default))
@@ -2269,8 +2269,7 @@ Return position where LINE begins."
;; gdb-table struct is a way to programmatically construct simple
;; tables. It help to reliably align columns of data in GDB buffers
;; and provides
-(defstruct
- gdb-table
+(cl-defstruct gdb-table
(column-sizes nil)
(rows nil)
(row-properties nil)
@@ -2757,9 +2756,9 @@ corresponding to the mode line clicked."
(add-to-list 'gdb-threads-list
(cons (bindat-get-field thread 'id)
thread))
- (if running
- (incf gdb-running-threads-count)
- (incf gdb-stopped-threads-count))
+ (cl-incf (if running
+ gdb-running-threads-count
+ gdb-stopped-threads-count))
(gdb-table-add-row table
(list
diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el
index 7c131dd316c..a5ac7b43057 100644
--- a/lisp/progmodes/glasses.el
+++ b/lisp/progmodes/glasses.el
@@ -51,10 +51,6 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
-
-
;;; User variables
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 0b67bbed7ea..8912e67d603 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -37,8 +37,6 @@
;;; Code:
-(eval-when-compile (require 'cl)) ; for case macro
-
(require 'comint)
(defvar gdb-active-process)
@@ -528,10 +526,10 @@ required by the caller."
nil 'gdb-edit-value)
nil
(if gdb-show-changed-values
- (or parent (case status
- (changed 'font-lock-warning-face)
- (out-of-scope 'shadow)
- (t t)))
+ (or parent (pcase status
+ (`changed 'font-lock-warning-face)
+ (`out-of-scope 'shadow)
+ (_ t)))
t)
depth)
(if (eq status 'out-of-scope) (setq parent 'shadow))
@@ -549,10 +547,10 @@ required by the caller."
nil 'gdb-edit-value)
nil
(if gdb-show-changed-values
- (or parent (case status
- (changed 'font-lock-warning-face)
- (out-of-scope 'shadow)
- (t t)))
+ (or parent (pcase status
+ (`changed 'font-lock-warning-face)
+ (`out-of-scope 'shadow)
+ (_ t)))
t)
depth)
(speedbar-make-tag-line
@@ -3412,11 +3410,11 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference."
(defun gud-tooltip-print-command (expr)
"Return a suitable command to print the expression EXPR."
- (case gud-minor-mode
- (gdbmi (concat "-data-evaluate-expression " expr))
- (dbx (concat "print " expr))
- ((xdb pdb) (concat "p " expr))
- (sdb (concat expr "/"))))
+ (pcase gud-minor-mode
+ (`gdbmi (concat "-data-evaluate-expression " expr))
+ (`dbx (concat "print " expr))
+ ((or `xdb `pdb) (concat "p " expr))
+ (`sdb (concat expr "/"))))
(declare-function gdb-input "gdb-mi" (command handler))
(declare-function tooltip-expr-to-print "tooltip" (event))
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 2e943be412b..519e5aef2bc 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -54,7 +54,7 @@
(require 'json nil t)
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'comint)
(require 'ido))
@@ -240,12 +240,11 @@ name as matched contains
")
(defconst js--available-frameworks
- (loop with available-frameworks
- for style in js--class-styles
- for framework = (plist-get style :framework)
- unless (memq framework available-frameworks)
- collect framework into available-frameworks
- finally return available-frameworks)
+ (cl-loop for style in js--class-styles
+ for framework = (plist-get style :framework)
+ unless (memq framework available-frameworks)
+ collect framework into available-frameworks
+ finally return available-frameworks)
"List of available JavaScript frameworks symbols.")
(defconst js--function-heading-1-re
@@ -374,7 +373,7 @@ Match group 1 is the name of the macro.")
;; (The exception for b-end and its caveats is described below.)
;;
-(defstruct (js--pitem (:type list))
+(cl-defstruct (js--pitem (:type list))
;; IMPORTANT: Do not alter the position of fields within the list.
;; Various bits of code depend on their positions, particularly
;; anything that manipulates the list of children.
@@ -555,10 +554,10 @@ getting timeout messages."
(make-variable-buffer-local 'js--state-at-last-parse-pos)
(defun js--flatten-list (list)
- (loop for item in list
- nconc (cond ((consp item)
- (js--flatten-list item))
- (item (list item)))))
+ (cl-loop for item in list
+ nconc (cond ((consp item)
+ (js--flatten-list item))
+ (item (list item)))))
(defun js--maybe-join (prefix separator suffix &rest list)
"Helper function for `js--update-quick-match-re'.
@@ -768,13 +767,13 @@ If invoked while inside a macro, treat the macro as normal text."
"Move forward over a whole JavaScript expression.
This function doesn't move over expressions continued across
lines."
- (loop
+ (cl-loop
;; non-continued case; simplistic, but good enough?
- do (loop until (or (eolp)
- (progn
- (forward-comment most-positive-fixnum)
- (memq (char-after) '(?\, ?\; ?\] ?\) ?\}))))
- do (forward-sexp))
+ do (cl-loop until (or (eolp)
+ (progn
+ (forward-comment most-positive-fixnum)
+ (memq (char-after) '(?\, ?\; ?\] ?\) ?\}))))
+ do (forward-sexp))
while (and (eq (char-after) ?\n)
(save-excursion
@@ -788,7 +787,7 @@ This puts point at the 'function' keyword.
If this is a syntactically-correct non-expression function,
return the name of the function, or t if the name could not be
determined. Otherwise, return nil."
- (assert (looking-at "\\_<function\\_>"))
+ (cl-assert (looking-at "\\_<function\\_>"))
(let ((name t))
(forward-word)
(forward-comment most-positive-fixnum)
@@ -847,32 +846,32 @@ anything."
"Helper function for `js--beginning-of-defun-nested'.
If PSTATE represents a non-empty top-level defun, return the
top-most pitem. Otherwise, return nil."
- (loop for pitem in pstate
- with func-depth = 0
- with func-pitem
- if (eq 'function (js--pitem-type pitem))
- do (incf func-depth)
- and do (setq func-pitem pitem)
- finally return (if (eq func-depth 1) func-pitem)))
+ (cl-loop for pitem in pstate
+ with func-depth = 0
+ with func-pitem
+ if (eq 'function (js--pitem-type pitem))
+ do (cl-incf func-depth)
+ and do (setq func-pitem pitem)
+ finally return (if (eq func-depth 1) func-pitem)))
(defun js--beginning-of-defun-nested ()
"Helper function for `js--beginning-of-defun'.
Return the pitem of the function we went to the beginning of."
(or
;; Look for the smallest function that encloses point...
- (loop for pitem in (js--parse-state-at-point)
- if (and (eq 'function (js--pitem-type pitem))
- (js--inside-pitem-p pitem))
- do (goto-char (js--pitem-h-begin pitem))
- and return pitem)
+ (cl-loop for pitem in (js--parse-state-at-point)
+ if (and (eq 'function (js--pitem-type pitem))
+ (js--inside-pitem-p pitem))
+ do (goto-char (js--pitem-h-begin pitem))
+ and return pitem)
;; ...and if that isn't found, look for the previous top-level
;; defun
- (loop for pstate = (js--backward-pstate)
- while pstate
- if (js--pstate-is-toplevel-defun pstate)
- do (goto-char (js--pitem-h-begin it))
- and return it)))
+ (cl-loop for pstate = (js--backward-pstate)
+ while pstate
+ if (js--pstate-is-toplevel-defun pstate)
+ do (goto-char (js--pitem-h-begin it))
+ and return it)))
(defun js--beginning-of-defun-flat ()
"Helper function for `js-beginning-of-defun'."
@@ -884,7 +883,7 @@ Return the pitem of the function we went to the beginning of."
"Value of `beginning-of-defun-function' for `js-mode'."
(setq arg (or arg 1))
(while (and (not (eobp)) (< arg 0))
- (incf arg)
+ (cl-incf arg)
(when (and (not js-flat-functions)
(or (eq (js-syntactic-context) 'function)
(js--function-prologue-beginning)))
@@ -896,7 +895,7 @@ Return the pitem of the function we went to the beginning of."
(goto-char (point-max))))
(while (> arg 0)
- (decf arg)
+ (cl-decf arg)
;; If we're just past the end of a function, the user probably wants
;; to go to the beginning of *that* function
(when (eq (char-before) ?})
@@ -925,14 +924,14 @@ BEG defaults to `point-min', meaning to flush the entire cache."
(defun js--ensure-cache--pop-if-ended (open-items paren-depth)
(let ((top-item (car open-items)))
(when (<= paren-depth (js--pitem-paren-depth top-item))
- (assert (not (get-text-property (1- (point)) 'js-pend)))
+ (cl-assert (not (get-text-property (1- (point)) 'js-pend)))
(put-text-property (1- (point)) (point) 'js--pend top-item)
(setf (js--pitem-b-end top-item) (point))
(setq open-items
;; open-items must contain at least two items for this to
;; work, but because we push a dummy item to start with,
;; that assumption holds.
- (cons (js--pitem-add-child (second open-items) top-item)
+ (cons (js--pitem-add-child (cl-second open-items) top-item)
(cddr open-items)))))
open-items)
@@ -950,7 +949,7 @@ the body of `js--ensure-cache'."
;; Make sure parse-partial-sexp doesn't stop because we *entered*
;; the given depth -- i.e., make sure we're deeper than the target
;; depth.
- (assert (> (nth 0 parse)
+ (cl-assert (> (nth 0 parse)
(js--pitem-paren-depth (car open-items))))
(setq parse (parse-partial-sexp
prev-parse-point goal-point
@@ -1045,10 +1044,10 @@ LIMIT defaults to point."
;; Figure out which class styles we need to look for
(setq filtered-class-styles
- (loop for style in js--class-styles
- if (memq (plist-get style :framework)
- js-enabled-frameworks)
- collect style))
+ (cl-loop for style in js--class-styles
+ if (memq (plist-get style :framework)
+ js-enabled-frameworks)
+ collect style))
(save-excursion
(save-restriction
@@ -1067,7 +1066,7 @@ LIMIT defaults to point."
(unless (bobp)
(setq open-items (get-text-property (1- (point))
'js--pstate))
- (assert open-items))))
+ (cl-assert open-items))))
(unless open-items
;; Make a placeholder for the top-level definition
@@ -1080,97 +1079,98 @@ LIMIT defaults to point."
(narrow-to-region (point-min) limit)
- (loop while (re-search-forward js--quick-match-re-func nil t)
- for orig-match-start = (goto-char (match-beginning 0))
- for orig-match-end = (match-end 0)
- do (js--ensure-cache--update-parse)
- for orig-depth = (nth 0 parse)
-
- ;; Each of these conditions should return non-nil if
- ;; we should add a new item and leave point at the end
- ;; of the new item's header (h-end in the
- ;; js--pitem diagram). This point is the one
- ;; after the last character we need to unambiguously
- ;; detect this construct. If one of these evaluates to
- ;; nil, the location of the point is ignored.
- if (cond
- ;; In comment or string
- ((nth 8 parse) nil)
-
- ;; Regular function declaration
- ((and (looking-at "\\_<function\\_>")
- (setq name (js--forward-function-decl)))
-
- (when (eq name t)
- (setq name (js--guess-function-name orig-match-end))
- (if name
- (when js--guess-function-name-start
- (setq orig-match-start
- js--guess-function-name-start))
-
- (setq name t)))
-
- (assert (eq (char-after) ?{))
- (forward-char)
- (make-js--pitem
- :paren-depth orig-depth
- :h-begin orig-match-start
- :type 'function
- :name (if (eq name t)
- name
- (js--split-name name))))
-
- ;; Macro
- ((looking-at js--macro-decl-re)
-
- ;; Macros often contain unbalanced parentheses.
- ;; Make sure that h-end is at the textual end of
- ;; the macro no matter what the parenthesis say.
- (c-end-of-macro)
- (js--ensure-cache--update-parse)
-
- (make-js--pitem
- :paren-depth (nth 0 parse)
- :h-begin orig-match-start
- :type 'macro
- :name (list (match-string-no-properties 1))))
-
- ;; "Prototype function" declaration
- ((looking-at js--plain-method-re)
- (goto-char (match-beginning 3))
- (when (save-match-data
- (js--forward-function-decl))
- (forward-char)
- (make-js--pitem
- :paren-depth orig-depth
- :h-begin orig-match-start
- :type 'function
- :name (nconc (js--split-name
- (match-string-no-properties 1))
- (list (match-string-no-properties 2))))))
-
- ;; Class definition
- ((loop with syntactic-context =
- (js--syntactic-context-from-pstate open-items)
- for class-style in filtered-class-styles
- if (and (memq syntactic-context
- (plist-get class-style :contexts))
- (looking-at (plist-get class-style
- :class-decl)))
- do (goto-char (match-end 0))
- and return
- (make-js--pitem
- :paren-depth orig-depth
- :h-begin orig-match-start
- :type class-style
- :name (js--split-name
- (match-string-no-properties 1))))))
-
- do (js--ensure-cache--update-parse)
- and do (push it open-items)
- and do (put-text-property
- (1- (point)) (point) 'js--pstate open-items)
- else do (goto-char orig-match-end))
+ (cl-loop while (re-search-forward js--quick-match-re-func nil t)
+ for orig-match-start = (goto-char (match-beginning 0))
+ for orig-match-end = (match-end 0)
+ do (js--ensure-cache--update-parse)
+ for orig-depth = (nth 0 parse)
+
+ ;; Each of these conditions should return non-nil if
+ ;; we should add a new item and leave point at the end
+ ;; of the new item's header (h-end in the
+ ;; js--pitem diagram). This point is the one
+ ;; after the last character we need to unambiguously
+ ;; detect this construct. If one of these evaluates to
+ ;; nil, the location of the point is ignored.
+ if (cond
+ ;; In comment or string
+ ((nth 8 parse) nil)
+
+ ;; Regular function declaration
+ ((and (looking-at "\\_<function\\_>")
+ (setq name (js--forward-function-decl)))
+
+ (when (eq name t)
+ (setq name (js--guess-function-name orig-match-end))
+ (if name
+ (when js--guess-function-name-start
+ (setq orig-match-start
+ js--guess-function-name-start))
+
+ (setq name t)))
+
+ (cl-assert (eq (char-after) ?{))
+ (forward-char)
+ (make-js--pitem
+ :paren-depth orig-depth
+ :h-begin orig-match-start
+ :type 'function
+ :name (if (eq name t)
+ name
+ (js--split-name name))))
+
+ ;; Macro
+ ((looking-at js--macro-decl-re)
+
+ ;; Macros often contain unbalanced parentheses.
+ ;; Make sure that h-end is at the textual end of
+ ;; the macro no matter what the parenthesis say.
+ (c-end-of-macro)
+ (js--ensure-cache--update-parse)
+
+ (make-js--pitem
+ :paren-depth (nth 0 parse)
+ :h-begin orig-match-start
+ :type 'macro
+ :name (list (match-string-no-properties 1))))
+
+ ;; "Prototype function" declaration
+ ((looking-at js--plain-method-re)
+ (goto-char (match-beginning 3))
+ (when (save-match-data
+ (js--forward-function-decl))
+ (forward-char)
+ (make-js--pitem
+ :paren-depth orig-depth
+ :h-begin orig-match-start
+ :type 'function
+ :name (nconc (js--split-name
+ (match-string-no-properties 1))
+ (list (match-string-no-properties 2))))))
+
+ ;; Class definition
+ ((cl-loop
+ with syntactic-context =
+ (js--syntactic-context-from-pstate open-items)
+ for class-style in filtered-class-styles
+ if (and (memq syntactic-context
+ (plist-get class-style :contexts))
+ (looking-at (plist-get class-style
+ :class-decl)))
+ do (goto-char (match-end 0))
+ and return
+ (make-js--pitem
+ :paren-depth orig-depth
+ :h-begin orig-match-start
+ :type class-style
+ :name (js--split-name
+ (match-string-no-properties 1))))))
+
+ do (js--ensure-cache--update-parse)
+ and do (push it open-items)
+ and do (put-text-property
+ (1- (point)) (point) 'js--pstate open-items)
+ else do (goto-char orig-match-end))
(goto-char limit)
(js--ensure-cache--update-parse)
@@ -1181,12 +1181,12 @@ LIMIT defaults to point."
(defun js--end-of-defun-flat ()
"Helper function for `js-end-of-defun'."
- (loop while (js--re-search-forward "}" nil t)
- do (js--ensure-cache)
- if (get-text-property (1- (point)) 'js--pend)
- if (eq 'function (js--pitem-type it))
- return t
- finally do (goto-char (point-max))))
+ (cl-loop while (js--re-search-forward "}" nil t)
+ do (js--ensure-cache)
+ if (get-text-property (1- (point)) 'js--pend)
+ if (eq 'function (js--pitem-type it))
+ return t
+ finally do (goto-char (point-max))))
(defun js--end-of-defun-nested ()
"Helper function for `js-end-of-defun'."
@@ -1218,14 +1218,14 @@ LIMIT defaults to point."
"Value of `end-of-defun-function' for `js-mode'."
(setq arg (or arg 1))
(while (and (not (bobp)) (< arg 0))
- (incf arg)
+ (cl-incf arg)
(js-beginning-of-defun)
(js-beginning-of-defun)
(unless (bobp)
(js-end-of-defun)))
(while (> arg 0)
- (decf arg)
+ (cl-decf arg)
;; look for function backward. if we're inside it, go to that
;; function's end. otherwise, search for the next function's end and
;; go there
@@ -1349,7 +1349,7 @@ REGEXPS, but only if FRAMEWORK is in `js-enabled-frameworks'."
If FUNC is supplied, call it with no arguments before every
variable name in the spec. Return true iff this was actually a
spec. FUNC must preserve the match data."
- (case (char-after)
+ (pcase (char-after)
(?\[
(forward-char)
(while
@@ -1554,8 +1554,8 @@ point of view of font-lock. It applies highlighting directly with
(defun js--inside-pitem-p (pitem)
"Return whether point is inside the given pitem's header or body."
(js--ensure-cache)
- (assert (js--pitem-h-begin pitem))
- (assert (js--pitem-paren-depth pitem))
+ (cl-assert (js--pitem-h-begin pitem))
+ (cl-assert (js--pitem-paren-depth pitem))
(and (> (point) (js--pitem-h-begin pitem))
(or (null (js--pitem-b-end pitem))
@@ -1576,11 +1576,11 @@ will be returned."
;; Loop until we either hit a pitem at BOB or pitem ends after
;; point (or at point if we're at eob)
- (loop for pitem = (car pstate)
- until (or (eq (js--pitem-type pitem)
- 'toplevel)
- (js--inside-pitem-p pitem))
- do (pop pstate))
+ (cl-loop for pitem = (car pstate)
+ until (or (eq (js--pitem-type pitem)
+ 'toplevel)
+ (js--inside-pitem-p pitem))
+ do (pop pstate))
pstate))))
@@ -1609,22 +1609,22 @@ context."
(defun js--class-decl-matcher (limit)
"Font lock function used by `js-mode'.
This performs fontification according to `js--class-styles'."
- (loop initially (js--ensure-cache limit)
- while (re-search-forward js--quick-match-re limit t)
- for orig-end = (match-end 0)
- do (goto-char (match-beginning 0))
- if (loop for style in js--class-styles
- for decl-re = (plist-get style :class-decl)
- if (and (memq (plist-get style :framework)
- js-enabled-frameworks)
- (memq (js-syntactic-context)
- (plist-get style :contexts))
- decl-re
- (looking-at decl-re))
- do (goto-char (match-end 0))
- and return t)
- return t
- else do (goto-char orig-end)))
+ (cl-loop initially (js--ensure-cache limit)
+ while (re-search-forward js--quick-match-re limit t)
+ for orig-end = (match-end 0)
+ do (goto-char (match-beginning 0))
+ if (cl-loop for style in js--class-styles
+ for decl-re = (plist-get style :class-decl)
+ if (and (memq (plist-get style :framework)
+ js-enabled-frameworks)
+ (memq (js-syntactic-context)
+ (plist-get style :contexts))
+ decl-re
+ (looking-at decl-re))
+ do (goto-char (match-end 0))
+ and return t)
+ return t
+ else do (goto-char orig-end)))
(defconst js--font-lock-keywords
'(js--font-lock-keywords-3 js--font-lock-keywords-1
@@ -1789,7 +1789,7 @@ nil."
js-expr-indent-offset))
(t
(+ (current-column) js-indent-level
- (case (char-after (nth 1 parse-status))
+ (pcase (char-after (nth 1 parse-status))
(?\( js-paren-indent-offset)
(?\[ js-square-indent-offset)
(?\{ js-curly-indent-offset))))))
@@ -1821,15 +1821,17 @@ nil."
(defun js-c-fill-paragraph (&optional justify)
"Fill the paragraph with `c-fill-paragraph'."
(interactive "*P")
- (letf (((symbol-function 'c-forward-sws)
- (lambda (&optional limit)
- (js--forward-syntactic-ws limit)))
- ((symbol-function 'c-backward-sws)
- (lambda (&optional limit)
- (js--backward-syntactic-ws limit)))
- ((symbol-function 'c-beginning-of-macro)
- (lambda (&optional limit)
- (js--beginning-of-macro limit))))
+ ;; FIXME: Such redefinitions are bad style. We should try and use some other
+ ;; way to get the same result.
+ (cl-letf (((symbol-function 'c-forward-sws)
+ (lambda (&optional limit)
+ (js--forward-syntactic-ws limit)))
+ ((symbol-function 'c-backward-sws)
+ (lambda (&optional limit)
+ (js--backward-syntactic-ws limit)))
+ ((symbol-function 'c-beginning-of-macro)
+ (lambda (&optional limit)
+ (js--beginning-of-macro limit))))
(let ((fill-paragraph-function 'c-fill-paragraph))
(c-fill-paragraph justify))))
@@ -1924,8 +1926,8 @@ the broken-down class name of the item to insert."
name-parts
(mapcar #'js--pitem-name items))
- (assert (stringp top-name))
- (assert (> (length top-name) 0))
+ (cl-assert (stringp top-name))
+ (cl-assert (> (length top-name) 0))
;; If top-name isn't found in items, then we build a copy of items
;; and throw it away. But that's okay, since most of the time, we
@@ -1990,10 +1992,10 @@ the broken-down class name of the item to insert."
(defun js--pitem-add-child (pitem child)
"Copy `js--pitem' PITEM, and push CHILD onto its list of children."
- (assert (integerp (js--pitem-h-begin child)))
- (assert (if (consp (js--pitem-name child))
- (loop for part in (js--pitem-name child)
- always (stringp part))
+ (cl-assert (integerp (js--pitem-h-begin child)))
+ (cl-assert (if (consp (js--pitem-name child))
+ (cl-loop for part in (js--pitem-name child)
+ always (stringp part))
t))
;; This trick works because we know (based on our defstructs) that
@@ -2015,7 +2017,7 @@ the broken-down class name of the item to insert."
;; name is a list here because down in
;; `js--ensure-cache', we made sure to only add
;; class entries with lists for :name
- (assert (consp name))
+ (cl-assert (consp name))
(js--splice-into-items (car pitem) child name))
(t
@@ -2040,11 +2042,11 @@ the broken-down class name of the item to insert."
(setq pitem-name (js--pitem-strname pitem))
(when (eq pitem-name t)
(setq pitem-name (format "[unknown %s]"
- (incf (car unknown-ctr)))))
+ (cl-incf (car unknown-ctr)))))
(cond
((memq pitem-type '(function macro))
- (assert (integerp (js--pitem-h-begin pitem)))
+ (cl-assert (integerp (js--pitem-h-begin pitem)))
(push (cons pitem-name
(js--maybe-make-marker
(js--pitem-h-begin pitem)))
@@ -2059,7 +2061,7 @@ the broken-down class name of the item to insert."
imenu-items))
((js--pitem-h-begin pitem)
- (assert (integerp (js--pitem-h-begin pitem)))
+ (cl-assert (integerp (js--pitem-h-begin pitem)))
(setq subitems (list
(cons "[empty]"
(js--maybe-make-marker
@@ -2078,7 +2080,7 @@ the broken-down class name of the item to insert."
(widen)
(goto-char (point-max))
(js--ensure-cache)
- (assert (or (= (point-min) (point-max))
+ (cl-assert (or (= (point-min) (point-max))
(eq js--last-parse-pos (point))))
(when js--last-parse-pos
(let ((state js--state-at-last-parse-pos)
@@ -2087,10 +2089,10 @@ the broken-down class name of the item to insert."
;; Make sure everything is closed
(while (cdr state)
(setq state
- (cons (js--pitem-add-child (second state) (car state))
+ (cons (js--pitem-add-child (cl-second state) (car state))
(cddr state))))
- (assert (= (length state) 1))
+ (cl-assert (= (length state) 1))
;; Convert the new-finalized state into what imenu expects
(js--pitems-to-imenu
@@ -2104,34 +2106,34 @@ the broken-down class name of the item to insert."
(mapconcat #'identity parts "."))
(defun js--imenu-to-flat (items prefix symbols)
- (loop for item in items
- if (imenu--subalist-p item)
- do (js--imenu-to-flat
- (cdr item) (concat prefix (car item) ".")
- symbols)
- else
- do (let* ((name (concat prefix (car item)))
- (name2 name)
- (ctr 0))
+ (cl-loop for item in items
+ if (imenu--subalist-p item)
+ do (js--imenu-to-flat
+ (cdr item) (concat prefix (car item) ".")
+ symbols)
+ else
+ do (let* ((name (concat prefix (car item)))
+ (name2 name)
+ (ctr 0))
- (while (gethash name2 symbols)
- (setq name2 (format "%s<%d>" name (incf ctr))))
+ (while (gethash name2 symbols)
+ (setq name2 (format "%s<%d>" name (cl-incf ctr))))
- (puthash name2 (cdr item) symbols))))
+ (puthash name2 (cdr item) symbols))))
(defun js--get-all-known-symbols ()
"Return a hash table of all JavaScript symbols.
This searches all existing `js-mode' buffers. Each key is the
name of a symbol (possibly disambiguated with <N>, where N > 1),
and each value is a marker giving the location of that symbol."
- (loop with symbols = (make-hash-table :test 'equal)
- with imenu-use-markers = t
- for buffer being the buffers
- for imenu-index = (with-current-buffer buffer
- (when (derived-mode-p 'js-mode)
- (js--imenu-create-index)))
- do (js--imenu-to-flat imenu-index "" symbols)
- finally return symbols))
+ (cl-loop with symbols = (make-hash-table :test 'equal)
+ with imenu-use-markers = t
+ for buffer being the buffers
+ for imenu-index = (with-current-buffer buffer
+ (when (derived-mode-p 'js-mode)
+ (js--imenu-create-index)))
+ do (js--imenu-to-flat imenu-index "" symbols)
+ finally return symbols))
(defvar js--symbol-history nil
"History of entered JavaScript symbols.")
@@ -2149,8 +2151,8 @@ marker."
(let ((choice (ido-completing-read
prompt
- (loop for key being the hash-keys of symbols-table
- collect key)
+ (cl-loop for key being the hash-keys of symbols-table
+ collect key)
nil t initial-input 'js--symbol-history)))
(cons choice (gethash choice symbols-table))))
@@ -2204,20 +2206,20 @@ On timeout, return nil. On success, return t with match data
set. If START is non-nil, look for output starting from START.
Otherwise, use the current value of `process-mark'."
(with-current-buffer (process-buffer process)
- (loop with start-pos = (or start
- (marker-position (process-mark process)))
- with end-time = (+ (float-time) timeout)
- for time-left = (- end-time (float-time))
- do (goto-char (point-max))
- if (looking-back regexp start-pos) return t
- while (> time-left 0)
- do (accept-process-output process time-left nil t)
- do (goto-char (process-mark process))
- finally do (signal
- 'js-moz-bad-rpc
- (list (format "Timed out waiting for output matching %S" regexp))))))
-
-(defstruct js--js-handle
+ (cl-loop with start-pos = (or start
+ (marker-position (process-mark process)))
+ with end-time = (+ (float-time) timeout)
+ for time-left = (- end-time (float-time))
+ do (goto-char (point-max))
+ if (looking-back regexp start-pos) return t
+ while (> time-left 0)
+ do (accept-process-output process time-left nil t)
+ do (goto-char (process-mark process))
+ finally do (signal
+ 'js-moz-bad-rpc
+ (list (format "Timed out waiting for output matching %S" regexp))))))
+
+(cl-defstruct js--js-handle
;; Integer, mirrors the value we see in JS
(id nil :read-only t)
@@ -2626,11 +2628,11 @@ with `js--js-encode-value'."
(inferior-moz-process) js--js-repl-prompt-regexp
js-js-timeout))
- (incf js--js-repl-depth)))
+ (cl-incf js--js-repl-depth)))
(defun js--js-leave-repl ()
- (assert (> js--js-repl-depth 0))
- (when (= 0 (decf js--js-repl-depth))
+ (cl-assert (> js--js-repl-depth 0))
+ (when (= 0 (cl-decf js--js-repl-depth))
(with-current-buffer inferior-moz-buffer
(goto-char (point-max))
(js--js-wait-for-eval-prompt)
@@ -2649,33 +2651,33 @@ with `js--js-encode-value'."
(eval-and-compile
(defun js--optimize-arglist (arglist)
"Convert immediate js< and js! references to deferred ones."
- (loop for item in arglist
- if (eq (car-safe item) 'js<)
- collect (append (list 'list ''js--funcall
- '(list 'interactor "_getProp"))
- (js--optimize-arglist (cdr item)))
- else if (eq (car-safe item) 'js>)
- collect (append (list 'list ''js--funcall
- '(list 'interactor "_putProp"))
-
- (if (atom (cadr item))
- (list (cadr item))
- (list
- (append
- (list 'list ''js--funcall
- '(list 'interactor "_mkArray"))
- (js--optimize-arglist (cadr item)))))
- (js--optimize-arglist (cddr item)))
- else if (eq (car-safe item) 'js!)
- collect (destructuring-bind (ignored function &rest body) item
- (append (list 'list ''js--funcall
- (if (consp function)
- (cons 'list
- (js--optimize-arglist function))
- function))
- (js--optimize-arglist body)))
- else
- collect item)))
+ (cl-loop for item in arglist
+ if (eq (car-safe item) 'js<)
+ collect (append (list 'list ''js--funcall
+ '(list 'interactor "_getProp"))
+ (js--optimize-arglist (cdr item)))
+ else if (eq (car-safe item) 'js>)
+ collect (append (list 'list ''js--funcall
+ '(list 'interactor "_putProp"))
+
+ (if (atom (cadr item))
+ (list (cadr item))
+ (list
+ (append
+ (list 'list ''js--funcall
+ '(list 'interactor "_mkArray"))
+ (js--optimize-arglist (cadr item)))))
+ (js--optimize-arglist (cddr item)))
+ else if (eq (car-safe item) 'js!)
+ collect (pcase-let ((`(,_ ,function . ,body) item))
+ (append (list 'list ''js--funcall
+ (if (consp function)
+ (cons 'list
+ (js--optimize-arglist function))
+ function))
+ (js--optimize-arglist body)))
+ else
+ collect item)))
(defmacro js--js-get-service (class-name interface-name)
`(js! ("Components" "classes" ,class-name "getService")
@@ -2698,56 +2700,56 @@ Inside the lexical scope of `with-js', `js?', `js!',
`(progn
(js--js-enter-repl)
(unwind-protect
- (macrolet ((js? (&rest body) `(js--js-true ,@body))
- (js! (function &rest body)
- `(js--js-funcall
- ,(if (consp function)
- (cons 'list
- (js--optimize-arglist function))
- function)
- ,@(js--optimize-arglist body)))
-
- (js-new (function &rest body)
- `(js--js-new
+ (cl-macrolet ((js? (&rest body) `(js--js-true ,@body))
+ (js! (function &rest body)
+ `(js--js-funcall
,(if (consp function)
(cons 'list
(js--optimize-arglist function))
function)
- ,@body))
-
- (js-eval (thisobj js)
- `(js--js-eval
- ,@(js--optimize-arglist
- (list thisobj js))))
-
- (js-list (&rest args)
- `(js--js-list
- ,@(js--optimize-arglist args)))
-
- (js-get-service (&rest args)
- `(js--js-get-service
- ,@(js--optimize-arglist args)))
-
- (js-create-instance (&rest args)
- `(js--js-create-instance
- ,@(js--optimize-arglist args)))
-
- (js-qi (&rest args)
- `(js--js-qi
- ,@(js--optimize-arglist args)))
-
- (js< (&rest body) `(js--js-get
- ,@(js--optimize-arglist body)))
- (js> (props value)
- `(js--js-funcall
- '(interactor "_putProp")
- ,(if (consp props)
- (cons 'list
- (js--optimize-arglist props))
- props)
- ,@(js--optimize-arglist (list value))
- ))
- (js-handle? (arg) `(js--js-handle-p ,arg)))
+ ,@(js--optimize-arglist body)))
+
+ (js-new (function &rest body)
+ `(js--js-new
+ ,(if (consp function)
+ (cons 'list
+ (js--optimize-arglist function))
+ function)
+ ,@body))
+
+ (js-eval (thisobj js)
+ `(js--js-eval
+ ,@(js--optimize-arglist
+ (list thisobj js))))
+
+ (js-list (&rest args)
+ `(js--js-list
+ ,@(js--optimize-arglist args)))
+
+ (js-get-service (&rest args)
+ `(js--js-get-service
+ ,@(js--optimize-arglist args)))
+
+ (js-create-instance (&rest args)
+ `(js--js-create-instance
+ ,@(js--optimize-arglist args)))
+
+ (js-qi (&rest args)
+ `(js--js-qi
+ ,@(js--optimize-arglist args)))
+
+ (js< (&rest body) `(js--js-get
+ ,@(js--optimize-arglist body)))
+ (js> (props value)
+ `(js--js-funcall
+ '(interactor "_putProp")
+ ,(if (consp props)
+ (cons 'list
+ (js--optimize-arglist props))
+ props)
+ ,@(js--optimize-arglist (list value))
+ ))
+ (js-handle? (arg) `(js--js-handle-p ,arg)))
,@forms)
(js--js-leave-repl))))
@@ -2756,21 +2758,22 @@ Inside the lexical scope of `with-js', `js?', `js!',
If nil, the whole Array is treated as a JS symbol.")
(defun js--js-decode-retval (result)
- (ecase (intern (first result))
- (atom (second result))
- (special (intern (second result)))
- (array
- (mapcar #'js--js-decode-retval (second result)))
- (objid
- (or (gethash (second result)
- js--js-references)
- (puthash (second result)
- (make-js--js-handle
- :id (second result)
- :process (inferior-moz-process))
- js--js-references)))
-
- (error (signal 'js-js-error (list (second result))))))
+ (pcase (intern (cl-first result))
+ (`atom (cl-second result))
+ (`special (intern (cl-second result)))
+ (`array
+ (mapcar #'js--js-decode-retval (cl-second result)))
+ (`objid
+ (or (gethash (cl-second result)
+ js--js-references)
+ (puthash (cl-second result)
+ (make-js--js-handle
+ :id (cl-second result)
+ :process (inferior-moz-process))
+ js--js-references)))
+
+ (`error (signal 'js-js-error (list (cl-second result))))
+ (x (error "Unmatched case in js--js-decode-retval: %S" x))))
(defun js--js-funcall (function &rest arguments)
"Call the Mozilla function FUNCTION with arguments ARGUMENTS.
@@ -2853,9 +2856,9 @@ With argument, run even if no intervening GC has happened."
(looking-back js--js-prompt-regexp
(save-excursion (forward-line 0) (point))))))
- (setq keys (loop for x being the hash-keys
- of js--js-references
- collect x))
+ (setq keys (cl-loop for x being the hash-keys
+ of js--js-references
+ collect x))
(setq num (js--js-funcall '(repl "_jsGC") (or keys [])))
(setq js--js-last-gcs-done this-gcs-done)
@@ -2889,58 +2892,58 @@ left-to-right."
(with-js
(let (windows)
- (loop with window-mediator = (js! ("Components" "classes"
- "@mozilla.org/appshell/window-mediator;1"
- "getService")
- (js< "Components" "interfaces"
- "nsIWindowMediator"))
- with enumerator = (js! (window-mediator "getEnumerator") nil)
-
- while (js? (js! (enumerator "hasMoreElements")))
- for window = (js! (enumerator "getNext"))
- for window-info = (js-list window
- (js< window "document" "title")
- (js! (window "location" "toString"))
- (js< window "closed")
- (js< window "windowState"))
-
- unless (or (js? (fourth window-info))
- (eq (fifth window-info) 2))
- do (push window-info windows))
-
- (loop for window-info in windows
- for window = (first window-info)
- collect (list (second window-info)
- (third window-info)
- window)
-
- for gbrowser = (js< window "gBrowser")
- if (js-handle? gbrowser)
- nconc (loop
- for x below (js< gbrowser "browsers" "length")
- collect (js-list (js< gbrowser
- "browsers"
- x
- "contentDocument"
- "title")
-
- (js! (gbrowser
- "browsers"
- x
- "contentWindow"
- "location"
- "toString"))
- (js< gbrowser
- "browsers"
- x)
-
- (js! (gbrowser
- "tabContainer"
- "childNodes"
- "item")
- x)
-
- gbrowser))))))
+ (cl-loop with window-mediator = (js! ("Components" "classes"
+ "@mozilla.org/appshell/window-mediator;1"
+ "getService")
+ (js< "Components" "interfaces"
+ "nsIWindowMediator"))
+ with enumerator = (js! (window-mediator "getEnumerator") nil)
+
+ while (js? (js! (enumerator "hasMoreElements")))
+ for window = (js! (enumerator "getNext"))
+ for window-info = (js-list window
+ (js< window "document" "title")
+ (js! (window "location" "toString"))
+ (js< window "closed")
+ (js< window "windowState"))
+
+ unless (or (js? (cl-fourth window-info))
+ (eq (cl-fifth window-info) 2))
+ do (push window-info windows))
+
+ (cl-loop for window-info in windows
+ for window = (cl-first window-info)
+ collect (list (cl-second window-info)
+ (cl-third window-info)
+ window)
+
+ for gbrowser = (js< window "gBrowser")
+ if (js-handle? gbrowser)
+ nconc (cl-loop
+ for x below (js< gbrowser "browsers" "length")
+ collect (js-list (js< gbrowser
+ "browsers"
+ x
+ "contentDocument"
+ "title")
+
+ (js! (gbrowser
+ "browsers"
+ x
+ "contentWindow"
+ "location"
+ "toString"))
+ (js< gbrowser
+ "browsers"
+ x)
+
+ (js! (gbrowser
+ "tabContainer"
+ "childNodes"
+ "item")
+ x)
+
+ gbrowser))))))
(defvar js-read-tab-history nil)
@@ -2960,106 +2963,110 @@ browser, respectively."
selected-tab prev-hitab)
;; Disambiguate names
- (setq tabs (loop with tab-names = (make-hash-table :test 'equal)
- for tab in tabs
- for cname = (format "%s (%s)" (second tab) (first tab))
- for num = (incf (gethash cname tab-names -1))
- if (> num 0)
- do (setq cname (format "%s <%d>" cname num))
- collect (cons cname tab)))
-
- (labels ((find-tab-by-cname
- (cname)
- (loop for tab in tabs
- if (equal (car tab) cname)
- return (cdr tab)))
-
- (mogrify-highlighting
- (hitab unhitab)
-
- ;; Hack to reduce the number of
- ;; round-trips to mozilla
- (let (cmds)
- (cond
- ;; Highlighting tab
- ((fourth hitab)
- (push '(js! ((fourth hitab) "setAttribute")
- "style"
- "color: red; font-weight: bold")
- cmds)
-
- ;; Highlight window proper
- (push '(js! ((third hitab)
- "setAttribute")
- "style"
- "border: 8px solid red")
- cmds)
-
- ;; Select tab, when appropriate
- (when js-js-switch-tabs
- (push
- '(js> ((fifth hitab) "selectedTab") (fourth hitab))
- cmds)))
-
- ;; Highlighting whole window
- ((third hitab)
- (push '(js! ((third hitab) "document"
- "documentElement" "setAttribute")
- "style"
- (concat "-moz-appearance: none;"
- "border: 8px solid red;"))
- cmds)))
-
- (cond
- ;; Unhighlighting tab
- ((fourth unhitab)
- (push '(js! ((fourth unhitab) "setAttribute") "style" "")
- cmds)
- (push '(js! ((third unhitab) "setAttribute") "style" "")
- cmds))
-
- ;; Unhighlighting window
- ((third unhitab)
- (push '(js! ((third unhitab) "document"
- "documentElement" "setAttribute")
- "style" "")
- cmds)))
-
- (eval (list 'with-js
- (cons 'js-list (nreverse cmds))))))
-
- (command-hook
- ()
- (let* ((tab (find-tab-by-cname (car ido-matches))))
- (mogrify-highlighting tab prev-hitab)
- (setq prev-hitab tab)))
-
- (setup-hook
- ()
- ;; Fiddle with the match list a bit: if our first match
- ;; is a tabbrowser window, rotate the match list until
- ;; the active tab comes up
- (let ((matched-tab (find-tab-by-cname (car ido-matches))))
- (when (and matched-tab
- (null (fourth matched-tab))
- (equal "navigator:browser"
- (js! ((third matched-tab)
- "document"
- "documentElement"
- "getAttribute")
- "windowtype")))
-
- (loop with tab-to-match = (js< (third matched-tab)
- "gBrowser"
- "selectedTab")
-
- for match in ido-matches
- for candidate-tab = (find-tab-by-cname match)
- if (eq (fourth candidate-tab) tab-to-match)
- do (setq ido-cur-list (ido-chop ido-cur-list match))
- and return t)))
-
- (add-hook 'post-command-hook #'command-hook t t)))
+ (setq tabs
+ (cl-loop with tab-names = (make-hash-table :test 'equal)
+ for tab in tabs
+ for cname = (format "%s (%s)"
+ (cl-second tab) (cl-first tab))
+ for num = (cl-incf (gethash cname tab-names -1))
+ if (> num 0)
+ do (setq cname (format "%s <%d>" cname num))
+ collect (cons cname tab)))
+
+ (cl-labels
+ ((find-tab-by-cname
+ (cname)
+ (cl-loop for tab in tabs
+ if (equal (car tab) cname)
+ return (cdr tab)))
+
+ (mogrify-highlighting
+ (hitab unhitab)
+
+ ;; Hack to reduce the number of
+ ;; round-trips to mozilla
+ (let (cmds)
+ (cond
+ ;; Highlighting tab
+ ((cl-fourth hitab)
+ (push '(js! ((cl-fourth hitab) "setAttribute")
+ "style"
+ "color: red; font-weight: bold")
+ cmds)
+
+ ;; Highlight window proper
+ (push '(js! ((cl-third hitab)
+ "setAttribute")
+ "style"
+ "border: 8px solid red")
+ cmds)
+
+ ;; Select tab, when appropriate
+ (when js-js-switch-tabs
+ (push
+ '(js> ((cl-fifth hitab) "selectedTab") (cl-fourth hitab))
+ cmds)))
+
+ ;; Highlighting whole window
+ ((cl-third hitab)
+ (push '(js! ((cl-third hitab) "document"
+ "documentElement" "setAttribute")
+ "style"
+ (concat "-moz-appearance: none;"
+ "border: 8px solid red;"))
+ cmds)))
+
+ (cond
+ ;; Unhighlighting tab
+ ((cl-fourth unhitab)
+ (push '(js! ((cl-fourth unhitab) "setAttribute") "style" "")
+ cmds)
+ (push '(js! ((cl-third unhitab) "setAttribute") "style" "")
+ cmds))
+
+ ;; Unhighlighting window
+ ((cl-third unhitab)
+ (push '(js! ((cl-third unhitab) "document"
+ "documentElement" "setAttribute")
+ "style" "")
+ cmds)))
+
+ (eval (list 'with-js
+ (cons 'js-list (nreverse cmds))))))
+
+ (command-hook
+ ()
+ (let* ((tab (find-tab-by-cname (car ido-matches))))
+ (mogrify-highlighting tab prev-hitab)
+ (setq prev-hitab tab)))
+
+ (setup-hook
+ ()
+ ;; Fiddle with the match list a bit: if our first match
+ ;; is a tabbrowser window, rotate the match list until
+ ;; the active tab comes up
+ (let ((matched-tab (find-tab-by-cname (car ido-matches))))
+ (when (and matched-tab
+ (null (cl-fourth matched-tab))
+ (equal "navigator:browser"
+ (js! ((cl-third matched-tab)
+ "document"
+ "documentElement"
+ "getAttribute")
+ "windowtype")))
+
+ (cl-loop with tab-to-match = (js< (cl-third matched-tab)
+ "gBrowser"
+ "selectedTab")
+
+ for match in ido-matches
+ for candidate-tab = (find-tab-by-cname match)
+ if (eq (cl-fourth candidate-tab) tab-to-match)
+ do (setq ido-cur-list
+ (ido-chop ido-cur-list match))
+ and return t)))
+
+ (add-hook 'post-command-hook #'command-hook t t)))
(unwind-protect
@@ -3078,13 +3085,12 @@ browser, respectively."
(add-to-history 'js-read-tab-history selected-tab-cname)
- (setq selected-tab (loop for tab in tabs
- if (equal (car tab) selected-tab-cname)
- return (cdr tab)))
+ (setq selected-tab (cl-loop for tab in tabs
+ if (equal (car tab) selected-tab-cname)
+ return (cdr tab)))
- (if (fourth selected-tab)
- (cons 'browser (third selected-tab))
- (cons 'window (third selected-tab)))))))
+ (cons (if (cl-fourth selected-tab) 'browser 'window)
+ (cl-third selected-tab))))))
(defun js--guess-eval-defun-info (pstate)
"Helper function for `js-eval-defun'.
@@ -3092,19 +3098,19 @@ Return a list (NAME . CLASSPARTS), where CLASSPARTS is a list of
strings making up the class name and NAME is the name of the
function part."
(cond ((and (= (length pstate) 3)
- (eq (js--pitem-type (first pstate)) 'function)
- (= (length (js--pitem-name (first pstate))) 1)
- (consp (js--pitem-type (second pstate))))
+ (eq (js--pitem-type (cl-first pstate)) 'function)
+ (= (length (js--pitem-name (cl-first pstate))) 1)
+ (consp (js--pitem-type (cl-second pstate))))
- (append (js--pitem-name (second pstate))
- (list (first (js--pitem-name (first pstate))))))
+ (append (js--pitem-name (cl-second pstate))
+ (list (cl-first (js--pitem-name (cl-first pstate))))))
((and (= (length pstate) 2)
- (eq (js--pitem-type (first pstate)) 'function))
+ (eq (js--pitem-type (cl-first pstate)) 'function))
(append
- (butlast (js--pitem-name (first pstate)))
- (list (car (last (js--pitem-name (first pstate)))))))
+ (butlast (js--pitem-name (cl-first pstate)))
+ (list (car (last (js--pitem-name (cl-first pstate)))))))
(t (error "Function not a toplevel defun or class member"))))
@@ -3148,19 +3154,21 @@ If one hasn't been set, or if it's stale, prompt for a new one."
(with-js
(when (or (null js--js-context)
(js--js-handle-expired-p (cdr js--js-context))
- (ecase (car js--js-context)
- (window (js? (js< (cdr js--js-context) "closed")))
- (browser (not (js? (js< (cdr js--js-context)
- "contentDocument"))))))
+ (pcase (car js--js-context)
+ (`window (js? (js< (cdr js--js-context) "closed")))
+ (`browser (not (js? (js< (cdr js--js-context)
+ "contentDocument"))))
+ (x (error "Unmatched case in js--get-js-context: %S" x))))
(setq js--js-context (js--read-tab "Javascript Context: ")))
js--js-context))
(defun js--js-content-window (context)
(with-js
- (ecase (car context)
- (window (cdr context))
- (browser (js< (cdr context)
- "contentWindow" "wrappedJSObject")))))
+ (pcase (car context)
+ (`window (cdr context))
+ (`browser (js< (cdr context)
+ "contentWindow" "wrappedJSObject"))
+ (x (error "Unmatched case in js--js-content-window: %S" x)))))
(defun js--make-nsilocalfile (path)
(with-js
@@ -3179,7 +3187,7 @@ If one hasn't been set, or if it's stale, prompt for a new one."
(path-uri (js! (io-service "newFileURI") path-file)))
(js! (res-prot "setSubstitution") alias path-uri))))
-(defun* js-eval-defun ()
+(cl-defun js-eval-defun ()
"Update a Mozilla tab using the JavaScript defun at point."
(interactive)
@@ -3215,7 +3223,7 @@ If one hasn't been set, or if it's stale, prompt for a new one."
(unless (y-or-n-p (format "Send %s to Mozilla? "
(mapconcat #'identity defun-info ".")))
(message "") ; question message lingers until next command
- (return-from js-eval-defun))
+ (cl-return-from js-eval-defun))
(delete-overlay overlay)))
(setq defun-body (buffer-substring-no-properties begin end))
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index ce37fc2c571..b313fd4aee6 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -57,7 +57,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(defgroup pascal nil
"Major mode for editing Pascal source in Emacs."
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 9df9943cc00..848b92868e7 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -102,7 +102,6 @@
;;; Code:
-(eval-when-compile (require 'cl))
(defvar font-lock-comment-face)
(defvar font-lock-doc-face)