Merge from emacs--devo--0
Patches applied: * emacs--devo--0 (patch 866-879) - Merge multi-tty branch - Update from CVS - Merge from emacs--rel--22 Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-257
This commit is contained in:
Miles Bader
commit
c73bd236f7
416 changed files with 80201 additions and 99211 deletions
|
|
@ -2996,7 +2996,9 @@ in any of these classes."
|
|||
(setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage)))
|
||||
(if origdoc (setq paragraphs (list origdoc)))
|
||||
(unless (eq style 'plain)
|
||||
(push (concat "This " origtype " is advised.") paragraphs))
|
||||
(push (propertize (concat "This " origtype " is advised.")
|
||||
'face 'font-lock-warning-face)
|
||||
paragraphs))
|
||||
(ad-dolist (class ad-advice-classes)
|
||||
(ad-dolist (advice (ad-get-enabled-advices function class))
|
||||
(setq advice-docstring
|
||||
|
|
|
|||
|
|
@ -72,7 +72,7 @@ files.")
|
|||
("Geoff Voelker" "voelker")
|
||||
("Gerd M,Av(Bllmann" "Gerd Moellmann")
|
||||
("Hallvard B. Furuseth" "Hallvard B Furuseth")
|
||||
("Hrvoje Nik,B9(Bi,Bf(B" "Hrvoje Niksic")
|
||||
("Hrvoje Nik$,1!!(Bi$,1 '(B" "Hrvoje Niksic")
|
||||
(nil "(afs@hplb.hpl.hp.com)")
|
||||
(nil "<Use-Author-Address-Header@\\[127.1\\]>")
|
||||
(nil "Code Extracted")
|
||||
|
|
@ -81,7 +81,7 @@ files.")
|
|||
("Jaeyoun Chung" "Jae-youn Chung" "Jae-you Chung" "Chung Jae-youn")
|
||||
("Jan Dj,Ad(Brv" "Jan D." "Jan Djarv")
|
||||
("Jay K. Adams" "jka@ece.cmu.edu" "Jay Adams")
|
||||
("J,Ai(Br,At(Bme Marant" "J,bi(Br,bt(Bme Marant" "Jerome Marant")
|
||||
("J,Ai(Br,At(Bme Marant" "J,Ai(Br,At(Bme Marant" "Jerome Marant")
|
||||
("Jens-Ulrik Holger Petersen" "Jens-Ulrik Petersen")
|
||||
("Jeremy Bertram Maitin-Shepard" "Jeremy Maitin-Shepard")
|
||||
("Johan Bockg,Ae(Brd" "Johan Bockgard")
|
||||
|
|
@ -90,11 +90,11 @@ files.")
|
|||
("Joseph Arceneaux" "Joe Arceneaux")
|
||||
("Juan Le,As(Bn Lahoz Garc,Am(Ba" "Juan-Leon Lahoz Garcia")
|
||||
("K. Shane Hartman" "Shane Hartman")
|
||||
("Kai Gro,A_(Bjohann" "Kai Grossjohann" "Kai Gro,b_(Bjohann"
|
||||
("Kai Gro,A_(Bjohann" "Kai Grossjohann" "Kai Gro,A_(Bjohann"
|
||||
"Kai.Grossjohann@Cs.Uni-Dortmund.De"
|
||||
"Kai.Grossjohann@Gmx.Net")
|
||||
("Karl Berry" "K. Berry")
|
||||
("K,Aa(Broly L$,1 q(Brentey" "K,Aa(Broly L,Bu(Brentey" "L$,1 q(Brentey K,Aa(Broly")
|
||||
("K,Aa(Broly L$,1 q(Brentey" "K,Aa(Broly L$,1 q(Brentey" "L$,1 q(Brentey K,Aa(Broly")
|
||||
("Kazushi Marukawa" "Kazushi")
|
||||
("Ken Manheimer" "Kenneth Manheimer")
|
||||
("Kenichi Handa" "Ken'ichi Handa" "Kenichi HANDA")
|
||||
|
|
@ -113,7 +113,7 @@ files.")
|
|||
("Mikio Nakajima" "Nakajima Mikio")
|
||||
("Paul Eggert" "eggert")
|
||||
("Paul Reilly" "(pmr@legacy.pajato.com)")
|
||||
("Pavel Jan,Bm(Bk" "Pavel Jan,Am(Bk Ml." "Pavel Jan,Am(Bk" "Pavel@Janik.Cz")
|
||||
("Pavel Jan,Am(Bk" "Pavel Jan,Am(Bk Ml." "Pavel Jan,Am(Bk" "Pavel@Janik.Cz")
|
||||
("Per Abrahamsen" "Per Abhiddenware")
|
||||
("Peter S. Galbraith" "Peter Galbraith")
|
||||
("Peter Runestig" "Peter 'luna' Runestig")
|
||||
|
|
@ -666,8 +666,8 @@ list of their contributions.\n")
|
|||
(erase-buffer)
|
||||
(set-buffer-file-coding-system authors-coding-system)
|
||||
(insert "Unrecognized file entries found:\n\n")
|
||||
(mapcar (lambda (f) (if (not (string-match "^[A-Za-z]+$" f)) (insert f "\n")))
|
||||
(sort authors-invalid-file-names 'string-lessp))
|
||||
(mapc (lambda (f) (if (not (string-match "^[A-Za-z]+$" f)) (insert f "\n")))
|
||||
(sort authors-invalid-file-names 'string-lessp))
|
||||
(goto-char (point-min))
|
||||
(compilation-mode)
|
||||
(message "Errors were found. See buffer %s" (buffer-name))))
|
||||
|
|
|
|||
|
|
@ -28,345 +28,306 @@
|
|||
|
||||
;;; 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.
|
||||
;; An AVL tree is a nearly-perfect balanced binary tree. A tree consists of
|
||||
;; two elements, the root node and the compare function. The actual tree
|
||||
;; has a dummy node as its root with the real root 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.
|
||||
;; The functions with names of the form "avl-tree--" are intended for
|
||||
;; internal use only.
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;; ================================================================
|
||||
;;; Functions and macros handling an AVL tree node.
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defmacro avl-tree-node-create (left right data balance)
|
||||
;; Create and return an avl-tree node.
|
||||
`(vector ,left ,right ,data ,balance))
|
||||
;; ================================================================
|
||||
;;; Functions and macros handling an AVL tree node.
|
||||
|
||||
(defmacro avl-tree-node-left (node)
|
||||
;; Return the left pointer of NODE.
|
||||
`(aref ,node 0))
|
||||
(defstruct (avl-tree--node
|
||||
;; We force a representation without tag so it matches the
|
||||
;; pre-defstruct representation. Also we use the underlying
|
||||
;; representation in the implementation of avl-tree--node-branch.
|
||||
(:type vector)
|
||||
(:constructor nil)
|
||||
(:constructor avl-tree--node-create (left right data balance))
|
||||
(:copier nil))
|
||||
left right data balance)
|
||||
|
||||
(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)
|
||||
(defalias 'avl-tree--node-branch 'aref
|
||||
;; This implementation is efficient but breaks the defstruct abstraction.
|
||||
;; An alternative could be
|
||||
;; (funcall (aref [avl-tree-left avl-tree-right avl-tree-data] branch) node)
|
||||
"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))
|
||||
0 for left pointer, 1 for right pointer and 2 for the data.\"
|
||||
\(fn node branch)")
|
||||
;; The funcall/aref trick doesn't work for the setf method, unless we try
|
||||
;; and access the underlying setter function, but this wouldn't be
|
||||
;; portable either.
|
||||
(defsetf avl-tree--node-branch aset)
|
||||
|
||||
|
||||
;;; ================================================================
|
||||
;;; Internal functions for use in the AVL tree package
|
||||
;; ================================================================
|
||||
;;; Internal functions for use in the AVL tree package
|
||||
|
||||
(defmacro avl-tree-root (tree)
|
||||
(defstruct (avl-tree-
|
||||
;; A tagged list is the pre-defstruct representation.
|
||||
;; (:type list)
|
||||
:named
|
||||
(:constructor nil)
|
||||
(:constructor avl-tree-create (cmpfun))
|
||||
(:predicate avl-tree-p)
|
||||
(:copier nil))
|
||||
(dummyroot (avl-tree--node-create nil nil nil 0))
|
||||
cmpfun)
|
||||
|
||||
(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)))
|
||||
`(avl-tree--node-left (avl-tree--dummyroot tree)))
|
||||
(defsetf avl-tree--root (tree) (node)
|
||||
`(setf (avl-tree--node-left (avl-tree--dummyroot ,tree)) ,node))
|
||||
|
||||
;; ----------------------------------------------------------------
|
||||
;; Deleting data
|
||||
|
||||
(defun avl-tree-del-balance1 (node branch)
|
||||
(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))
|
||||
(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)
|
||||
((< (avl-tree--node-balance br) 0)
|
||||
(setf (avl-tree--node-balance br) 0)
|
||||
t)
|
||||
|
||||
((= (avl-tree-node-balance br) 0)
|
||||
(avl-tree-node-set-balance br +1)
|
||||
((= (avl-tree--node-balance br) 0)
|
||||
(setf (avl-tree--node-balance br) +1)
|
||||
nil)
|
||||
|
||||
(t
|
||||
;; Rebalance.
|
||||
(setq p1 (avl-tree-node-right br)
|
||||
b1 (avl-tree-node-balance p1))
|
||||
(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)
|
||||
(setf (avl-tree--node-right br) (avl-tree--node-left p1))
|
||||
(setf (avl-tree--node-left p1) br)
|
||||
(if (= 0 b1)
|
||||
(progn
|
||||
(avl-tree-node-set-balance br +1)
|
||||
(avl-tree-node-set-balance p1 -1)
|
||||
(setf (avl-tree--node-balance br) +1)
|
||||
(setf (avl-tree--node-balance p1) -1)
|
||||
(setq result nil))
|
||||
(avl-tree-node-set-balance br 0)
|
||||
(avl-tree-node-set-balance p1 0)
|
||||
(setf (avl-tree--node-balance br) 0)
|
||||
(setf (avl-tree--node-balance p1) 0)
|
||||
(setq result t))
|
||||
(avl-tree-node-set-branch node branch p1)
|
||||
(setf (avl-tree--node-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)
|
||||
(setq p2 (avl-tree--node-left p1)
|
||||
b2 (avl-tree--node-balance p2))
|
||||
(setf (avl-tree--node-left p1) (avl-tree--node-right p2))
|
||||
(setf (avl-tree--node-right p2) p1)
|
||||
(setf (avl-tree--node-right br) (avl-tree--node-left p2))
|
||||
(setf (avl-tree--node-left p2) br)
|
||||
(setf (avl-tree--node-balance br) (if (> b2 0) -1 0))
|
||||
(setf (avl-tree--node-balance p1) (if (< b2 0) +1 0))
|
||||
(setf (avl-tree--node-branch node branch) p2)
|
||||
(setf (avl-tree--node-balance p2) 0)
|
||||
t)))))
|
||||
|
||||
(defun avl-tree-del-balance2 (node branch)
|
||||
(let ((br (avl-tree-node-branch node branch))
|
||||
(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)
|
||||
((> (avl-tree--node-balance br) 0)
|
||||
(setf (avl-tree--node-balance br) 0)
|
||||
t)
|
||||
|
||||
((= (avl-tree-node-balance br) 0)
|
||||
(avl-tree-node-set-balance br -1)
|
||||
((= (avl-tree--node-balance br) 0)
|
||||
(setf (avl-tree--node-balance br) -1)
|
||||
nil)
|
||||
|
||||
(t
|
||||
;; Rebalance.
|
||||
(setq p1 (avl-tree-node-left br)
|
||||
b1 (avl-tree-node-balance p1))
|
||||
(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)
|
||||
(setf (avl-tree--node-left br) (avl-tree--node-right p1))
|
||||
(setf (avl-tree--node-right p1) br)
|
||||
(if (= 0 b1)
|
||||
(progn
|
||||
(avl-tree-node-set-balance br -1)
|
||||
(avl-tree-node-set-balance p1 +1)
|
||||
(setf (avl-tree--node-balance br) -1)
|
||||
(setf (avl-tree--node-balance p1) +1)
|
||||
(setq result nil))
|
||||
(avl-tree-node-set-balance br 0)
|
||||
(avl-tree-node-set-balance p1 0)
|
||||
(setf (avl-tree--node-balance br) 0)
|
||||
(setf (avl-tree--node-balance p1) 0)
|
||||
(setq result t))
|
||||
(avl-tree-node-set-branch node branch p1)
|
||||
(setf (avl-tree--node-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)
|
||||
(setq p2 (avl-tree--node-right p1)
|
||||
b2 (avl-tree--node-balance p2))
|
||||
(setf (avl-tree--node-right p1) (avl-tree--node-left p2))
|
||||
(setf (avl-tree--node-left p2) p1)
|
||||
(setf (avl-tree--node-left br) (avl-tree--node-right p2))
|
||||
(setf (avl-tree--node-right p2) br)
|
||||
(setf (avl-tree--node-balance br) (if (< b2 0) +1 0))
|
||||
(setf (avl-tree--node-balance p1) (if (> b2 0) -1 0))
|
||||
(setf (avl-tree--node-branch node branch) p2)
|
||||
(setf (avl-tree--node-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))
|
||||
(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))
|
||||
(setf (avl-tree--node-data q) (avl-tree--node-data br))
|
||||
(setf (avl-tree--node-branch node branch)
|
||||
(avl-tree--node-left br))
|
||||
t)))
|
||||
|
||||
(defun avl-tree-do-delete (cmpfun root branch data)
|
||||
(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)))
|
||||
(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 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)))
|
||||
((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))
|
||||
((null (avl-tree--node-right br))
|
||||
(setf (avl-tree--node-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))
|
||||
((null (avl-tree--node-left br))
|
||||
(setf (avl-tree--node-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))))))))
|
||||
(if (avl-tree--do-del-internal br 0 br)
|
||||
(avl-tree--del-balance1 root branch))))))))
|
||||
|
||||
;; ----------------------------------------------------------------
|
||||
;; Entering data
|
||||
|
||||
(defun avl-tree-enter-balance1 (node branch)
|
||||
(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))
|
||||
(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)
|
||||
((< (avl-tree--node-balance br) 0)
|
||||
(setf (avl-tree--node-balance br) 0)
|
||||
nil)
|
||||
|
||||
((= (avl-tree-node-balance br) 0)
|
||||
(avl-tree-node-set-balance br +1)
|
||||
((= (avl-tree--node-balance br) 0)
|
||||
(setf (avl-tree--node-balance br) +1)
|
||||
t)
|
||||
|
||||
(t
|
||||
;; Tree has grown => Rebalance.
|
||||
(setq p1 (avl-tree-node-right br))
|
||||
(if (> (avl-tree-node-balance p1) 0)
|
||||
(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))
|
||||
(setf (avl-tree--node-right br) (avl-tree--node-left p1))
|
||||
(setf (avl-tree--node-left p1) br)
|
||||
(setf (avl-tree--node-balance br) 0)
|
||||
(setf (avl-tree--node-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)
|
||||
(setq p2 (avl-tree--node-left p1)
|
||||
b2 (avl-tree--node-balance p2))
|
||||
(setf (avl-tree--node-left p1) (avl-tree--node-right p2))
|
||||
(setf (avl-tree--node-right p2) p1)
|
||||
(setf (avl-tree--node-right br) (avl-tree--node-left p2))
|
||||
(setf (avl-tree--node-left p2) br)
|
||||
(setf (avl-tree--node-balance br) (if (> b2 0) -1 0))
|
||||
(setf (avl-tree--node-balance p1) (if (< b2 0) +1 0))
|
||||
(setf (avl-tree--node-branch node branch) p2))
|
||||
(setf (avl-tree--node-balance (avl-tree--node-branch node branch)) 0)
|
||||
nil))))
|
||||
|
||||
(defun avl-tree-enter-balance2 (node branch)
|
||||
(defun avl-tree--enter-balance2 (node branch)
|
||||
;; Return t if the tree has grown.
|
||||
(let ((br (avl-tree-node-branch node branch))
|
||||
(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)
|
||||
((> (avl-tree--node-balance br) 0)
|
||||
(setf (avl-tree--node-balance br) 0)
|
||||
nil)
|
||||
|
||||
((= (avl-tree-node-balance br) 0)
|
||||
(avl-tree-node-set-balance br -1)
|
||||
((= (avl-tree--node-balance br) 0)
|
||||
(setf (avl-tree--node-balance br) -1)
|
||||
t)
|
||||
|
||||
(t
|
||||
;; Balance was -1 => Rebalance.
|
||||
(setq p1 (avl-tree-node-left br))
|
||||
(if (< (avl-tree-node-balance p1) 0)
|
||||
(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))
|
||||
(setf (avl-tree--node-left br) (avl-tree--node-right p1))
|
||||
(setf (avl-tree--node-right p1) br)
|
||||
(setf (avl-tree--node-balance br) 0)
|
||||
(setf (avl-tree--node-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)
|
||||
(setq p2 (avl-tree--node-right p1)
|
||||
b2 (avl-tree--node-balance p2))
|
||||
(setf (avl-tree--node-right p1) (avl-tree--node-left p2))
|
||||
(setf (avl-tree--node-left p2) p1)
|
||||
(setf (avl-tree--node-left br) (avl-tree--node-right p2))
|
||||
(setf (avl-tree--node-right p2) br)
|
||||
(setf (avl-tree--node-balance br) (if (< b2 0) +1 0))
|
||||
(setf (avl-tree--node-balance p1) (if (> b2 0) -1 0))
|
||||
(setf (avl-tree--node-branch node branch) p2))
|
||||
(setf (avl-tree--node-balance (avl-tree--node-branch node branch)) 0)
|
||||
nil))))
|
||||
|
||||
(defun avl-tree-do-enter (cmpfun root branch data)
|
||||
(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)))
|
||||
(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))
|
||||
(setf (avl-tree--node-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 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)))
|
||||
((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)
|
||||
(setf (avl-tree--node-data br) data)
|
||||
nil))))
|
||||
|
||||
;; ----------------------------------------------------------------
|
||||
|
||||
(defun avl-tree-mapc (map-function root)
|
||||
(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.
|
||||
;;
|
||||
|
|
@ -378,72 +339,59 @@ NEWVAL is new value of the branch.\""
|
|||
(push nil stack)
|
||||
(while node
|
||||
(if (and go-left
|
||||
(avl-tree-node-left node))
|
||||
(avl-tree--node-left node))
|
||||
;; Do the left subtree first.
|
||||
(progn
|
||||
(push node stack)
|
||||
(setq node (avl-tree-node-left node)))
|
||||
(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))))))
|
||||
(setq node (if (setq go-left (avl-tree--node-right node))
|
||||
(avl-tree--node-right node)
|
||||
(pop stack)))))))
|
||||
|
||||
(defun avl-tree-do-copy (root)
|
||||
(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))))
|
||||
(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.
|
||||
;; ================================================================
|
||||
;;; 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)))
|
||||
(defalias 'avl-tree-compare-function 'avl-tree--cmpfun
|
||||
"Return the comparison function for the avl tree TREE.
|
||||
|
||||
(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))
|
||||
\(fn TREE)")
|
||||
|
||||
(defun avl-tree-empty (tree)
|
||||
"Return t if avl tree TREE is emtpy, otherwise return nil."
|
||||
(null (avl-tree-root tree)))
|
||||
(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)
|
||||
(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))
|
||||
(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.
|
||||
|
|
@ -451,82 +399,72 @@ 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))
|
||||
(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)))
|
||||
((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)
|
||||
(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)))
|
||||
(avl-tree--mapc
|
||||
(lambda (node)
|
||||
(setf (avl-tree--node-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)))
|
||||
(let ((node (avl-tree--root tree)))
|
||||
(when node
|
||||
(while (avl-tree--node-left node)
|
||||
(setq node (avl-tree--node-left node)))
|
||||
(avl-tree--node-data node))))
|
||||
|
||||
(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)))
|
||||
(let ((node (avl-tree--root tree)))
|
||||
(when node
|
||||
(while (avl-tree--node-right node)
|
||||
(setq node (avl-tree--node-right node)))
|
||||
(avl-tree--node-data node))))
|
||||
|
||||
(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)))
|
||||
(let ((new-tree (avl-tree-create (avl-tree--cmpfun tree))))
|
||||
(setf (avl-tree--root 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))
|
||||
(avl-tree--mapc
|
||||
(lambda (node) (push (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))
|
||||
(avl-tree--mapc
|
||||
(lambda (data) (setq treesize (1+ treesize)))
|
||||
(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))
|
||||
(setf (avl-tree--root tree) nil))
|
||||
|
||||
(provide 'avl-tree)
|
||||
|
||||
|
|
|
|||
|
|
@ -103,6 +103,7 @@
|
|||
;; not good to call from Lisp)
|
||||
;; `make-local' (dubious calls to
|
||||
;; `make-variable-buffer-local')
|
||||
;; `mapcar' (mapcar called for effect)
|
||||
;; byte-compile-compatibility Whether the compiler should
|
||||
;; generate .elc files which can be loaded into
|
||||
;; generic emacs 18.
|
||||
|
|
@ -340,7 +341,8 @@ If it is 'byte, then only byte-level optimizations will be logged."
|
|||
|
||||
(defconst byte-compile-warning-types
|
||||
'(redefine callargs free-vars unresolved
|
||||
obsolete noruntime cl-functions interactive-only)
|
||||
obsolete noruntime cl-functions interactive-only
|
||||
make-local mapcar)
|
||||
"The list of warning types used when `byte-compile-warnings' is t.")
|
||||
(defcustom byte-compile-warnings t
|
||||
"*List of warnings that the byte-compiler should issue (t for all).
|
||||
|
|
@ -359,7 +361,8 @@ Elements of the list may be:
|
|||
distinguished from macros and aliases).
|
||||
interactive-only
|
||||
commands that normally shouldn't be called from Lisp code.
|
||||
make-local calls to make-variable-buffer-local that may be incorrect."
|
||||
make-local calls to make-variable-buffer-local that may be incorrect.
|
||||
mapcar mapcar called for effect."
|
||||
:group 'bytecomp
|
||||
:type `(choice (const :tag "All" t)
|
||||
(set :menu-tag "Some"
|
||||
|
|
@ -367,7 +370,7 @@ Elements of the list may be:
|
|||
(const callargs) (const redefine)
|
||||
(const obsolete) (const noruntime)
|
||||
(const cl-functions) (const interactive-only)
|
||||
(const make-local))))
|
||||
(const make-local) (const mapcar))))
|
||||
(put 'byte-compile-warnings 'safe-local-variable 'byte-compile-warnings-safe-p)
|
||||
;;;###autoload
|
||||
(defun byte-compile-warnings-safe-p (x)
|
||||
|
|
@ -378,7 +381,8 @@ Elements of the list may be:
|
|||
(when (memq e '(free-vars unresolved
|
||||
callargs redefine
|
||||
obsolete noruntime
|
||||
cl-functions interactive-only make-local))
|
||||
cl-functions interactive-only
|
||||
make-local mapcar))
|
||||
e))
|
||||
x)
|
||||
x))))
|
||||
|
|
@ -975,7 +979,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
|
|||
(pos (if (and byte-compile-current-file
|
||||
(integerp byte-compile-read-position))
|
||||
(with-current-buffer byte-compile-current-buffer
|
||||
(format "%d:%d:"
|
||||
(format "%d:%d:"
|
||||
(save-excursion
|
||||
(goto-char byte-compile-last-position)
|
||||
(1+ (count-lines (point-min) (point-at-bol))))
|
||||
|
|
@ -1037,8 +1041,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
|
|||
(setq byte-compile-last-logged-file byte-compile-current-file
|
||||
byte-compile-last-warned-form nil)
|
||||
;; Do this after setting default-directory.
|
||||
(unless (eq major-mode 'compilation-mode)
|
||||
(compilation-mode))
|
||||
(unless (derived-mode-p 'compilation-mode) (compilation-mode))
|
||||
(compilation-forget-errors)
|
||||
pt))))
|
||||
|
||||
|
|
@ -1552,7 +1555,7 @@ recompile every `.el' file that already has a `.elc' file."
|
|||
;; compilation-mode copies value of default-directory.
|
||||
(unless (eq major-mode 'compilation-mode)
|
||||
(compilation-mode))
|
||||
(let ((directories (list (expand-file-name directory)))
|
||||
(let ((directories (list default-directory))
|
||||
(default-directory default-directory)
|
||||
(skip-count 0)
|
||||
(fail-count 0)
|
||||
|
|
@ -1659,7 +1662,7 @@ 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)
|
||||
(with-current-buffer
|
||||
(with-current-buffer
|
||||
(setq input-buffer (get-buffer-create " *Compiler Input*"))
|
||||
(erase-buffer)
|
||||
(setq buffer-file-coding-system nil)
|
||||
|
|
@ -2832,6 +2835,11 @@ That command is designed for interactive use only" fn))
|
|||
(defun byte-compile-normal-call (form)
|
||||
(if byte-compile-generate-call-tree
|
||||
(byte-compile-annotate-call-tree form))
|
||||
(when (and for-effect (eq (car form) 'mapcar)
|
||||
(memq 'mapcar byte-compile-warnings))
|
||||
(byte-compile-set-symbol-position 'mapcar)
|
||||
(byte-compile-warn
|
||||
"`mapcar' called for effect; use `mapc' or `dolist' instead"))
|
||||
(byte-compile-push-constant (car form))
|
||||
(mapc 'byte-compile-form (cdr form)) ; wasteful, but faster.
|
||||
(byte-compile-out 'byte-call (length (cdr form))))
|
||||
|
|
@ -4237,18 +4245,18 @@ and corresponding effects."
|
|||
(assq 'byte-code (symbol-function 'byte-compile-form))
|
||||
(let ((byte-optimize nil) ; do it fast
|
||||
(byte-compile-warnings nil))
|
||||
(mapcar (lambda (x)
|
||||
(or noninteractive (message "compiling %s..." x))
|
||||
(byte-compile x)
|
||||
(or noninteractive (message "compiling %s...done" x)))
|
||||
'(byte-compile-normal-call
|
||||
byte-compile-form
|
||||
byte-compile-body
|
||||
;; Inserted some more than necessary, to speed it up.
|
||||
byte-compile-top-level
|
||||
byte-compile-out-toplevel
|
||||
byte-compile-constant
|
||||
byte-compile-variable-ref))))
|
||||
(mapc (lambda (x)
|
||||
(or noninteractive (message "compiling %s..." x))
|
||||
(byte-compile x)
|
||||
(or noninteractive (message "compiling %s...done" x)))
|
||||
'(byte-compile-normal-call
|
||||
byte-compile-form
|
||||
byte-compile-body
|
||||
;; Inserted some more than necessary, to speed it up.
|
||||
byte-compile-top-level
|
||||
byte-compile-out-toplevel
|
||||
byte-compile-constant
|
||||
byte-compile-variable-ref))))
|
||||
nil)
|
||||
|
||||
(run-hooks 'bytecomp-load-hook)
|
||||
|
|
|
|||
|
|
@ -199,6 +199,12 @@
|
|||
:group 'lisp
|
||||
:version "20.3")
|
||||
|
||||
(defcustom checkdoc-minor-mode-string " CDoc"
|
||||
"*String to display in mode line when Checkdoc mode is enabled; nil for none."
|
||||
:type '(choice string (const :tag "None" nil))
|
||||
:group 'checkdoc
|
||||
:version "23.1")
|
||||
|
||||
(defcustom checkdoc-autofix-flag 'semiautomatic
|
||||
"Non-nil means attempt auto-fixing of doc strings.
|
||||
If this value is the symbol `query', then the user is queried before
|
||||
|
|
@ -227,7 +233,7 @@ and that it's good but not required practice to make non user visible items
|
|||
have doc strings."
|
||||
:group 'checkdoc
|
||||
:type 'boolean)
|
||||
(put 'checkdoc-force-docstrings-flag 'safe-local-variable 'booleanp)
|
||||
;;;###autoload(put 'checkdoc-force-docstrings-flag 'safe-local-variable 'booleanp)
|
||||
|
||||
(defcustom checkdoc-force-history-flag t
|
||||
"Non-nil means that files should have a History section or ChangeLog file.
|
||||
|
|
@ -243,7 +249,7 @@ should be used when the first part could stand alone as a sentence, but
|
|||
it indicates that a modifying clause follows."
|
||||
:group 'checkdoc
|
||||
:type 'boolean)
|
||||
(put 'checkdoc-permit-comma-termination-flag 'safe-local-variable 'booleanp)
|
||||
;;;###autoload(put 'checkdoc-permit-comma-termination-flag 'safe-local-variable 'booleanp)
|
||||
|
||||
(defcustom checkdoc-spellcheck-documentation-flag nil
|
||||
"Non-nil means run Ispell on text based on value.
|
||||
|
|
@ -1251,7 +1257,7 @@ bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-c
|
|||
checking of documentation strings.
|
||||
|
||||
\\{checkdoc-minor-mode-map}"
|
||||
nil " CDoc" nil
|
||||
nil checkdoc-minor-mode-string nil
|
||||
:group 'checkdoc)
|
||||
|
||||
;;; Subst utils
|
||||
|
|
|
|||
|
|
@ -55,7 +55,7 @@ The second \\( \\) construct must match the years."
|
|||
(defcustom copyright-names-regexp ""
|
||||
"Regexp matching the names which correspond to the user.
|
||||
Only copyright lines where the name matches this regexp will be updated.
|
||||
This allows you to avoid adding yars to a copyright notice belonging to
|
||||
This allows you to avoid adding years to a copyright notice belonging to
|
||||
someone else or to a group for which you do not work."
|
||||
:group 'copyright
|
||||
:type 'regexp)
|
||||
|
|
@ -184,10 +184,13 @@ interactively."
|
|||
either \\|; a\\^u eldono \\([0-9]+\\)a, ? a\\^u (la\\^u via \\)\
|
||||
version \\([0-9]+\\), or (at"
|
||||
(copyright-limit) t)
|
||||
(not (string= (match-string 3) copyright-current-gpl-version))
|
||||
;; Don't update if the file is already using a more recent
|
||||
;; version than the "current" one.
|
||||
(< (string-to-number (match-string 3))
|
||||
(string-to-number copyright-current-gpl-version))
|
||||
(or noquery
|
||||
(y-or-n-p (concat "Replace GPL version by "
|
||||
copyright-current-gpl-version "? ")))
|
||||
(y-or-n-p (format "Replace GPL version by %s? "
|
||||
copyright-current-gpl-version)))
|
||||
(progn
|
||||
(if (match-end 2)
|
||||
;; Esperanto bilingual comment in two-column.el
|
||||
|
|
|
|||
|
|
@ -244,14 +244,14 @@ Any pair that has the same PREDICATE is first removed."
|
|||
|
||||
;; Save emacs routines.
|
||||
(if (not (fboundp 'cust-print-original-prin1))
|
||||
(mapcar 'cust-print-set-function-cell
|
||||
'((cust-print-original-prin1 prin1)
|
||||
(cust-print-original-princ princ)
|
||||
(cust-print-original-print print)
|
||||
(cust-print-original-prin1-to-string prin1-to-string)
|
||||
(cust-print-original-format format)
|
||||
(cust-print-original-message message)
|
||||
(cust-print-original-error error))))
|
||||
(mapc 'cust-print-set-function-cell
|
||||
'((cust-print-original-prin1 prin1)
|
||||
(cust-print-original-princ princ)
|
||||
(cust-print-original-print print)
|
||||
(cust-print-original-prin1-to-string prin1-to-string)
|
||||
(cust-print-original-format format)
|
||||
(cust-print-original-message message)
|
||||
(cust-print-original-error error))))
|
||||
|
||||
|
||||
(defun custom-print-install ()
|
||||
|
|
@ -259,29 +259,29 @@ Any pair that has the same PREDICATE is first removed."
|
|||
The Emacs subroutines are saved away, and you can reinstall them
|
||||
by running `custom-print-uninstall'."
|
||||
(interactive)
|
||||
(mapcar 'cust-print-set-function-cell
|
||||
'((prin1 custom-prin1)
|
||||
(princ custom-princ)
|
||||
(print custom-print)
|
||||
(prin1-to-string custom-prin1-to-string)
|
||||
(format custom-format)
|
||||
(message custom-message)
|
||||
(error custom-error)
|
||||
))
|
||||
(mapc 'cust-print-set-function-cell
|
||||
'((prin1 custom-prin1)
|
||||
(princ custom-princ)
|
||||
(print custom-print)
|
||||
(prin1-to-string custom-prin1-to-string)
|
||||
(format custom-format)
|
||||
(message custom-message)
|
||||
(error custom-error)
|
||||
))
|
||||
t)
|
||||
|
||||
(defun custom-print-uninstall ()
|
||||
"Reset print functions to their Emacs subroutines."
|
||||
(interactive)
|
||||
(mapcar 'cust-print-set-function-cell
|
||||
'((prin1 cust-print-original-prin1)
|
||||
(princ cust-print-original-princ)
|
||||
(print cust-print-original-print)
|
||||
(prin1-to-string cust-print-original-prin1-to-string)
|
||||
(format cust-print-original-format)
|
||||
(message cust-print-original-message)
|
||||
(error cust-print-original-error)
|
||||
))
|
||||
(mapc 'cust-print-set-function-cell
|
||||
'((prin1 cust-print-original-prin1)
|
||||
(princ cust-print-original-princ)
|
||||
(print cust-print-original-print)
|
||||
(prin1-to-string cust-print-original-prin1-to-string)
|
||||
(format cust-print-original-format)
|
||||
(message cust-print-original-message)
|
||||
(error cust-print-original-error)
|
||||
))
|
||||
t)
|
||||
|
||||
(defalias 'custom-print-funcs-installed-p 'custom-print-installed-p)
|
||||
|
|
|
|||
|
|
@ -250,7 +250,7 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
|
|||
(+ indent disassemble-recursive-indent)))
|
||||
((eq (car-safe (car-safe arg)) 'byte-code)
|
||||
(insert "(<byte code>...)\n")
|
||||
(mapcar ;recurse on list of byte-code objects
|
||||
(mapc ;recurse on list of byte-code objects
|
||||
'(lambda (obj)
|
||||
(disassemble-1
|
||||
obj
|
||||
|
|
|
|||
|
|
@ -139,8 +139,8 @@ For example, you could write
|
|||
(setq body (list* lighter keymap body) lighter nil keymap nil))
|
||||
((keywordp keymap) (push keymap body) (setq keymap nil)))
|
||||
|
||||
(let* ((last-message (current-message))
|
||||
(mode-name (symbol-name mode))
|
||||
(let* ((last-message (make-symbol "last-message"))
|
||||
(mode-name (symbol-name mode))
|
||||
(pretty-name (easy-mmode-pretty-mode-name mode lighter))
|
||||
(globalp nil)
|
||||
(set nil)
|
||||
|
|
@ -222,28 +222,30 @@ With zero or negative ARG turn mode off.
|
|||
;; Use `toggle' rather than (if ,mode 0 1) so that using
|
||||
;; repeat-command still does the toggling correctly.
|
||||
(interactive (list (or current-prefix-arg 'toggle)))
|
||||
(setq ,mode
|
||||
(cond
|
||||
((eq arg 'toggle) (not ,mode))
|
||||
(arg (> (prefix-numeric-value arg) 0))
|
||||
(t
|
||||
(if (null ,mode) t
|
||||
(message
|
||||
"Toggling %s off; better pass an explicit argument."
|
||||
',mode)
|
||||
nil))))
|
||||
,@body
|
||||
;; The on/off hooks are here for backward compatibility only.
|
||||
(run-hooks ',hook (if ,mode ',hook-on ',hook-off))
|
||||
(if (called-interactively-p)
|
||||
(progn
|
||||
,(if globalp `(customize-mark-as-set ',mode))
|
||||
;; Avoid overwriting a message shown by the body,
|
||||
;; but do overwrite previous messages.
|
||||
(unless ,(and (current-message)
|
||||
(not (equal last-message (current-message))))
|
||||
(message ,(format "%s %%sabled" pretty-name)
|
||||
(if ,mode "en" "dis")))))
|
||||
(let ((,last-message (current-message)))
|
||||
(setq ,mode
|
||||
(cond
|
||||
((eq arg 'toggle) (not ,mode))
|
||||
(arg (> (prefix-numeric-value arg) 0))
|
||||
(t
|
||||
(if (null ,mode) t
|
||||
(message
|
||||
"Toggling %s off; better pass an explicit argument."
|
||||
',mode)
|
||||
nil))))
|
||||
,@body
|
||||
;; The on/off hooks are here for backward compatibility only.
|
||||
(run-hooks ',hook (if ,mode ',hook-on ',hook-off))
|
||||
(if (called-interactively-p)
|
||||
(progn
|
||||
,(if globalp `(customize-mark-as-set ',mode))
|
||||
;; Avoid overwriting a message shown by the body,
|
||||
;; but do overwrite previous messages.
|
||||
(unless (and (current-message)
|
||||
(not (equal ,last-message
|
||||
(current-message))))
|
||||
(message ,(format "%s %%sabled" pretty-name)
|
||||
(if ,mode "en" "dis"))))))
|
||||
(force-mode-line-update)
|
||||
;; Return the new setting.
|
||||
,mode)
|
||||
|
|
@ -456,7 +458,7 @@ ARGS is a list of additional keyword arguments."
|
|||
(let ((char (car cs))
|
||||
(syntax (cdr cs)))
|
||||
(if (sequencep char)
|
||||
(mapcar (lambda (c) (modify-syntax-entry c syntax st)) char)
|
||||
(mapc (lambda (c) (modify-syntax-entry c syntax st)) char)
|
||||
(modify-syntax-entry char syntax st))))
|
||||
(if parent (set-char-table-parent
|
||||
st (if (symbolp parent) (symbol-value parent) parent)))
|
||||
|
|
@ -539,5 +541,5 @@ found, do `widen' first and then call NARROWFUN with no args after moving."
|
|||
|
||||
(provide 'easy-mmode)
|
||||
|
||||
;;; arch-tag: d48a5250-6961-4528-9cb0-3c9ea042a66a
|
||||
;; arch-tag: d48a5250-6961-4528-9cb0-3c9ea042a66a
|
||||
;;; easy-mmode.el ends here
|
||||
|
|
|
|||
|
|
@ -4421,7 +4421,7 @@ With prefix argument, make it a temporary breakpoint."
|
|||
|
||||
(defun byte-compile-resolve-functions (funcs)
|
||||
"Say it is OK for the named functions to be unresolved."
|
||||
(mapcar
|
||||
(mapc
|
||||
(function
|
||||
(lambda (func)
|
||||
(setq byte-compile-unresolved-functions
|
||||
|
|
|
|||
|
|
@ -109,7 +109,7 @@ truncated to make more of the arglist or documentation string visible."
|
|||
;;; No user options below here.
|
||||
|
||||
(defvar eldoc-message-commands-table-size 31
|
||||
"This is used by eldoc-add-command to initialize eldoc-message-commands
|
||||
"This is used by `eldoc-add-command' to initialize `eldoc-message-commands'
|
||||
as an obarray.
|
||||
It should probably never be necessary to do so, but if you
|
||||
choose to increase the number of buckets, you must do so before loading
|
||||
|
|
@ -121,7 +121,7 @@ Remember to keep it a prime number to improve hash performance.")
|
|||
"Commands after which it is appropriate to print in the echo area.
|
||||
Eldoc does not try to print function arglists, etc. after just any command,
|
||||
because some commands print their own messages in the echo area and these
|
||||
functions would instantly overwrite them. But self-insert-command as well
|
||||
functions would instantly overwrite them. But `self-insert-command' as well
|
||||
as most motion commands are good candidates.
|
||||
This variable contains an obarray of symbols; do not manipulate it
|
||||
directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'.")
|
||||
|
|
@ -137,7 +137,7 @@ directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'.")
|
|||
(defvar eldoc-timer nil "eldoc's timer object.")
|
||||
|
||||
(defvar eldoc-current-idle-delay eldoc-idle-delay
|
||||
"idle time delay currently in use by timer.
|
||||
"Idle time delay currently in use by timer.
|
||||
This is used to determine if `eldoc-idle-delay' is changed by the user.")
|
||||
|
||||
|
||||
|
|
@ -474,13 +474,14 @@ ARGLIST is either a string, or a list of strings or symbols."
|
|||
(format "(%s)" arglist)))
|
||||
|
||||
(defun eldoc-function-argstring-format (argstring)
|
||||
"Apply `eldoc-argument-case' to each word in argstring.
|
||||
"Apply `eldoc-argument-case' to each word in ARGSTRING.
|
||||
The words \"&rest\", \"&optional\" are returned unchanged."
|
||||
(mapconcat (lambda (s)
|
||||
(if (member s '("&optional" "&rest"))
|
||||
s
|
||||
(funcall eldoc-argument-case s)))
|
||||
(split-string argstring) " "))
|
||||
(split-string argstring "[][ ()]+" t) " "))
|
||||
|
||||
|
||||
;; When point is in a sexp, the function args are not reprinted in the echo
|
||||
;; area after every possible interactive command because some of them print
|
||||
|
|
|
|||
|
|
@ -218,7 +218,7 @@ This environment can be passed to `macroexpand'."
|
|||
(buffer-file-name)
|
||||
(buffer-name))))
|
||||
(elint-display-log)
|
||||
(mapcar 'elint-top-form (elint-update-env))
|
||||
(mapc 'elint-top-form (elint-update-env))
|
||||
|
||||
;; Tell the user we're finished. This is terribly klugy: we set
|
||||
;; elint-top-form-logged so elint-log-message doesn't print the
|
||||
|
|
@ -542,11 +542,11 @@ CODE can be a lambda expression, a macro, or byte-compiled code."
|
|||
(defun elint-check-defun-form (form env)
|
||||
"Lint a defun/defmacro/lambda FORM in ENV."
|
||||
(setq form (if (eq (car form) 'lambda) (cdr form) (cdr (cdr form))))
|
||||
(mapcar (function (lambda (p)
|
||||
(or (memq p '(&optional &rest))
|
||||
(setq env (elint-env-add-var env p)))
|
||||
))
|
||||
(car form))
|
||||
(mapc (function (lambda (p)
|
||||
(or (memq p '(&optional &rest))
|
||||
(setq env (elint-env-add-var env p)))
|
||||
))
|
||||
(car form))
|
||||
(elint-forms (cdr form) env))
|
||||
|
||||
(defun elint-check-let-form (form env)
|
||||
|
|
@ -566,21 +566,21 @@ CODE can be a lambda expression, a macro, or byte-compiled code."
|
|||
|
||||
;; Add variables to environment, and check the init values
|
||||
(let ((newenv env))
|
||||
(mapcar (function (lambda (s)
|
||||
(cond
|
||||
((symbolp s)
|
||||
(setq newenv (elint-env-add-var newenv s)))
|
||||
((and (consp s) (<= (length s) 2))
|
||||
(elint-form (car (cdr s))
|
||||
(if (eq (car form) 'let)
|
||||
env
|
||||
newenv))
|
||||
(setq newenv
|
||||
(elint-env-add-var newenv (car s))))
|
||||
(t (elint-error
|
||||
"Malformed `let' declaration: %s" s))
|
||||
)))
|
||||
varlist)
|
||||
(mapc (function (lambda (s)
|
||||
(cond
|
||||
((symbolp s)
|
||||
(setq newenv (elint-env-add-var newenv s)))
|
||||
((and (consp s) (<= (length s) 2))
|
||||
(elint-form (car (cdr s))
|
||||
(if (eq (car form) 'let)
|
||||
env
|
||||
newenv))
|
||||
(setq newenv
|
||||
(elint-env-add-var newenv (car s))))
|
||||
(t (elint-error
|
||||
"Malformed `let' declaration: %s" s))
|
||||
)))
|
||||
varlist)
|
||||
|
||||
;; Lint the body forms
|
||||
(elint-forms (cdr (cdr form)) newenv)
|
||||
|
|
@ -665,18 +665,18 @@ CODE can be a lambda expression, a macro, or byte-compiled code."
|
|||
errlist)
|
||||
(while errforms
|
||||
(setq errlist (car (car errforms)))
|
||||
(mapcar (function (lambda (s)
|
||||
(or (get s 'error-conditions)
|
||||
(get s 'error-message)
|
||||
(elint-warning
|
||||
"Not an error symbol in error handler: %s" s))))
|
||||
(cond
|
||||
((symbolp errlist) (list errlist))
|
||||
((listp errlist) errlist)
|
||||
(t (elint-error "Bad error list in error handler: %s"
|
||||
errlist)
|
||||
nil))
|
||||
)
|
||||
(mapc (function (lambda (s)
|
||||
(or (get s 'error-conditions)
|
||||
(get s 'error-message)
|
||||
(elint-warning
|
||||
"Not an error symbol in error handler: %s" s))))
|
||||
(cond
|
||||
((symbolp errlist) (list errlist))
|
||||
((listp errlist) errlist)
|
||||
(t (elint-error "Bad error list in error handler: %s"
|
||||
errlist)
|
||||
nil))
|
||||
)
|
||||
(elint-forms (cdr (car errforms)) newenv)
|
||||
(setq errforms (cdr errforms))
|
||||
)))
|
||||
|
|
@ -767,11 +767,11 @@ Insert HEADER followed by a blank line if non-nil."
|
|||
(defun elint-initialize ()
|
||||
"Initialize elint."
|
||||
(interactive)
|
||||
(mapcar (function (lambda (x)
|
||||
(or (not (symbolp (car x)))
|
||||
(eq (cdr x) 'unknown)
|
||||
(put (car x) 'elint-args (cdr x)))))
|
||||
(elint-find-builtin-args))
|
||||
(mapc (function (lambda (x)
|
||||
(or (not (symbolp (car x)))
|
||||
(eq (cdr x) 'unknown)
|
||||
(put (car x) 'elint-args (cdr x)))))
|
||||
(elint-find-builtin-args))
|
||||
(mapcar (function (lambda (x)
|
||||
(put (car x) 'elint-args (cdr x))))
|
||||
elint-unknown-builtin-args))
|
||||
|
|
|
|||
|
|
@ -615,7 +615,7 @@ displayed."
|
|||
;; buffer
|
||||
(if elp-sort-by-function
|
||||
(setq resvec (sort resvec elp-sort-by-function)))
|
||||
(mapcar 'elp-output-result resvec))
|
||||
(mapc 'elp-output-result resvec))
|
||||
;; now pop up results buffer
|
||||
(set-buffer curbuf)
|
||||
(pop-to-buffer resultsbuf)
|
||||
|
|
|
|||
|
|
@ -205,7 +205,7 @@ See the file generic-x.el for some examples of `define-generic-mode'."
|
|||
(setq font-lock-defaults '(generic-font-lock-keywords))
|
||||
|
||||
;; Call a list of functions
|
||||
(mapcar 'funcall function-list)
|
||||
(mapc 'funcall function-list)
|
||||
|
||||
(run-mode-hooks mode-hook)))
|
||||
|
||||
|
|
|
|||
|
|
@ -261,7 +261,6 @@
|
|||
|
||||
(defvar lisp-mode-shared-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "\t" 'lisp-indent-line)
|
||||
(define-key map "\e\C-q" 'indent-sexp)
|
||||
(define-key map "\177" 'backward-delete-char-untabify)
|
||||
;; This gets in the way when viewing a Lisp file in view-mode. As
|
||||
|
|
@ -785,8 +784,13 @@ which see."
|
|||
(let ((comment-start nil) (comment-start-skip nil))
|
||||
(do-auto-fill))))))
|
||||
|
||||
(defvar lisp-indent-offset nil
|
||||
"If non-nil, indent second line of expressions that many more columns.")
|
||||
(defcustom lisp-indent-offset nil
|
||||
"If non-nil, indent second line of expressions that many more columns."
|
||||
:group 'lisp
|
||||
:type '(choice nil integer))
|
||||
(put 'lisp-body-indent 'safe-local-variable
|
||||
(lambda (x) (or (null x) (integerp x))))
|
||||
|
||||
(defvar lisp-indent-function 'lisp-indent-function)
|
||||
|
||||
(defun lisp-indent-line (&optional whole-exp)
|
||||
|
|
@ -1026,8 +1030,11 @@ This function also returns nil meaning don't specify the indentation."
|
|||
(method
|
||||
(funcall method indent-point state)))))))
|
||||
|
||||
(defvar lisp-body-indent 2
|
||||
"Number of columns to indent the second line of a `(def...)' form.")
|
||||
(defcustom lisp-body-indent 2
|
||||
"Number of columns to indent the second line of a `(def...)' form."
|
||||
:group 'lisp
|
||||
:type 'integer)
|
||||
(put 'lisp-body-indent 'safe-local-variable 'integerp)
|
||||
|
||||
(defun lisp-indent-specform (count state indent-point normal-indent)
|
||||
(let ((containing-form-start (elt state 1))
|
||||
|
|
|
|||
|
|
@ -515,7 +515,7 @@ optional fourth argument FORCE is non-nil."
|
|||
"Delete all RE Builder overlays in the `reb-target-buffer' buffer."
|
||||
(if (buffer-live-p reb-target-buffer)
|
||||
(with-current-buffer reb-target-buffer
|
||||
(mapcar 'delete-overlay reb-overlays)
|
||||
(mapc 'delete-overlay reb-overlays)
|
||||
(setq reb-overlays nil))))
|
||||
|
||||
(defun reb-assert-buffer-in-window ()
|
||||
|
|
|
|||
|
|
@ -166,7 +166,7 @@ useful information:
|
|||
|
||||
;; lets find the special tags and remove them from the working
|
||||
;; frame. note that only the last special tag is used.
|
||||
(mapcar
|
||||
(mapc
|
||||
(function
|
||||
(lambda (entry)
|
||||
(let ((pred (car entry))
|
||||
|
|
|
|||
|
|
@ -679,7 +679,7 @@ CHAR
|
|||
|
||||
`not-newline', `nonl'
|
||||
matches any character except a newline.
|
||||
.
|
||||
|
||||
`anything'
|
||||
matches any character
|
||||
|
||||
|
|
|
|||
|
|
@ -565,7 +565,7 @@ has one of the following forms:
|
|||
(let ((chars (make-bool-vector 256 nil))) ; Yeah, right!
|
||||
(dolist (arg args)
|
||||
(cond ((integerp arg) (aset chars arg t))
|
||||
((stringp arg) (mapcar (lambda (c) (aset chars c t)) arg))
|
||||
((stringp arg) (mapc (lambda (c) (aset chars c t)) arg))
|
||||
((consp arg)
|
||||
(let ((start (car arg))
|
||||
(end (cdr arg)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue