diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/avl-tree.el | 534 | ||||
| -rw-r--r-- | lisp/emacs-lisp/backquote.el | 9 | ||||
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 23 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 243 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-loaddefs.el | 118 | ||||
| -rw-r--r-- | lisp/emacs-lisp/edebug.el | 8 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eldoc.el | 7 |
7 files changed, 745 insertions, 197 deletions
diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el new file mode 100644 index 00000000000..ffac825acac --- /dev/null +++ b/lisp/emacs-lisp/avl-tree.el @@ -0,0 +1,534 @@ +;;; avl-tree.el --- balanced binary trees, AVL-trees + +;; Copyright (C) 1995, 2007 Free Software Foundation, Inc. + +;; Author: Per Cederqvist <ceder@lysator.liu.se> +;; Inge Wallin <inge@lysator.liu.se> +;; Thomas Bellman <bellman@lysator.liu.se> +;; Maintainer: FSF +;; Created: 10 May 1991 +;; Keywords: extensions, data structures + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; An AVL tree is a nearly-perfect balanced binary tree. A tree +;; consists of two cons cells, the first one holding the tag +;; 'AVL-TREE in the car cell, and the second one having the tree +;; in the car and the compare function in the cdr cell. The tree has +;; a dummy node as its root with the real tree in the left pointer. +;; +;; Each node of the tree consists of one data element, one left +;; sub-tree and one right sub-tree. Each node also has a balance +;; count, which is the difference in depth of the left and right +;; sub-trees. +;; +;; The "public" functions (prefixed with "avl-tree") are: +;; -create, -p, -compare-function, -empty, -enter, -delete, +;; -member, -map, -first, -last, -copy, -flatten, -size, -clear. + +;;; Code: + +;;; ================================================================ +;;; Functions and macros handling an AVL tree node. + +(defmacro avl-tree-node-create (left right data balance) + ;; Create and return an avl-tree node. + `(vector ,left ,right ,data ,balance)) + +(defmacro avl-tree-node-left (node) + ;; Return the left pointer of NODE. + `(aref ,node 0)) + +(defmacro avl-tree-node-right (node) + ;; Return the right pointer of NODE. + `(aref ,node 1)) + +(defmacro avl-tree-node-data (node) + ;; Return the data of NODE. + `(aref ,node 2)) + +(defmacro avl-tree-node-set-left (node newleft) + ;; Set the left pointer of NODE to NEWLEFT. + `(aset ,node 0 ,newleft)) + +(defmacro avl-tree-node-set-right (node newright) + ;; Set the right pointer of NODE to NEWRIGHT. + `(aset ,node 1 ,newright)) + +(defmacro avl-tree-node-set-data (node newdata) + ;; Set the data of NODE to NEWDATA. + `(aset ,node 2 ,newdata)) + +(defmacro avl-tree-node-branch (node branch) + "Get value of a branch of a node. + +NODE is the node, and BRANCH is the branch. +0 for left pointer, 1 for right pointer and 2 for the data.\"" + `(aref ,node ,branch)) + +(defmacro avl-tree-node-set-branch (node branch newval) + "Set value of a branch of a node. + +NODE is the node, and BRANCH is the branch. +0 for left pointer, 1 for the right pointer and 2 for the data. +NEWVAL is new value of the branch.\"" + `(aset ,node ,branch ,newval)) + +(defmacro avl-tree-node-balance (node) + ;; Return the balance field of a node. + `(aref ,node 3)) + +(defmacro avl-tree-node-set-balance (node newbal) + ;; Set the balance field of a node. + `(aset ,node 3 ,newbal)) + + +;;; ================================================================ +;;; Internal functions for use in the AVL tree package + +(defmacro avl-tree-root (tree) + ;; Return the root node for an avl-tree. INTERNAL USE ONLY. + `(avl-tree-node-left (car (cdr ,tree)))) + +(defmacro avl-tree-dummyroot (tree) + ;; Return the dummy node of an avl-tree. INTERNAL USE ONLY. + `(car (cdr ,tree))) + +(defmacro avl-tree-cmpfun (tree) + ;; Return the compare function of AVL tree TREE. INTERNAL USE ONLY. + `(cdr (cdr ,tree))) + +;; ---------------------------------------------------------------- +;; Deleting data + +(defun avl-tree-del-balance1 (node branch) + ;; Rebalance a tree and return t if the height of the tree has shrunk. + (let ((br (avl-tree-node-branch node branch)) + p1 b1 p2 b2 result) + (cond + ((< (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br 0) + t) + + ((= (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br +1) + nil) + + (t + ;; Rebalance. + (setq p1 (avl-tree-node-right br) + b1 (avl-tree-node-balance p1)) + (if (>= b1 0) + ;; Single RR rotation. + (progn + (avl-tree-node-set-right br (avl-tree-node-left p1)) + (avl-tree-node-set-left p1 br) + (if (= 0 b1) + (progn + (avl-tree-node-set-balance br +1) + (avl-tree-node-set-balance p1 -1) + (setq result nil)) + (avl-tree-node-set-balance br 0) + (avl-tree-node-set-balance p1 0) + (setq result t)) + (avl-tree-node-set-branch node branch p1) + result) + + ;; Double RL rotation. + (setq p2 (avl-tree-node-left p1) + b2 (avl-tree-node-balance p2)) + (avl-tree-node-set-left p1 (avl-tree-node-right p2)) + (avl-tree-node-set-right p2 p1) + (avl-tree-node-set-right br (avl-tree-node-left p2)) + (avl-tree-node-set-left p2 br) + (if (> b2 0) + (avl-tree-node-set-balance br -1) + (avl-tree-node-set-balance br 0)) + (if (< b2 0) + (avl-tree-node-set-balance p1 +1) + (avl-tree-node-set-balance p1 0)) + (avl-tree-node-set-branch node branch p2) + (avl-tree-node-set-balance p2 0) + t))))) + +(defun avl-tree-del-balance2 (node branch) + (let ((br (avl-tree-node-branch node branch)) + p1 b1 p2 b2 result) + (cond + ((> (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br 0) + t) + + ((= (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br -1) + nil) + + (t + ;; Rebalance. + (setq p1 (avl-tree-node-left br) + b1 (avl-tree-node-balance p1)) + (if (<= b1 0) + ;; Single LL rotation. + (progn + (avl-tree-node-set-left br (avl-tree-node-right p1)) + (avl-tree-node-set-right p1 br) + (if (= 0 b1) + (progn + (avl-tree-node-set-balance br -1) + (avl-tree-node-set-balance p1 +1) + (setq result nil)) + (avl-tree-node-set-balance br 0) + (avl-tree-node-set-balance p1 0) + (setq result t)) + (avl-tree-node-set-branch node branch p1) + result) + + ;; Double LR rotation. + (setq p2 (avl-tree-node-right p1) + b2 (avl-tree-node-balance p2)) + (avl-tree-node-set-right p1 (avl-tree-node-left p2)) + (avl-tree-node-set-left p2 p1) + (avl-tree-node-set-left br (avl-tree-node-right p2)) + (avl-tree-node-set-right p2 br) + (if (< b2 0) + (avl-tree-node-set-balance br +1) + (avl-tree-node-set-balance br 0)) + (if (> b2 0) + (avl-tree-node-set-balance p1 -1) + (avl-tree-node-set-balance p1 0)) + (avl-tree-node-set-branch node branch p2) + (avl-tree-node-set-balance p2 0) + t))))) + +(defun avl-tree-do-del-internal (node branch q) + (let ((br (avl-tree-node-branch node branch))) + (if (avl-tree-node-right br) + (if (avl-tree-do-del-internal br +1 q) + (avl-tree-del-balance2 node branch)) + (avl-tree-node-set-data q (avl-tree-node-data br)) + (avl-tree-node-set-branch node branch + (avl-tree-node-left br)) + t))) + +(defun avl-tree-do-delete (cmpfun root branch data) + ;; Return t if the height of the tree has shrunk. + (let ((br (avl-tree-node-branch root branch))) + (cond + ((null br) + nil) + + ((funcall cmpfun data (avl-tree-node-data br)) + (if (avl-tree-do-delete cmpfun br 0 data) + (avl-tree-del-balance1 root branch))) + + ((funcall cmpfun (avl-tree-node-data br) data) + (if (avl-tree-do-delete cmpfun br 1 data) + (avl-tree-del-balance2 root branch))) + + (t + ;; Found it. Let's delete it. + (cond + ((null (avl-tree-node-right br)) + (avl-tree-node-set-branch root branch (avl-tree-node-left br)) + t) + + ((null (avl-tree-node-left br)) + (avl-tree-node-set-branch root branch (avl-tree-node-right br)) + t) + + (t + (if (avl-tree-do-del-internal br 0 br) + (avl-tree-del-balance1 root branch)))))))) + +;; ---------------------------------------------------------------- +;; Entering data + +(defun avl-tree-enter-balance1 (node branch) + ;; Rebalance a tree and return t if the height of the tree has grown. + (let ((br (avl-tree-node-branch node branch)) + p1 p2 b2 result) + (cond + ((< (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br 0) + nil) + + ((= (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br +1) + t) + + (t + ;; Tree has grown => Rebalance. + (setq p1 (avl-tree-node-right br)) + (if (> (avl-tree-node-balance p1) 0) + ;; Single RR rotation. + (progn + (avl-tree-node-set-right br (avl-tree-node-left p1)) + (avl-tree-node-set-left p1 br) + (avl-tree-node-set-balance br 0) + (avl-tree-node-set-branch node branch p1)) + + ;; Double RL rotation. + (setq p2 (avl-tree-node-left p1) + b2 (avl-tree-node-balance p2)) + (avl-tree-node-set-left p1 (avl-tree-node-right p2)) + (avl-tree-node-set-right p2 p1) + (avl-tree-node-set-right br (avl-tree-node-left p2)) + (avl-tree-node-set-left p2 br) + (if (> b2 0) + (avl-tree-node-set-balance br -1) + (avl-tree-node-set-balance br 0)) + (if (< b2 0) + (avl-tree-node-set-balance p1 +1) + (avl-tree-node-set-balance p1 0)) + (avl-tree-node-set-branch node branch p2)) + (avl-tree-node-set-balance (avl-tree-node-branch node branch) 0) + nil)))) + +(defun avl-tree-enter-balance2 (node branch) + ;; Return t if the tree has grown. + (let ((br (avl-tree-node-branch node branch)) + p1 p2 b2) + (cond + ((> (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br 0) + nil) + + ((= (avl-tree-node-balance br) 0) + (avl-tree-node-set-balance br -1) + t) + + (t + ;; Balance was -1 => Rebalance. + (setq p1 (avl-tree-node-left br)) + (if (< (avl-tree-node-balance p1) 0) + ;; Single LL rotation. + (progn + (avl-tree-node-set-left br (avl-tree-node-right p1)) + (avl-tree-node-set-right p1 br) + (avl-tree-node-set-balance br 0) + (avl-tree-node-set-branch node branch p1)) + + ;; Double LR rotation. + (setq p2 (avl-tree-node-right p1) + b2 (avl-tree-node-balance p2)) + (avl-tree-node-set-right p1 (avl-tree-node-left p2)) + (avl-tree-node-set-left p2 p1) + (avl-tree-node-set-left br (avl-tree-node-right p2)) + (avl-tree-node-set-right p2 br) + (if (< b2 0) + (avl-tree-node-set-balance br +1) + (avl-tree-node-set-balance br 0)) + (if (> b2 0) + (avl-tree-node-set-balance p1 -1) + (avl-tree-node-set-balance p1 0)) + (avl-tree-node-set-branch node branch p2)) + (avl-tree-node-set-balance (avl-tree-node-branch node branch) 0) + nil)))) + +(defun avl-tree-do-enter (cmpfun root branch data) + ;; Return t if height of tree ROOT has grown. INTERNAL USE ONLY. + (let ((br (avl-tree-node-branch root branch))) + (cond + ((null br) + ;; Data not in tree, insert it. + (avl-tree-node-set-branch + root branch (avl-tree-node-create nil nil data 0)) + t) + + ((funcall cmpfun data (avl-tree-node-data br)) + (and (avl-tree-do-enter cmpfun br 0 data) + (avl-tree-enter-balance2 root branch))) + + ((funcall cmpfun (avl-tree-node-data br) data) + (and (avl-tree-do-enter cmpfun br 1 data) + (avl-tree-enter-balance1 root branch))) + + (t + (avl-tree-node-set-data br data) + nil)))) + +;; ---------------------------------------------------------------- + +(defun avl-tree-mapc (map-function root) + ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT. + ;; The function is applied in-order. + ;; + ;; Note: MAP-FUNCTION is applied to the node and not to the data itself. + ;; INTERNAL USE ONLY. + (let ((node root) + (stack nil) + (go-left t)) + (push nil stack) + (while node + (if (and go-left + (avl-tree-node-left node)) + ;; Do the left subtree first. + (progn + (push node stack) + (setq node (avl-tree-node-left node))) + ;; Apply the function... + (funcall map-function node) + ;; and do the right subtree. + (if (avl-tree-node-right node) + (setq node (avl-tree-node-right node) + go-left t) + (setq node (pop stack) + go-left nil)))))) + +(defun avl-tree-do-copy (root) + ;; Copy the avl tree with ROOT as root. + ;; Highly recursive. INTERNAL USE ONLY. + (if (null root) + nil + (avl-tree-node-create + (avl-tree-do-copy (avl-tree-node-left root)) + (avl-tree-do-copy (avl-tree-node-right root)) + (avl-tree-node-data root) + (avl-tree-node-balance root)))) + + +;;; ================================================================ +;;; The public functions which operate on AVL trees. + +(defun avl-tree-create (compare-function) + "Create a new empty avl tree and return it. +COMPARE-FUNCTION is a function which takes two arguments, A and B, +and returns non-nil if A is less than B, and nil otherwise." + (cons 'AVL-TREE + (cons (avl-tree-node-create nil nil nil 0) + compare-function))) + +(defun avl-tree-p (obj) + "Return t if OBJ is an avl tree, nil otherwise." + (eq (car-safe obj) 'AVL-TREE)) + +(defun avl-tree-compare-function (tree) + "Return the comparison function for the avl tree TREE." + (avl-tree-cmpfun tree)) + +(defun avl-tree-empty (tree) + "Return t if avl tree TREE is emtpy, otherwise return nil." + (null (avl-tree-root tree))) + +(defun avl-tree-enter (tree data) + "In the avl tree TREE insert DATA. +Return DATA." + (avl-tree-do-enter (avl-tree-cmpfun tree) + (avl-tree-dummyroot tree) + 0 + data) + data) + +(defun avl-tree-delete (tree data) + "From the avl tree TREE, delete DATA. +Return the element in TREE which matched DATA, +nil if no element matched." + (avl-tree-do-delete (avl-tree-cmpfun tree) + (avl-tree-dummyroot tree) + 0 + data)) + +(defun avl-tree-member (tree data) + "Return the element in the avl tree TREE which matches DATA. +Matching uses the compare function previously specified in +`avl-tree-create' when TREE was created. + +If there is no such element in the tree, the value is nil." + (let ((node (avl-tree-root tree)) + (compare-function (avl-tree-cmpfun tree)) + found) + (while (and node + (not found)) + (cond + ((funcall compare-function data (avl-tree-node-data node)) + (setq node (avl-tree-node-left node))) + ((funcall compare-function (avl-tree-node-data node) data) + (setq node (avl-tree-node-right node))) + (t + (setq found t)))) + (if node + (avl-tree-node-data node) + nil))) + +(defun avl-tree-map (__map-function__ tree) + "Apply __MAP-FUNCTION__ to all elements in the avl tree TREE." + (avl-tree-mapc + (function (lambda (node) + (avl-tree-node-set-data + node (funcall __map-function__ + (avl-tree-node-data node))))) + (avl-tree-root tree))) + +(defun avl-tree-first (tree) + "Return the first element in TREE, or nil if TREE is empty." + (let ((node (avl-tree-root tree))) + (if node + (progn + (while (avl-tree-node-left node) + (setq node (avl-tree-node-left node))) + (avl-tree-node-data node)) + nil))) + +(defun avl-tree-last (tree) + "Return the last element in TREE, or nil if TREE is empty." + (let ((node (avl-tree-root tree))) + (if node + (progn + (while (avl-tree-node-right node) + (setq node (avl-tree-node-right node))) + (avl-tree-node-data node)) + nil))) + +(defun avl-tree-copy (tree) + "Return a copy of the avl tree TREE." + (let ((new-tree (avl-tree-create (avl-tree-cmpfun tree)))) + (avl-tree-node-set-left (avl-tree-dummyroot new-tree) + (avl-tree-do-copy (avl-tree-root tree))) + new-tree)) + +(defun avl-tree-flatten (tree) + "Return a sorted list containing all elements of TREE." + (nreverse + (let ((treelist nil)) + (avl-tree-mapc + (function (lambda (node) + (setq treelist (cons (avl-tree-node-data node) + treelist)))) + (avl-tree-root tree)) + treelist))) + +(defun avl-tree-size (tree) + "Return the number of elements in TREE." + (let ((treesize 0)) + (avl-tree-mapc + (function (lambda (data) + (setq treesize (1+ treesize)) + data)) + (avl-tree-root tree)) + treesize)) + +(defun avl-tree-clear (tree) + "Clear the avl tree TREE." + (avl-tree-node-set-left (avl-tree-dummyroot tree) nil)) + +(provide 'avl-tree) + +;; arch-tag: 47e26701-43c9-4222-bd79-739eac6357a9 +;;; avl-tree.el ends here diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el index 6daaf001433..a2a929d9601 100644 --- a/lisp/emacs-lisp/backquote.el +++ b/lisp/emacs-lisp/backquote.el @@ -85,10 +85,10 @@ For example (backquote-list* 'a 'b 'c) => (a b . c)" (defconst backquote-backquote-symbol '\` "Symbol used to represent a backquote or nested backquote.") -(defconst backquote-unquote-symbol ', +(defconst backquote-unquote-symbol '\, "Symbol used to represent an unquote inside a backquote.") -(defconst backquote-splice-symbol ',@ +(defconst backquote-splice-symbol '\,@ "Symbol used to represent a splice inside a backquote.") ;;;###autoload @@ -121,9 +121,8 @@ Vectors work just like lists. Nested backquotes are permitted." (defun backquote-delay-process (s level) "Process a (un|back|splice)quote inside a backquote. This simply recurses through the body." - (let ((exp (backquote-listify (list (backquote-process (nth 1 s) level) - (cons 0 (list 'quote (car s)))) - '(0)))) + (let ((exp (backquote-listify (list (cons 0 (list 'quote (car s)))) + (backquote-process (cdr s) level)))) (if (eq (car-safe exp) 'quote) (cons 0 (list 'quote s)) (cons 1 exp)))) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 82a5cf0a75a..fdeab460c79 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -31,7 +31,7 @@ ;; "No matter how hard you try, you can't make a racehorse out of a pig. ;; You can, however, make a faster pig." ;; -;; Or, to put it another way, the emacs byte compiler is a VW Bug. This code +;; Or, to put it another way, the Emacs byte compiler is a VW Bug. This code ;; makes it be a VW Bug with fuel injection and a turbocharger... You're ;; still not going to make it go faster than 70 mph, but it might be easier ;; to get it there. @@ -1014,12 +1014,23 @@ form)) (defun byte-optimize-if (form) + ;; (if (progn <insts> <test>) <rest>) ==> (progn <insts> (if <test> <rest>)) ;; (if <true-constant> <then> <else...>) ==> <then> ;; (if <false-constant> <then> <else...>) ==> (progn <else...>) ;; (if <test> nil <else...>) ==> (if (not <test>) (progn <else...>)) ;; (if <test> <then> nil) ==> (if <test> <then>) (let ((clause (nth 1 form))) - (cond ((byte-compile-trueconstp clause) + (cond ((and (eq (car-safe clause) 'progn) + ;; `clause' is a proper list. + (null (cdr (last clause)))) + (if (null (cddr clause)) + ;; A trivial `progn'. + (byte-optimize-if `(if ,(cadr clause) ,@(nthcdr 2 form))) + (nconc (butlast clause) + (list + (byte-optimize-if + `(if ,(car (last clause)) ,@(nthcdr 2 form))))))) + ((byte-compile-trueconstp clause) (nth 2 form)) ((null clause) (if (nthcdr 4 form) @@ -1135,9 +1146,9 @@ (put 'featurep 'byte-optimizer 'byte-optimize-featurep) (defun byte-optimize-featurep (form) - ;; Emacs-21's byte-code doesn't run under XEmacs anyway, so we can - ;; safely optimize away this test. - (if (equal '((quote xemacs)) (cdr-safe form)) + ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so we + ;; can safely optimize away this test. + (if (member (cdr-safe form) '((quote xemacs) (quote sxemacs))) nil form)) @@ -1326,7 +1337,7 @@ ;; This list contains numbers, which are pc values, ;; before each instruction. (defun byte-decompile-bytecode (bytes constvec) - "Turns BYTECODE into lapcode, referring to CONSTVEC." + "Turn BYTECODE into lapcode, referring to CONSTVEC." (let ((byte-compile-constants nil) (byte-compile-variables nil) (byte-compile-tag-number 0)) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 286725f99c1..bfc21820b5c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -385,7 +385,7 @@ Elements of the list may be: (defvar byte-compile-interactive-only-functions '(beginning-of-buffer end-of-buffer replace-string replace-regexp - insert-file insert-buffer insert-file-literally) + insert-file insert-buffer insert-file-literally previous-line next-line) "List of commands that are not meant to be called from Lisp.") (defvar byte-compile-not-obsolete-var nil @@ -1010,8 +1010,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (defun byte-compile-log-file () (and (not (equal byte-compile-current-file byte-compile-last-logged-file)) (not noninteractive) - (save-excursion - (set-buffer (get-buffer-create "*Compile-Log*")) + (with-current-buffer (get-buffer-create "*Compile-Log*") (goto-char (point-max)) (let* ((inhibit-read-only t) (dir (and byte-compile-current-file @@ -1548,8 +1547,7 @@ recompile every `.el' file that already has a `.elc' file." nil (save-some-buffers) (force-mode-line-update)) - (save-current-buffer - (set-buffer (get-buffer-create "*Compile-Log*")) + (with-current-buffer (get-buffer-create "*Compile-Log*") (setq default-directory (expand-file-name directory)) ;; compilation-mode copies value of default-directory. (unless (eq major-mode 'compilation-mode) @@ -1651,7 +1649,7 @@ The value is non-nil if there were no errors, nil if errors." (let ((b (get-file-buffer (expand-file-name filename)))) (if (and b (buffer-modified-p b) (y-or-n-p (format "Save buffer %s first? " (buffer-name b)))) - (save-excursion (set-buffer b) (save-buffer))))) + (with-current-buffer b (save-buffer))))) ;; Force logging of the file name for each file compiled. (setq byte-compile-last-logged-file nil) @@ -1661,9 +1659,8 @@ The value is non-nil if there were no errors, nil if errors." byte-compile-dest-file) (setq target-file (byte-compile-dest-file filename)) (setq byte-compile-dest-file target-file) - (save-excursion - (setq input-buffer (get-buffer-create " *Compiler Input*")) - (set-buffer input-buffer) + (with-current-buffer + (setq input-buffer (get-buffer-create " *Compiler Input*")) (erase-buffer) (setq buffer-file-coding-system nil) ;; Always compile an Emacs Lisp file as multibyte @@ -1864,7 +1861,13 @@ With argument, insert value in current buffer after the form." (not (eobp))) (setq byte-compile-read-position (point) byte-compile-last-position byte-compile-read-position) - (let ((form (read inbuffer))) + (let* ((old-style-backquotes nil) + (form (read inbuffer))) + ;; Warn about the use of old-style backquotes. + (when old-style-backquotes + (byte-compile-warn "!! The file uses old-style backquotes !! +This functionality has been obsolete for more than 10 years already +and will be removed soon. See (elisp)Backquote in the manual.")) (byte-compile-file-form form))) ;; Compile pending forms at end of file. (byte-compile-flush-pending) @@ -2037,85 +2040,83 @@ list that represents a doc string reference. ;; We need to examine byte-compile-dynamic-docstrings ;; in the input buffer (now current), not in the output buffer. (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) - (set-buffer - (prog1 (current-buffer) - (set-buffer outbuffer) - (let (position) - - ;; Insert the doc string, and make it a comment with #@LENGTH. - (and (>= (nth 1 info) 0) - dynamic-docstrings - (not byte-compile-compatibility) - (progn - ;; Make the doc string start at beginning of line - ;; for make-docfile's sake. - (insert "\n") - (setq position - (byte-compile-output-as-comment - (nth (nth 1 info) form) nil)) - (setq position (- (position-bytes position) (point-min) -1)) - ;; If the doc string starts with * (a user variable), - ;; negate POSITION. - (if (and (stringp (nth (nth 1 info) form)) - (> (length (nth (nth 1 info) form)) 0) - (eq (aref (nth (nth 1 info) form) 0) ?*)) - (setq position (- position))))) - - (if preface - (progn - (insert preface) - (prin1 name outbuffer))) - (insert (car info)) - (let ((print-escape-newlines t) - (print-quoted t) - ;; For compatibility with code before print-circle, - ;; use a cons cell to say that we want - ;; print-gensym-alist not to be cleared - ;; between calls to print functions. - (print-gensym '(t)) - (print-circle ; handle circular data structures - (not byte-compile-disable-print-circle)) - print-gensym-alist ; was used before print-circle existed. - (print-continuous-numbering t) - print-number-table - (index 0)) - (prin1 (car form) outbuffer) - (while (setq form (cdr form)) - (setq index (1+ index)) - (insert " ") - (cond ((and (numberp specindex) (= index specindex) - ;; Don't handle the definition dynamically - ;; if it refers (or might refer) - ;; to objects already output - ;; (for instance, gensyms in the arg list). - (let (non-nil) - (dotimes (i (length print-number-table)) - (if (aref print-number-table i) - (setq non-nil t))) - (not non-nil))) - ;; Output the byte code and constants specially - ;; for lazy dynamic loading. - (let ((position - (byte-compile-output-as-comment - (cons (car form) (nth 1 form)) - t))) - (setq position (- (position-bytes position) (point-min) -1)) - (princ (format "(#$ . %d) nil" position) outbuffer) - (setq form (cdr form)) - (setq index (1+ index)))) - ((= index (nth 1 info)) - (if position - (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") - position) - outbuffer) - (let ((print-escape-newlines nil)) - (goto-char (prog1 (1+ (point)) - (prin1 (car form) outbuffer))) - (insert "\\\n") - (goto-char (point-max))))) - (t - (prin1 (car form) outbuffer))))) - (insert (nth 2 info)))))) + (with-current-buffer outbuffer + (let (position) + + ;; Insert the doc string, and make it a comment with #@LENGTH. + (and (>= (nth 1 info) 0) + dynamic-docstrings + (not byte-compile-compatibility) + (progn + ;; Make the doc string start at beginning of line + ;; for make-docfile's sake. + (insert "\n") + (setq position + (byte-compile-output-as-comment + (nth (nth 1 info) form) nil)) + (setq position (- (position-bytes position) (point-min) -1)) + ;; If the doc string starts with * (a user variable), + ;; negate POSITION. + (if (and (stringp (nth (nth 1 info) form)) + (> (length (nth (nth 1 info) form)) 0) + (eq (aref (nth (nth 1 info) form) 0) ?*)) + (setq position (- position))))) + + (if preface + (progn + (insert preface) + (prin1 name outbuffer))) + (insert (car info)) + (let ((print-escape-newlines t) + (print-quoted t) + ;; For compatibility with code before print-circle, + ;; use a cons cell to say that we want + ;; print-gensym-alist not to be cleared + ;; between calls to print functions. + (print-gensym '(t)) + (print-circle ; handle circular data structures + (not byte-compile-disable-print-circle)) + print-gensym-alist ; was used before print-circle existed. + (print-continuous-numbering t) + print-number-table + (index 0)) + (prin1 (car form) outbuffer) + (while (setq form (cdr form)) + (setq index (1+ index)) + (insert " ") + (cond ((and (numberp specindex) (= index specindex) + ;; Don't handle the definition dynamically + ;; if it refers (or might refer) + ;; to objects already output + ;; (for instance, gensyms in the arg list). + (let (non-nil) + (dotimes (i (length print-number-table)) + (if (aref print-number-table i) + (setq non-nil t))) + (not non-nil))) + ;; Output the byte code and constants specially + ;; for lazy dynamic loading. + (let ((position + (byte-compile-output-as-comment + (cons (car form) (nth 1 form)) + t))) + (setq position (- (position-bytes position) (point-min) -1)) + (princ (format "(#$ . %d) nil" position) outbuffer) + (setq form (cdr form)) + (setq index (1+ index)))) + ((= index (nth 1 info)) + (if position + (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") + position) + outbuffer) + (let ((print-escape-newlines nil)) + (goto-char (prog1 (1+ (point)) + (prin1 (car form) outbuffer))) + (insert "\\\n") + (goto-char (point-max))))) + (t + (prin1 (car form) outbuffer))))) + (insert (nth 2 info))))) nil) (defun byte-compile-keep-pending (form &optional handler) @@ -2401,39 +2402,37 @@ list that represents a doc string reference. ;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting. (defun byte-compile-output-as-comment (exp quoted) (let ((position (point))) - (set-buffer - (prog1 (current-buffer) - (set-buffer outbuffer) - - ;; Insert EXP, and make it a comment with #@LENGTH. - (insert " ") - (if quoted - (prin1 exp outbuffer) - (princ exp outbuffer)) - (goto-char position) - ;; Quote certain special characters as needed. - ;; get_doc_string in doc.c does the unquoting. - (while (search-forward "\^A" nil t) - (replace-match "\^A\^A" t t)) - (goto-char position) - (while (search-forward "\000" nil t) - (replace-match "\^A0" t t)) - (goto-char position) - (while (search-forward "\037" nil t) - (replace-match "\^A_" t t)) - (goto-char (point-max)) - (insert "\037") - (goto-char position) - (insert "#@" (format "%d" (- (position-bytes (point-max)) - (position-bytes position)))) - - ;; Save the file position of the object. - ;; Note we should add 1 to skip the space - ;; that we inserted before the actual doc string, - ;; and subtract 1 to convert from an 1-origin Emacs position - ;; to a file position; they cancel. - (setq position (point)) - (goto-char (point-max)))) + (with-current-buffer outbuffer + + ;; Insert EXP, and make it a comment with #@LENGTH. + (insert " ") + (if quoted + (prin1 exp outbuffer) + (princ exp outbuffer)) + (goto-char position) + ;; Quote certain special characters as needed. + ;; get_doc_string in doc.c does the unquoting. + (while (search-forward "\^A" nil t) + (replace-match "\^A\^A" t t)) + (goto-char position) + (while (search-forward "\000" nil t) + (replace-match "\^A0" t t)) + (goto-char position) + (while (search-forward "\037" nil t) + (replace-match "\^A_" t t)) + (goto-char (point-max)) + (insert "\037") + (goto-char position) + (insert "#@" (format "%d" (- (position-bytes (point-max)) + (position-bytes position)))) + + ;; Save the file position of the object. + ;; Note we should add 1 to skip the space + ;; that we inserted before the actual doc string, + ;; and subtract 1 to convert from an 1-origin Emacs position + ;; to a file position; they cancel. + (setq position (point)) + (goto-char (point-max))) position)) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 7d94faa4456..a46fead6eb5 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -283,53 +283,53 @@ Not documented ;;;;;; do* do loop return-from return block etypecase typecase ecase ;;;;;; case load-time-value eval-when destructuring-bind function* ;;;;;; defmacro* defun* gentemp gensym cl-compile-time-init) "cl-macs" -;;;;;; "cl-macs.el" "d9759da97810bc01423e77442b459468") +;;;;;; "cl-macs.el" "d1c9f68f599fbec644a06dd5cf520fb5") ;;; Generated autoloads from cl-macs.el -(autoload (quote cl-compile-time-init) "cl-macs" "\ +(autoload 'cl-compile-time-init "cl-macs" "\ Not documented \(fn)" nil nil) -(autoload (quote gensym) "cl-macs" "\ +(autoload 'gensym "cl-macs" "\ Generate a new uninterned symbol. The name is made by appending a number to PREFIX, default \"G\". \(fn &optional PREFIX)" nil nil) -(autoload (quote gentemp) "cl-macs" "\ +(autoload 'gentemp "cl-macs" "\ Generate a new interned symbol with a unique name. The name is made by appending a number to PREFIX, default \"G\". \(fn &optional PREFIX)" nil nil) -(autoload (quote defun*) "cl-macs" "\ +(autoload 'defun* "cl-macs" "\ Define NAME as a function. Like normal `defun', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...). \(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro)) -(autoload (quote defmacro*) "cl-macs" "\ +(autoload 'defmacro* "cl-macs" "\ Define NAME as a macro. Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (block NAME ...). \(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro)) -(autoload (quote function*) "cl-macs" "\ +(autoload 'function* "cl-macs" "\ Introduce a function. Like normal `function', except that if argument is a lambda form, its argument list allows full Common Lisp conventions. \(fn FUNC)" nil (quote macro)) -(autoload (quote destructuring-bind) "cl-macs" "\ +(autoload 'destructuring-bind "cl-macs" "\ Not documented \(fn ARGS EXPR &rest BODY)" nil (quote macro)) -(autoload (quote eval-when) "cl-macs" "\ +(autoload 'eval-when "cl-macs" "\ Control when BODY is evaluated. If `compile' is in WHEN, BODY is evaluated when compiled at top-level. If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. @@ -337,13 +337,13 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. \(fn (WHEN...) BODY...)" nil (quote macro)) -(autoload (quote load-time-value) "cl-macs" "\ +(autoload 'load-time-value "cl-macs" "\ Like `progn', but evaluates the body at load time. The result of the body appears to the compiler as a quoted constant. \(fn FORM &optional READ-ONLY)" nil (quote macro)) -(autoload (quote case) "cl-macs" "\ +(autoload 'case "cl-macs" "\ Eval EXPR and choose among clauses on that value. Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared against each key in each KEYLIST; the corresponding BODY is evaluated. @@ -354,13 +354,13 @@ Key values are compared by `eql'. \(fn EXPR (KEYLIST BODY...)...)" nil (quote macro)) -(autoload (quote ecase) "cl-macs" "\ +(autoload 'ecase "cl-macs" "\ Like `case', but error if no case fits. `otherwise'-clauses are not allowed. \(fn EXPR (KEYLIST BODY...)...)" nil (quote macro)) -(autoload (quote typecase) "cl-macs" "\ +(autoload 'typecase "cl-macs" "\ Evals EXPR, chooses among clauses on that value. Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds, @@ -369,13 +369,13 @@ final clause, and matches if no other keys match. \(fn EXPR (TYPE BODY...)...)" nil (quote macro)) -(autoload (quote etypecase) "cl-macs" "\ +(autoload 'etypecase "cl-macs" "\ Like `typecase', but error if no case fits. `otherwise'-clauses are not allowed. \(fn EXPR (TYPE BODY...)...)" nil (quote macro)) -(autoload (quote block) "cl-macs" "\ +(autoload 'block "cl-macs" "\ Define a lexically-scoped block named NAME. NAME may be any symbol. Code inside the BODY forms can call `return-from' to jump prematurely out of the block. This differs from `catch' and `throw' @@ -387,13 +387,13 @@ called from BODY. \(fn NAME &rest BODY)" nil (quote macro)) -(autoload (quote return) "cl-macs" "\ +(autoload 'return "cl-macs" "\ Return from the block named nil. This is equivalent to `(return-from nil RESULT)'. \(fn &optional RESULT)" nil (quote macro)) -(autoload (quote return-from) "cl-macs" "\ +(autoload 'return-from "cl-macs" "\ Return from the block named NAME. This jump out to the innermost enclosing `(block NAME ...)' form, returning RESULT from that form (or nil if RESULT is omitted). @@ -402,7 +402,7 @@ This is compatible with Common Lisp, but note that `defun' and \(fn NAME &optional RESULT)" nil (quote macro)) -(autoload (quote loop) "cl-macs" "\ +(autoload 'loop "cl-macs" "\ The Common Lisp `loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, @@ -418,24 +418,24 @@ Valid clauses are: \(fn CLAUSE...)" nil (quote macro)) -(autoload (quote do) "cl-macs" "\ +(autoload 'do "cl-macs" "\ The Common Lisp `do' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil (quote macro)) -(autoload (quote do*) "cl-macs" "\ +(autoload 'do* "cl-macs" "\ The Common Lisp `do*' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil (quote macro)) -(autoload (quote dolist) "cl-macs" "\ +(autoload 'dolist "cl-macs" "\ Loop over a list. Evaluate BODY with VAR bound to each `car' from LIST, in turn. Then evaluate RESULT to get return value, default nil. \(fn (VAR LIST [RESULT]) BODY...)" nil (quote macro)) -(autoload (quote dotimes) "cl-macs" "\ +(autoload 'dotimes "cl-macs" "\ Loop a certain number of times. Evaluate BODY with VAR bound to successive integers from 0, inclusive, to COUNT, exclusive. Then evaluate RESULT to get return value, default @@ -443,26 +443,26 @@ nil. \(fn (VAR COUNT [RESULT]) BODY...)" nil (quote macro)) -(autoload (quote do-symbols) "cl-macs" "\ +(autoload 'do-symbols "cl-macs" "\ Loop over all symbols. Evaluate BODY with VAR bound to each interned symbol, or to each symbol from OBARRAY. \(fn (VAR [OBARRAY [RESULT]]) BODY...)" nil (quote macro)) -(autoload (quote do-all-symbols) "cl-macs" "\ +(autoload 'do-all-symbols "cl-macs" "\ Not documented \(fn SPEC &rest BODY)" nil (quote macro)) -(autoload (quote psetq) "cl-macs" "\ +(autoload 'psetq "cl-macs" "\ Set SYMs to the values VALs in parallel. This is like `setq', except that all VAL forms are evaluated (in order) before assigning any symbols SYM to the corresponding values. \(fn SYM VAL SYM VAL ...)" nil (quote macro)) -(autoload (quote progv) "cl-macs" "\ +(autoload 'progv "cl-macs" "\ Bind SYMBOLS to VALUES dynamically in BODY. The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. Each symbol in the first list is bound to the corresponding value in the @@ -472,7 +472,7 @@ a `let' form, except that the list of symbols can be computed at run-time. \(fn SYMBOLS VALUES &rest BODY)" nil (quote macro)) -(autoload (quote flet) "cl-macs" "\ +(autoload 'flet "cl-macs" "\ Make temporary function definitions. This is an analogue of `let' that operates on the function cell of FUNC rather than its value cell. The FORMs are evaluated with the specified @@ -481,41 +481,41 @@ go back to their previous definitions, or lack thereof). \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil (quote macro)) -(autoload (quote labels) "cl-macs" "\ +(autoload 'labels "cl-macs" "\ Make temporary function bindings. This is like `flet', except the bindings are lexical instead of dynamic. Unlike `flet', this macro is fully compliant with the Common Lisp standard. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil (quote macro)) -(autoload (quote macrolet) "cl-macs" "\ +(autoload 'macrolet "cl-macs" "\ Make temporary macro definitions. This is like `flet', but for macros instead of functions. \(fn ((NAME ARGLIST BODY...) ...) FORM...)" nil (quote macro)) -(autoload (quote symbol-macrolet) "cl-macs" "\ +(autoload 'symbol-macrolet "cl-macs" "\ Make symbol macro definitions. Within the body FORMs, references to the variable NAME will be replaced by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). \(fn ((NAME EXPANSION) ...) FORM...)" nil (quote macro)) -(autoload (quote lexical-let) "cl-macs" "\ +(autoload 'lexical-let "cl-macs" "\ Like `let', but lexically scoped. The main visible difference is that lambdas inside BODY will create lexical closures as in Common Lisp. \(fn VARLIST BODY)" nil (quote macro)) -(autoload (quote lexical-let*) "cl-macs" "\ +(autoload 'lexical-let* "cl-macs" "\ Like `let*', but lexically scoped. The main visible difference is that lambdas inside BODY will create lexical closures as in Common Lisp. \(fn VARLIST BODY)" nil (quote macro)) -(autoload (quote multiple-value-bind) "cl-macs" "\ +(autoload 'multiple-value-bind "cl-macs" "\ Collect multiple return values. FORM must return a list; the BODY is then executed with the first N elements of this list bound (`let'-style) to each of the symbols SYM in turn. This @@ -525,7 +525,7 @@ a synonym for (list A B C). \(fn (SYM...) FORM BODY)" nil (quote macro)) -(autoload (quote multiple-value-setq) "cl-macs" "\ +(autoload 'multiple-value-setq "cl-macs" "\ Collect multiple return values. FORM must return a list; the first N elements of this list are stored in each of the symbols SYM in turn. This is analogous to the Common Lisp @@ -534,22 +534,22 @@ values. For compatibility, (values A B C) is a synonym for (list A B C). \(fn (SYM...) FORM)" nil (quote macro)) -(autoload (quote locally) "cl-macs" "\ +(autoload 'locally "cl-macs" "\ Not documented \(fn &rest BODY)" nil (quote macro)) -(autoload (quote the) "cl-macs" "\ +(autoload 'the "cl-macs" "\ Not documented \(fn TYPE FORM)" nil (quote macro)) -(autoload (quote declare) "cl-macs" "\ +(autoload 'declare "cl-macs" "\ Not documented \(fn &rest SPECS)" nil (quote macro)) -(autoload (quote define-setf-method) "cl-macs" "\ +(autoload 'define-setf-method "cl-macs" "\ Define a `setf' method. This method shows how to handle `setf's to places of the form (NAME ARGS...). The argument forms ARGS are bound according to ARGLIST, as if NAME were @@ -560,7 +560,7 @@ form. See `defsetf' for a simpler way to define most setf-methods. \(fn NAME ARGLIST BODY...)" nil (quote macro)) -(autoload (quote defsetf) "cl-macs" "\ +(autoload 'defsetf "cl-macs" "\ Define a `setf' method. This macro is an easy-to-use substitute for `define-setf-method' that works well for simple place forms. In the simple `defsetf' form, `setf's of @@ -581,14 +581,14 @@ Example: \(fn NAME [FUNC | ARGLIST (STORE) BODY...])" nil (quote macro)) -(autoload (quote get-setf-method) "cl-macs" "\ +(autoload 'get-setf-method "cl-macs" "\ Return a list of five values describing the setf-method for PLACE. PLACE may be any Lisp form which can appear as the PLACE argument to a macro like `setf' or `incf'. \(fn PLACE &optional ENV)" nil nil) -(autoload (quote setf) "cl-macs" "\ +(autoload 'setf "cl-macs" "\ Set each PLACE to the value of its VAL. This is a generalized version of `setq'; the PLACEs may be symbolic references such as (car x) or (aref x i), as well as plain symbols. @@ -597,40 +597,40 @@ The return value is the last VAL in the list. \(fn PLACE VAL PLACE VAL ...)" nil (quote macro)) -(autoload (quote psetf) "cl-macs" "\ +(autoload 'psetf "cl-macs" "\ Set PLACEs to the values VALs in parallel. This is like `setf', except that all VAL forms are evaluated (in order) before assigning any PLACEs to the corresponding values. \(fn PLACE VAL PLACE VAL ...)" nil (quote macro)) -(autoload (quote cl-do-pop) "cl-macs" "\ +(autoload 'cl-do-pop "cl-macs" "\ Not documented \(fn PLACE)" nil nil) -(autoload (quote remf) "cl-macs" "\ +(autoload 'remf "cl-macs" "\ Remove TAG from property list PLACE. PLACE may be a symbol, or any generalized variable allowed by `setf'. The form returns true if TAG was found and removed, nil otherwise. \(fn PLACE TAG)" nil (quote macro)) -(autoload (quote shiftf) "cl-macs" "\ +(autoload 'shiftf "cl-macs" "\ Shift left among PLACEs. Example: (shiftf A B C) sets A to B, B to C, and returns the old A. Each PLACE may be a symbol, or any generalized variable allowed by `setf'. \(fn PLACE... VAL)" nil (quote macro)) -(autoload (quote rotatef) "cl-macs" "\ +(autoload 'rotatef "cl-macs" "\ Rotate left among PLACEs. Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil. Each PLACE may be a symbol, or any generalized variable allowed by `setf'. \(fn PLACE...)" nil (quote macro)) -(autoload (quote letf) "cl-macs" "\ +(autoload 'letf "cl-macs" "\ Temporarily bind to PLACEs. This is the analogue of `let', but with generalized variables (in the sense of `setf') for the PLACEs. Each PLACE is set to the corresponding @@ -642,7 +642,7 @@ the PLACE is not modified before executing BODY. \(fn ((PLACE VALUE) ...) BODY...)" nil (quote macro)) -(autoload (quote letf*) "cl-macs" "\ +(autoload 'letf* "cl-macs" "\ Temporarily bind to PLACEs. This is the analogue of `let*', but with generalized variables (in the sense of `setf') for the PLACEs. Each PLACE is set to the corresponding @@ -654,27 +654,27 @@ the PLACE is not modified before executing BODY. \(fn ((PLACE VALUE) ...) BODY...)" nil (quote macro)) -(autoload (quote callf) "cl-macs" "\ +(autoload 'callf "cl-macs" "\ Set PLACE to (FUNC PLACE ARGS...). FUNC should be an unquoted function name. PLACE may be a symbol, or any generalized variable allowed by `setf'. \(fn FUNC PLACE ARGS...)" nil (quote macro)) -(autoload (quote callf2) "cl-macs" "\ +(autoload 'callf2 "cl-macs" "\ Set PLACE to (FUNC ARG1 PLACE ARGS...). Like `callf', but PLACE is the second argument of FUNC, not the first. \(fn FUNC ARG1 PLACE ARGS...)" nil (quote macro)) -(autoload (quote define-modify-macro) "cl-macs" "\ +(autoload 'define-modify-macro "cl-macs" "\ Define a `setf'-like modify macro. If NAME is called, it combines its PLACE argument with the other arguments from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +) \(fn NAME ARGLIST FUNC &optional DOC)" nil (quote macro)) -(autoload (quote defstruct) "cl-macs" "\ +(autoload 'defstruct "cl-macs" "\ Define a struct type. This macro defines a new Lisp data type called NAME, which contains data stored in SLOTs. This defines a `make-NAME' constructor, a `copy-NAME' @@ -682,24 +682,24 @@ copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors. \(fn (NAME OPTIONS...) (SLOT SLOT-OPTS...)...)" nil (quote macro)) -(autoload (quote cl-struct-setf-expander) "cl-macs" "\ +(autoload 'cl-struct-setf-expander "cl-macs" "\ Not documented \(fn X NAME ACCESSOR PRED-FORM POS)" nil nil) -(autoload (quote typep) "cl-macs" "\ +(autoload 'typep "cl-macs" "\ Check that OBJECT is of type TYPE. TYPE is a Common Lisp-style type specifier. \(fn OBJECT TYPE)" nil nil) -(autoload (quote check-type) "cl-macs" "\ +(autoload 'check-type "cl-macs" "\ Verify that FORM is of type TYPE; signal an error if not. STRING is an optional description of the desired type. \(fn FORM TYPE &optional STRING)" nil (quote macro)) -(autoload (quote assert) "cl-macs" "\ +(autoload 'assert "cl-macs" "\ Verify that FORM returns non-nil; signal an error if not. Second arg SHOW-ARGS means to include arguments of FORM in message. Other args STRING and ARGS... are arguments to be passed to `error'. @@ -708,13 +708,13 @@ omitted, a default message listing FORM itself is used. \(fn FORM &optional SHOW-ARGS STRING &rest ARGS)" nil (quote macro)) -(autoload (quote ignore-errors) "cl-macs" "\ +(autoload 'ignore-errors "cl-macs" "\ Execute BODY; if an error occurs, return nil. Otherwise, return result of last form in BODY. \(fn &rest BODY)" nil (quote macro)) -(autoload (quote define-compiler-macro) "cl-macs" "\ +(autoload 'define-compiler-macro "cl-macs" "\ Define a compiler-only macro. This is like `defmacro', but macro expansion occurs only if the call to FUNC is compiled (i.e., not interpreted). Compiler macros should be used @@ -728,7 +728,7 @@ and then returning foo. \(fn FUNC ARGS &rest BODY)" nil (quote macro)) -(autoload (quote compiler-macroexpand) "cl-macs" "\ +(autoload 'compiler-macroexpand "cl-macs" "\ Not documented \(fn FORM)" nil nil) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 5a526126c25..964688894af 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1507,7 +1507,7 @@ expressions; a `progn' form will be returned enclosing these forms." head (edebug-move-cursor cursor)))))) ((consp head) - (if (eq (car head) ',) + (if (eq (car head) '\,) ;; The head of a form should normally be a symbol or a lambda ;; expression but it can also be an unquote form to be filled ;; before evaluation. We evaluate the arguments anyway, on the @@ -1664,7 +1664,7 @@ expressions; a `progn' form will be returned enclosing these forms." ((fboundp symbol) ; is it a predicate? (let ((sexp (edebug-top-element-required cursor "Expected" symbol))) ;; Special case for edebug-`. - (if (and (listp sexp) (eq (car sexp) ',)) + (if (and (listp sexp) (eq (car sexp) '\,)) (edebug-match cursor '(("," def-form))) (if (not (funcall symbol sexp)) (edebug-no-match cursor symbol "failed")) @@ -2102,8 +2102,8 @@ expressions; a `progn' form will be returned enclosing these forms." (def-edebug-spec edebug-\` (def-form)) ;; Assume immediate quote in unquotes mean backquote at next higher level. -(def-edebug-spec , (&or ("quote" edebug-\`) def-form)) -(def-edebug-spec ,@ (&define ;; so (,@ form) is never wrapped. +(def-edebug-spec \, (&or ("quote" edebug-\`) def-form)) +(def-edebug-spec \,@ (&define ;; so (,@ form) is never wrapped. &or ("quote" edebug-\`) def-form)) ;; New byte compiler. diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 8b2538d299c..1d2441f884a 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -101,6 +101,11 @@ truncated to make more of the arglist or documentation string visible." enable argument list to fit on one line" truncate-sym-name-if-fit)) :group 'eldoc) +(defface eldoc-highlight-function-argument + '((t (:inherit bold))) + "Face used for the argument at point in a function's argument list." + :group 'eldoc) + ;;; No user options below here. (defvar eldoc-message-commands-table-size 31 @@ -303,7 +308,7 @@ highlights argument number INDEX. " In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." (let ((start nil) (end 0) - (argument-face 'bold)) + (argument-face 'eldoc-highlight-function-argument)) ;; Find the current argument in the argument string. We need to ;; handle `&rest' and informal `...' properly. ;; |