summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/advice.el7
-rw-r--r--lisp/emacs-lisp/authors.el8
-rw-r--r--lisp/emacs-lisp/byte-opt.el4
-rw-r--r--lisp/emacs-lisp/bytecomp.el173
-rw-r--r--lisp/emacs-lisp/cl-compat.el4
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el118
-rw-r--r--lisp/emacs-lisp/cl-macs.el13
-rw-r--r--lisp/emacs-lisp/cl-seq.el4
-rw-r--r--lisp/emacs-lisp/cl.el15
-rw-r--r--lisp/emacs-lisp/elp.el28
-rw-r--r--lisp/emacs-lisp/find-func.el20
-rw-r--r--lisp/emacs-lisp/lselect.el242
-rw-r--r--lisp/emacs-lisp/unsafep.el19
13 files changed, 253 insertions, 402 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 21136721e60..f9c778443b4 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2675,12 +2675,9 @@ For that it has to be fbound with a non-autoload definition."
(ad-with-auto-activation-disabled
(require 'bytecomp)
(let ((symbol (make-symbol "advice-compilation"))
- (byte-compile-warnings
- (if (listp byte-compile-warnings) byte-compile-warnings
- byte-compile-warning-types)))
+ (byte-compile-warnings byte-compile-warnings))
(if (featurep 'cl)
- (setq byte-compile-warnings
- (remq 'cl-functions byte-compile-warnings)))
+ (byte-compile-disable-warning 'cl-functions))
(fset symbol (symbol-function function))
(byte-compile symbol)
(fset function (symbol-function symbol))))))
diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el
index 4b490621f51..50d2f41f7ae 100644
--- a/lisp/emacs-lisp/authors.el
+++ b/lisp/emacs-lisp/authors.el
@@ -475,8 +475,8 @@ with the file and the number of each action.
:wrote means the author wrote the file
:changed means he changed the file COUNT times."
- (let* ((enable-local-variables t)
- (enable-local-eval t)
+ (let* ((enable-local-variables :safe)
+ (enable-local-eval nil)
(existing-buffer (get-file-buffer log-file))
(buffer (find-file-noselect log-file))
author file pos)
@@ -521,8 +521,8 @@ with the file and the number of each action.
"Scan Lisp file FILE for author information.
TABLE is a hash table to add author information to."
(let* ((existing-buffer (get-file-buffer file))
- (enable-local-variables t)
- (enable-local-eval t)
+ (enable-local-variables :safe)
+ (enable-local-eval nil)
(buffer (find-file-noselect file)))
(save-excursion
(set-buffer buffer)
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 2ff453ac6e5..bc864aab490 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1150,7 +1150,9 @@
;; can safely optimize away this test.
(if (member (cdr-safe form) '(((quote xemacs)) ((quote sxemacs))))
nil
- form))
+ (if (member (cdr-safe form) '(((quote emacs))))
+ t
+ form)))
(put 'set 'byte-optimizer 'byte-optimize-set)
(defun byte-optimize-set (form)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index fbda38b79f0..27ee27eda92 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -362,7 +362,10 @@ Elements of the list may be:
interactive-only
commands that normally shouldn't be called from Lisp code.
make-local calls to make-variable-buffer-local that may be incorrect.
- mapcar mapcar called for effect."
+ mapcar mapcar called for effect.
+
+If the list begins with `not', then the remaining elements specify warnings to
+suppress. For example, (not mapcar) will suppress warnings about mapcar."
:group 'bytecomp
:type `(choice (const :tag "All" t)
(set :menu-tag "Some"
@@ -377,6 +380,8 @@ Elements of the list may be:
(defun byte-compile-warnings-safe-p (x)
(or (booleanp x)
(and (listp x)
+ (if (eq (car x) 'not) (setq x (cdr x))
+ t)
(equal (mapcar
(lambda (e)
(when (memq e '(free-vars unresolved
@@ -388,6 +393,46 @@ Elements of the list may be:
x)
x))))
+(defun byte-compile-warning-enabled-p (warning)
+ "Return non-nil if WARNING is enabled, according to `byte-compile-warnings'."
+ (or (eq byte-compile-warnings t)
+ (if (eq (car byte-compile-warnings) 'not)
+ (not (memq warning byte-compile-warnings))
+ (memq warning byte-compile-warnings))))
+
+;;;###autoload
+(defun byte-compile-disable-warning (warning)
+ "Change `byte-compile-warnings' to disable WARNING.
+If `byte-compile-warnings' is t, set it to `(not WARNING)'.
+Otherwise, if the first element is `not', add WARNING, else remove it.
+Normally you should let-bind `byte-compile-warnings' before calling this,
+else the global value will be modified."
+ (setq byte-compile-warnings
+ (cond ((eq byte-compile-warnings t)
+ (list 'not warning))
+ ((eq (car byte-compile-warnings) 'not)
+ (if (memq warning byte-compile-warnings)
+ byte-compile-warnings
+ (append byte-compile-warnings (list warning))))
+ (t
+ (delq warning byte-compile-warnings)))))
+
+;;;###autoload
+(defun byte-compile-enable-warning (warning)
+ "Change `byte-compile-warnings' to enable WARNING.
+If `byte-compile-warnings' is `t', do nothing. Otherwise, if the
+first element is `not', remove WARNING, else add it.
+Normally you should let-bind `byte-compile-warnings' before calling this,
+else the global value will be modified."
+ (or (eq byte-compile-warnings t)
+ (setq byte-compile-warnings
+ (cond ((eq (car byte-compile-warnings) 'not)
+ (delq warning byte-compile-warnings))
+ ((memq warning byte-compile-warnings)
+ byte-compile-warnings)
+ (t
+ (append byte-compile-warnings (list warning)))))))
+
(defvar byte-compile-interactive-only-functions
'(beginning-of-buffer end-of-buffer replace-string replace-regexp
insert-file insert-buffer insert-file-literally previous-line next-line)
@@ -830,7 +875,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(let ((hist-orig load-history)
(hist-nil-orig current-load-list))
(prog1 (eval form)
- (when (memq 'noruntime byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'noruntime)
(let ((hist-new load-history)
(hist-nil-new current-load-list))
;; Go through load-history, look for newly loaded files
@@ -858,7 +903,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(push s byte-compile-noruntime-functions))
(when (and (consp s) (eq t (car s)))
(push (cdr s) old-autoloads)))))))
- (when (memq 'cl-functions byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'cl-functions)
(let ((hist-new load-history))
;; Go through load-history, look for newly loaded files
;; and mark all the functions defined therein.
@@ -876,8 +921,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(let ((tem current-load-list))
(while (not (eq tem hist-nil-orig))
(when (equal (car tem) '(require . cl))
- (setq byte-compile-warnings
- (remq 'cl-functions byte-compile-warnings)))
+ (byte-compile-disable-warning 'cl-functions))
(setq tem (cdr tem)))))))
;;; byte compiler messages
@@ -1075,7 +1119,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(handler (nth 1 new))
(when (nth 2 new)))
(byte-compile-set-symbol-position (car form))
- (if (memq 'obsolete byte-compile-warnings)
+ (if (byte-compile-warning-enabled-p 'obsolete)
(byte-compile-warn "`%s' is an obsolete function%s; %s" (car form)
(if when (concat " (as of Emacs " when ")") "")
(if (stringp (car new))
@@ -1421,7 +1465,7 @@ extra args."
;; defined, issue a warning enumerating them.
;; `unresolved' in the list `byte-compile-warnings' disables this.
(defun byte-compile-warn-about-unresolved-functions ()
- (when (memq 'unresolved byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'unresolved)
(let ((byte-compile-current-form :end)
(noruntime nil)
(unresolved nil))
@@ -1484,9 +1528,7 @@ symbol itself."
byte-compile-dynamic-docstrings)
;; (byte-compile-generate-emacs19-bytecodes
;; byte-compile-generate-emacs19-bytecodes)
- (byte-compile-warnings (if (eq byte-compile-warnings t)
- byte-compile-warning-types
- byte-compile-warnings))
+ (byte-compile-warnings byte-compile-warnings)
)
body)))
@@ -1829,9 +1871,7 @@ With argument, insert value in current buffer after the form."
(read-with-symbol-positions inbuffer)
(read-symbol-positions-list nil)
;; #### This is bound in b-c-close-variables.
- ;; (byte-compile-warnings (if (eq byte-compile-warnings t)
- ;; byte-compile-warning-types
- ;; byte-compile-warnings))
+ ;; (byte-compile-warnings byte-compile-warnings)
)
(byte-compile-close-variables
(with-current-buffer
@@ -2210,7 +2250,7 @@ list that represents a doc string reference.
;; Since there is no doc string, we can compile this as a normal form,
;; and not do a file-boundary.
(byte-compile-keep-pending form)
- (when (memq 'free-vars byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'free-vars)
(push (nth 1 form) byte-compile-bound-variables)
(if (eq (car form) 'defconst)
(push (nth 1 form) byte-compile-const-variables)))
@@ -2220,12 +2260,19 @@ list that represents a doc string reference.
(byte-compile-top-level (nth 2 form) nil 'file))))
form))
+(put 'define-abbrev-table 'byte-hunk-handler 'byte-compile-file-form-define-abbrev-table)
+(defun byte-compile-file-form-define-abbrev-table (form)
+ (when (and (byte-compile-warning-enabled-p 'free-vars)
+ (eq 'quote (car-safe (car-safe (cdr form)))))
+ (push (car-safe (cdr (cadr form))) byte-compile-bound-variables))
+ (byte-compile-keep-pending form))
+
(put 'custom-declare-variable 'byte-hunk-handler
'byte-compile-file-form-custom-declare-variable)
(defun byte-compile-file-form-custom-declare-variable (form)
- (when (memq 'callargs byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'callargs)
(byte-compile-nogroup-warn form))
- (when (memq 'free-vars byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'free-vars)
(push (nth 1 (nth 1 form)) byte-compile-bound-variables))
(let ((tail (nthcdr 4 form)))
(while tail
@@ -2248,8 +2295,7 @@ list that represents a doc string reference.
(apply 'require args)
;; Detect (require 'cl) in a way that works even if cl is already loaded.
(if (member (car args) '("cl" cl))
- (setq byte-compile-warnings
- (remq 'cl-functions byte-compile-warnings))))
+ (byte-compile-disable-warning 'cl-functions)))
(byte-compile-keep-pending form 'byte-compile-normal-call))
(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
@@ -2295,12 +2341,12 @@ list that represents a doc string reference.
(cons (list name nil nil) byte-compile-call-tree))))
(setq byte-compile-current-form name) ; for warnings
- (if (memq 'redefine byte-compile-warnings)
+ (if (byte-compile-warning-enabled-p 'redefine)
(byte-compile-arglist-warn form macrop))
(if byte-compile-verbose
(message "Compiling %s... (%s)" (or filename "") (nth 1 form)))
(cond (that-one
- (if (and (memq 'redefine byte-compile-warnings)
+ (if (and (byte-compile-warning-enabled-p 'redefine)
;; don't warn when compiling the stubs in byte-run...
(not (assq (nth 1 form)
byte-compile-initial-macro-environment)))
@@ -2309,7 +2355,7 @@ list that represents a doc string reference.
(nth 1 form)))
(setcdr that-one nil))
(this-one
- (when (and (memq 'redefine byte-compile-warnings)
+ (when (and (byte-compile-warning-enabled-p 'redefine)
;; hack: don't warn when compiling the magic internal
;; byte-compiler macros in byte-run.el...
(not (assq (nth 1 form)
@@ -2320,7 +2366,7 @@ list that represents a doc string reference.
((and (fboundp name)
(eq (car-safe (symbol-function name))
(if macrop 'lambda 'macro)))
- (when (memq 'redefine byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'redefine)
(byte-compile-warn "%s `%s' being redefined as a %s"
(if macrop "function" "macro")
(nth 1 form)
@@ -2560,7 +2606,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(byte-compile-check-lambda-list (nth 1 fun))
(let* ((arglist (nth 1 fun))
(byte-compile-bound-variables
- (nconc (and (memq 'free-vars byte-compile-warnings)
+ (nconc (and (byte-compile-warning-enabled-p 'free-vars)
(delq '&rest (delq '&optional (copy-sequence arglist))))
byte-compile-bound-variables))
(body (cdr (cdr fun)))
@@ -2800,7 +2846,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(handler (get fn 'byte-compile)))
(when (byte-compile-const-symbol-p fn)
(byte-compile-warn "`%s' called as a function" fn))
- (and (memq 'interactive-only byte-compile-warnings)
+ (and (byte-compile-warning-enabled-p 'interactive-only)
(memq fn byte-compile-interactive-only-functions)
(byte-compile-warn "`%s' used from Lisp code\n\
That command is designed for interactive use only" fn))
@@ -2815,12 +2861,12 @@ That command is designed for interactive use only" fn))
byte-compile-compatibility)
(get (get fn 'byte-opcode) 'emacs19-opcode))))
(funcall handler form)
- (when (memq 'callargs byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'callargs)
(if (memq fn '(custom-declare-group custom-declare-variable custom-declare-face))
(byte-compile-nogroup-warn form))
(byte-compile-callargs-warn form))
(byte-compile-normal-call form))
- (if (memq 'cl-functions byte-compile-warnings)
+ (if (byte-compile-warning-enabled-p 'cl-functions)
(byte-compile-cl-warn form))))
((and (or (byte-code-function-p (car form))
(eq (car-safe (car form)) 'lambda))
@@ -2837,7 +2883,7 @@ That command is designed for interactive use only" fn))
(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-warning-enabled-p 'mapcar))
(byte-compile-set-symbol-position 'mapcar)
(byte-compile-warn
"`mapcar' called for effect; use `mapc' or `dolist' instead"))
@@ -2857,7 +2903,7 @@ That command is designed for interactive use only" fn))
(if (symbolp var) "constant" "nonvariable")
(prin1-to-string var))
(if (and (get var 'byte-obsolete-variable)
- (memq 'obsolete byte-compile-warnings)
+ (byte-compile-warning-enabled-p 'obsolete)
(not (eq var byte-compile-not-obsolete-var)))
(let* ((ob (get var 'byte-obsolete-variable))
(when (cdr ob)))
@@ -2866,7 +2912,7 @@ That command is designed for interactive use only" fn))
(if (stringp (car ob))
(car ob)
(format "use `%s' instead." (car ob))))))
- (if (memq 'free-vars byte-compile-warnings)
+ (if (byte-compile-warning-enabled-p 'free-vars)
(if (eq base-op 'byte-varbind)
(push var byte-compile-bound-variables)
(or (boundp var)
@@ -3448,6 +3494,32 @@ That command is designed for interactive use only" fn))
(if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
,tag))
+;; Return the list of items in CONDITION-PARAM that match PRED-LIST.
+;; Only return items that are not in ONLY-IF-NOT-PRESENT.
+(defun byte-compile-find-bound-condition (condition-param
+ pred-list
+ &optional only-if-not-present)
+ (let ((result nil)
+ (nth-one nil)
+ (cond-list
+ (if (memq (car-safe condition-param) pred-list)
+ ;; The condition appears by itself.
+ (list condition-param)
+ ;; If the condition is an `and', look for matches among the
+ ;; `and' arguments.
+ (when (eq 'and (car-safe condition-param))
+ (cdr condition-param)))))
+
+ (dolist (crt cond-list)
+ (when (and (memq (car-safe crt) pred-list)
+ (eq 'quote (car-safe (setq nth-one (nth 1 crt))))
+ ;; Ignore if the symbol is already on the unresolved
+ ;; list.
+ (not (assq (nth 1 nth-one) ; the relevant symbol
+ only-if-not-present)))
+ (push (nth 1 (nth 1 crt)) result)))
+ result))
+
(defmacro byte-compile-maybe-guarded (condition &rest body)
"Execute forms in BODY, potentially guarded by CONDITION.
CONDITION is a variable whose value is a test in an `if' or `cond'.
@@ -3459,35 +3531,34 @@ being undefined will be suppressed.
If CONDITION's value is (not (featurep 'emacs)) or (featurep 'xemacs),
that suppresses all warnings during execution of BODY."
(declare (indent 1) (debug t))
- `(let* ((fbound
- (if (eq 'fboundp (car-safe ,condition))
- (and (eq 'quote (car-safe (nth 1 ,condition)))
- ;; Ignore if the symbol is already on the
- ;; unresolved list.
- (not (assq (nth 1 (nth 1 ,condition)) ; the relevant symbol
- byte-compile-unresolved-functions))
- (nth 1 (nth 1 ,condition)))))
- (bound (if (or (eq 'boundp (car-safe ,condition))
- (eq 'default-boundp (car-safe ,condition)))
- (and (eq 'quote (car-safe (nth 1 ,condition)))
- (nth 1 (nth 1 ,condition)))))
+ `(let* ((fbound-list (byte-compile-find-bound-condition
+ ,condition (list 'fboundp)
+ byte-compile-unresolved-functions))
+ (bound-list (byte-compile-find-bound-condition
+ ,condition (list 'boundp 'default-boundp)))
;; Maybe add to the bound list.
(byte-compile-bound-variables
- (if bound
- (cons bound byte-compile-bound-variables)
+ (if bound-list
+ (append bound-list byte-compile-bound-variables)
byte-compile-bound-variables))
;; Suppress all warnings, for code not used in Emacs.
- (byte-compile-warnings
- (if (member ,condition '((featurep 'xemacs)
- (not (featurep 'emacs))))
- nil byte-compile-warnings)))
+ ;; FIXME: by the time this is executed the `featurep'
+ ;; emacs/xemacs tests have been optimized away, so this is
+ ;; not doing anything useful here, is should probably be
+ ;; moved to a different place.
+ ;; (byte-compile-warnings
+ ;; (if (member ,condition '((featurep 'xemacs)
+ ;; (not (featurep 'emacs))))
+ ;; nil byte-compile-warnings))
+ )
(unwind-protect
(progn ,@body)
;; Maybe remove the function symbol from the unresolved list.
- (if fbound
+ (dolist (fbound fbound-list)
+ (when fbound
(setq byte-compile-unresolved-functions
(delq (assq fbound byte-compile-unresolved-functions)
- byte-compile-unresolved-functions))))))
+ byte-compile-unresolved-functions)))))))
(defun byte-compile-if (form)
(byte-compile-form (car (cdr form)))
@@ -3809,7 +3880,7 @@ that suppresses all warnings during execution of BODY."
(if (= 1 ncall) "" "s")
(if (< ncall 2) "requires" "accepts only")
"2-3")))
- (when (memq 'free-vars byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'free-vars)
(push var byte-compile-bound-variables)
(if (eq fun 'defconst)
(push var byte-compile-const-variables)))
@@ -3901,7 +3972,7 @@ that suppresses all warnings during execution of BODY."
(byte-defop-compiler-1 make-variable-buffer-local byte-compile-make-variable-buffer-local)
(defun byte-compile-make-variable-buffer-local (form)
(if (and (eq (car-safe (car-safe (cdr-safe form))) 'quote)
- (memq 'make-local byte-compile-warnings))
+ (byte-compile-warning-enabled-p 'make-local))
(byte-compile-warn
"`make-variable-buffer-local' should be called at toplevel"))
(byte-compile-normal-call form))
diff --git a/lisp/emacs-lisp/cl-compat.el b/lisp/emacs-lisp/cl-compat.el
index ebfc43ebc80..1f476081f41 100644
--- a/lisp/emacs-lisp/cl-compat.el
+++ b/lisp/emacs-lisp/cl-compat.el
@@ -186,5 +186,9 @@
(provide 'cl-compat)
+;; Local variables:
+;; byte-compile-warnings: (not cl-functions)
+;; End:
+
;; arch-tag: 9996bb4f-aaf5-4592-b436-bf64759a3163
;;; cl-compat.el ends here
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index 705f565e146..4cdf7036369 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -745,24 +745,24 @@ Not documented
;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not
;;;;;; substitute-if substitute delete-duplicates remove-duplicates
;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove*
-;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "c972a97c053d4e001ac1d1012c315b28")
+;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "77bee7df392948b6ab0699e391e8abc1")
;;; Generated autoloads from cl-seq.el
-(autoload (quote reduce) "cl-seq" "\
+(autoload 'reduce "cl-seq" "\
Reduce two-argument FUNCTION across SEQ.
Keywords supported: :start :end :from-end :initial-value :key
\(fn FUNCTION SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote fill) "cl-seq" "\
+(autoload 'fill "cl-seq" "\
Fill the elements of SEQ with ITEM.
Keywords supported: :start :end
\(fn SEQ ITEM [KEYWORD VALUE]...)" nil nil)
-(autoload (quote replace) "cl-seq" "\
+(autoload 'replace "cl-seq" "\
Replace the elements of SEQ1 with the elements of SEQ2.
SEQ1 is destructively modified, then returned.
@@ -770,7 +770,7 @@ Keywords supported: :start1 :end1 :start2 :end2
\(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil)
-(autoload (quote remove*) "cl-seq" "\
+(autoload 'remove* "cl-seq" "\
Remove all occurrences of ITEM in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
@@ -779,7 +779,7 @@ Keywords supported: :test :test-not :key :count :start :end :from-end
\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote remove-if) "cl-seq" "\
+(autoload 'remove-if "cl-seq" "\
Remove all items satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
@@ -788,7 +788,7 @@ Keywords supported: :key :count :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote remove-if-not) "cl-seq" "\
+(autoload 'remove-if-not "cl-seq" "\
Remove all items not satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
@@ -797,7 +797,7 @@ Keywords supported: :key :count :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote delete*) "cl-seq" "\
+(autoload 'delete* "cl-seq" "\
Remove all occurrences of ITEM in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
@@ -805,7 +805,7 @@ Keywords supported: :test :test-not :key :count :start :end :from-end
\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote delete-if) "cl-seq" "\
+(autoload 'delete-if "cl-seq" "\
Remove all items satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
@@ -813,7 +813,7 @@ Keywords supported: :key :count :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote delete-if-not) "cl-seq" "\
+(autoload 'delete-if-not "cl-seq" "\
Remove all items not satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
@@ -821,21 +821,21 @@ Keywords supported: :key :count :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote remove-duplicates) "cl-seq" "\
+(autoload 'remove-duplicates "cl-seq" "\
Return a copy of SEQ with all duplicate elements removed.
Keywords supported: :test :test-not :key :start :end :from-end
\(fn SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote delete-duplicates) "cl-seq" "\
+(autoload 'delete-duplicates "cl-seq" "\
Remove all duplicate elements from SEQ (destructively).
Keywords supported: :test :test-not :key :start :end :from-end
\(fn SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote substitute) "cl-seq" "\
+(autoload 'substitute "cl-seq" "\
Substitute NEW for OLD in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
@@ -844,7 +844,7 @@ Keywords supported: :test :test-not :key :count :start :end :from-end
\(fn NEW OLD SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote substitute-if) "cl-seq" "\
+(autoload 'substitute-if "cl-seq" "\
Substitute NEW for all items satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
@@ -853,7 +853,7 @@ Keywords supported: :key :count :start :end :from-end
\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote substitute-if-not) "cl-seq" "\
+(autoload 'substitute-if-not "cl-seq" "\
Substitute NEW for all items not satisfying PREDICATE in SEQ.
This is a non-destructive function; it makes a copy of SEQ if necessary
to avoid corrupting the original SEQ.
@@ -862,7 +862,7 @@ Keywords supported: :key :count :start :end :from-end
\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote nsubstitute) "cl-seq" "\
+(autoload 'nsubstitute "cl-seq" "\
Substitute NEW for OLD in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
@@ -870,7 +870,7 @@ Keywords supported: :test :test-not :key :count :start :end :from-end
\(fn NEW OLD SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote nsubstitute-if) "cl-seq" "\
+(autoload 'nsubstitute-if "cl-seq" "\
Substitute NEW for all items satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
@@ -878,7 +878,7 @@ Keywords supported: :key :count :start :end :from-end
\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote nsubstitute-if-not) "cl-seq" "\
+(autoload 'nsubstitute-if-not "cl-seq" "\
Substitute NEW for all items not satisfying PREDICATE in SEQ.
This is a destructive function; it reuses the storage of SEQ whenever possible.
@@ -886,7 +886,7 @@ Keywords supported: :key :count :start :end :from-end
\(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote find) "cl-seq" "\
+(autoload 'find "cl-seq" "\
Find the first occurrence of ITEM in SEQ.
Return the matching ITEM, or nil if not found.
@@ -894,7 +894,7 @@ Keywords supported: :test :test-not :key :start :end :from-end
\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote find-if) "cl-seq" "\
+(autoload 'find-if "cl-seq" "\
Find the first item satisfying PREDICATE in SEQ.
Return the matching item, or nil if not found.
@@ -902,7 +902,7 @@ Keywords supported: :key :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote find-if-not) "cl-seq" "\
+(autoload 'find-if-not "cl-seq" "\
Find the first item not satisfying PREDICATE in SEQ.
Return the matching item, or nil if not found.
@@ -910,7 +910,7 @@ Keywords supported: :key :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote position) "cl-seq" "\
+(autoload 'position "cl-seq" "\
Find the first occurrence of ITEM in SEQ.
Return the index of the matching item, or nil if not found.
@@ -918,7 +918,7 @@ Keywords supported: :test :test-not :key :start :end :from-end
\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote position-if) "cl-seq" "\
+(autoload 'position-if "cl-seq" "\
Find the first item satisfying PREDICATE in SEQ.
Return the index of the matching item, or nil if not found.
@@ -926,7 +926,7 @@ Keywords supported: :key :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote position-if-not) "cl-seq" "\
+(autoload 'position-if-not "cl-seq" "\
Find the first item not satisfying PREDICATE in SEQ.
Return the index of the matching item, or nil if not found.
@@ -934,28 +934,28 @@ Keywords supported: :key :start :end :from-end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote count) "cl-seq" "\
+(autoload 'count "cl-seq" "\
Count the number of occurrences of ITEM in SEQ.
Keywords supported: :test :test-not :key :start :end
\(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote count-if) "cl-seq" "\
+(autoload 'count-if "cl-seq" "\
Count the number of items satisfying PREDICATE in SEQ.
Keywords supported: :key :start :end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote count-if-not) "cl-seq" "\
+(autoload 'count-if-not "cl-seq" "\
Count the number of items not satisfying PREDICATE in SEQ.
Keywords supported: :key :start :end
\(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
-(autoload (quote mismatch) "cl-seq" "\
+(autoload 'mismatch "cl-seq" "\
Compare SEQ1 with SEQ2, return index of first mismatching element.
Return nil if the sequences match. If one sequence is a prefix of the
other, the return value indicates the end of the shorter sequence.
@@ -964,7 +964,7 @@ Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
\(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil)
-(autoload (quote search) "cl-seq" "\
+(autoload 'search "cl-seq" "\
Search for SEQ1 as a subsequence of SEQ2.
Return the index of the leftmost element of the first match found;
return nil if there are no matches.
@@ -973,7 +973,7 @@ Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
\(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil)
-(autoload (quote sort*) "cl-seq" "\
+(autoload 'sort* "cl-seq" "\
Sort the argument SEQ according to PREDICATE.
This is a destructive function; it reuses the storage of SEQ if possible.
@@ -981,7 +981,7 @@ Keywords supported: :key
\(fn SEQ PREDICATE [KEYWORD VALUE]...)" nil nil)
-(autoload (quote stable-sort) "cl-seq" "\
+(autoload 'stable-sort "cl-seq" "\
Sort the argument SEQ stably according to PREDICATE.
This is a destructive function; it reuses the storage of SEQ if possible.
@@ -989,7 +989,7 @@ Keywords supported: :key
\(fn SEQ PREDICATE [KEYWORD VALUE]...)" nil nil)
-(autoload (quote merge) "cl-seq" "\
+(autoload 'merge "cl-seq" "\
Destructively merge the two sequences to produce a new sequence.
TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument
sequences, and PREDICATE is a `less-than' predicate on the elements.
@@ -998,7 +998,7 @@ Keywords supported: :key
\(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)" nil nil)
-(autoload (quote member*) "cl-seq" "\
+(autoload 'member* "cl-seq" "\
Find the first occurrence of ITEM in LIST.
Return the sublist of LIST whose car is ITEM.
@@ -1006,7 +1006,7 @@ Keywords supported: :test :test-not :key
\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
-(autoload (quote member-if) "cl-seq" "\
+(autoload 'member-if "cl-seq" "\
Find the first item satisfying PREDICATE in LIST.
Return the sublist of LIST whose car matches.
@@ -1014,7 +1014,7 @@ Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload (quote member-if-not) "cl-seq" "\
+(autoload 'member-if-not "cl-seq" "\
Find the first item not satisfying PREDICATE in LIST.
Return the sublist of LIST whose car matches.
@@ -1022,54 +1022,54 @@ Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload (quote cl-adjoin) "cl-seq" "\
+(autoload 'cl-adjoin "cl-seq" "\
Not documented
\(fn CL-ITEM CL-LIST &rest CL-KEYS)" nil nil)
-(autoload (quote assoc*) "cl-seq" "\
+(autoload 'assoc* "cl-seq" "\
Find the first item whose car matches ITEM in LIST.
Keywords supported: :test :test-not :key
\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
-(autoload (quote assoc-if) "cl-seq" "\
+(autoload 'assoc-if "cl-seq" "\
Find the first item whose car satisfies PREDICATE in LIST.
Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload (quote assoc-if-not) "cl-seq" "\
+(autoload 'assoc-if-not "cl-seq" "\
Find the first item whose car does not satisfy PREDICATE in LIST.
Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload (quote rassoc*) "cl-seq" "\
+(autoload 'rassoc* "cl-seq" "\
Find the first item whose cdr matches ITEM in LIST.
Keywords supported: :test :test-not :key
\(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
-(autoload (quote rassoc-if) "cl-seq" "\
+(autoload 'rassoc-if "cl-seq" "\
Find the first item whose cdr satisfies PREDICATE in LIST.
Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload (quote rassoc-if-not) "cl-seq" "\
+(autoload 'rassoc-if-not "cl-seq" "\
Find the first item whose cdr does not satisfy PREDICATE in LIST.
Keywords supported: :key
\(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
-(autoload (quote union) "cl-seq" "\
+(autoload 'union "cl-seq" "\
Combine LIST1 and LIST2 using a set-union operation.
The result list contains all items that appear in either LIST1 or LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
@@ -1079,7 +1079,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload (quote nunion) "cl-seq" "\
+(autoload 'nunion "cl-seq" "\
Combine LIST1 and LIST2 using a set-union operation.
The result list contains all items that appear in either LIST1 or LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -1089,7 +1089,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload (quote intersection) "cl-seq" "\
+(autoload 'intersection "cl-seq" "\
Combine LIST1 and LIST2 using a set-intersection operation.
The result list contains all items that appear in both LIST1 and LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
@@ -1099,7 +1099,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload (quote nintersection) "cl-seq" "\
+(autoload 'nintersection "cl-seq" "\
Combine LIST1 and LIST2 using a set-intersection operation.
The result list contains all items that appear in both LIST1 and LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -1109,7 +1109,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload (quote set-difference) "cl-seq" "\
+(autoload 'set-difference "cl-seq" "\
Combine LIST1 and LIST2 using a set-difference operation.
The result list contains all items that appear in LIST1 but not LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
@@ -1119,7 +1119,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload (quote nset-difference) "cl-seq" "\
+(autoload 'nset-difference "cl-seq" "\
Combine LIST1 and LIST2 using a set-difference operation.
The result list contains all items that appear in LIST1 but not LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -1129,7 +1129,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload (quote set-exclusive-or) "cl-seq" "\
+(autoload 'set-exclusive-or "cl-seq" "\
Combine LIST1 and LIST2 using a set-exclusive-or operation.
The result list contains all items that appear in exactly one of LIST1, LIST2.
This is a non-destructive function; it makes a copy of the data if necessary
@@ -1139,7 +1139,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload (quote nset-exclusive-or) "cl-seq" "\
+(autoload 'nset-exclusive-or "cl-seq" "\
Combine LIST1 and LIST2 using a set-exclusive-or operation.
The result list contains all items that appear in exactly one of LIST1, LIST2.
This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -1149,7 +1149,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload (quote subsetp) "cl-seq" "\
+(autoload 'subsetp "cl-seq" "\
Return true if LIST1 is a subset of LIST2.
I.e., if every element of LIST1 also appears in LIST2.
@@ -1157,7 +1157,7 @@ Keywords supported: :test :test-not :key
\(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
-(autoload (quote subst-if) "cl-seq" "\
+(autoload 'subst-if "cl-seq" "\
Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
Return a copy of TREE with all matching elements replaced by NEW.
@@ -1165,7 +1165,7 @@ Keywords supported: :key
\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
-(autoload (quote subst-if-not) "cl-seq" "\
+(autoload 'subst-if-not "cl-seq" "\
Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
Return a copy of TREE with all non-matching elements replaced by NEW.
@@ -1173,7 +1173,7 @@ Keywords supported: :key
\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
-(autoload (quote nsubst) "cl-seq" "\
+(autoload 'nsubst "cl-seq" "\
Substitute NEW for OLD everywhere in TREE (destructively).
Any element of TREE which is `eql' to OLD is changed to NEW (via a call
to `setcar').
@@ -1182,7 +1182,7 @@ Keywords supported: :test :test-not :key
\(fn NEW OLD TREE [KEYWORD VALUE]...)" nil nil)
-(autoload (quote nsubst-if) "cl-seq" "\
+(autoload 'nsubst-if "cl-seq" "\
Substitute NEW for elements matching PREDICATE in TREE (destructively).
Any element of TREE which matches is changed to NEW (via a call to `setcar').
@@ -1190,7 +1190,7 @@ Keywords supported: :key
\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
-(autoload (quote nsubst-if-not) "cl-seq" "\
+(autoload 'nsubst-if-not "cl-seq" "\
Substitute NEW for elements not matching PREDICATE in TREE (destructively).
Any element of TREE which matches is changed to NEW (via a call to `setcar').
@@ -1198,7 +1198,7 @@ Keywords supported: :key
\(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
-(autoload (quote sublis) "cl-seq" "\
+(autoload 'sublis "cl-seq" "\
Perform substitutions indicated by ALIST in TREE (non-destructively).
Return a copy of TREE with all matching elements replaced.
@@ -1206,7 +1206,7 @@ Keywords supported: :test :test-not :key
\(fn ALIST TREE [KEYWORD VALUE]...)" nil nil)
-(autoload (quote nsublis) "cl-seq" "\
+(autoload 'nsublis "cl-seq" "\
Perform substitutions indicated by ALIST in TREE (destructively).
Any matching element of TREE is changed via a call to `setcar'.
@@ -1214,7 +1214,7 @@ Keywords supported: :test :test-not :key
\(fn ALIST TREE [KEYWORD VALUE]...)" nil nil)
-(autoload (quote tree-equal) "cl-seq" "\
+(autoload 'tree-equal "cl-seq" "\
Return t if trees TREE1 and TREE2 have `eql' leaves.
Atoms are compared by `eql'; cons cells are compared recursively.
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 8b55dd4a379..b99de0aac98 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1,4 +1,4 @@
-;;; cl-macs.el --- Common Lisp macros -*-byte-compile-dynamic: t;-*-
+;;; cl-macs.el --- Common Lisp macros
;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007
;; Free Software Foundation, Inc.
@@ -1554,15 +1554,11 @@ values. For compatibility, (values A B C) is a synonym for (list A B C).
byte-compile-delete-errors (nth 1 safety)))))
((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings))
- (if (eq byte-compile-warnings t)
- (setq byte-compile-warnings byte-compile-warning-types))
(while (setq spec (cdr spec))
(if (consp (car spec))
(if (eq (cadar spec) 0)
- (setq byte-compile-warnings
- (delq (caar spec) byte-compile-warnings))
- (setq byte-compile-warnings
- (adjoin (caar spec) byte-compile-warnings)))))))
+ (byte-compile-disable-warning (caar spec))
+ (byte-compile-enable-warning (caar spec)))))))
nil)
;;; Process any proclamations made before cl-macs was loaded.
@@ -2728,7 +2724,8 @@ surrounded by (block NAME ...).
(run-hooks 'cl-macs-load-hook)
;; Local variables:
-;; byte-compile-warnings: (redefine callargs free-vars unresolved obsolete noruntime)
+;; byte-compile-dynamic: t
+;; byte-compile-warnings: (not cl-functions)
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index 8016b75aad9..4669d69c872 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -1,4 +1,4 @@
-;;; cl-seq.el --- Common Lisp features, part 3 -*-byte-compile-dynamic: t;-*-
+;;; cl-seq.el --- Common Lisp features, part 3
;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007 Free Software Foundation, Inc.
@@ -1020,6 +1020,8 @@ Atoms are compared by `eql'; cons cells are compared recursively.
(run-hooks 'cl-seq-load-hook)
;; Local variables:
+;; byte-compile-dynamic: t
+;; byte-compile-warnings: (not cl-functions)
;; generated-autoload-file: "cl-loaddefs.el"
;; End:
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 8d609509f10..c8a029a453a 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -1,4 +1,4 @@
-;;; cl.el --- Common Lisp extensions for Emacs -*-byte-compile-dynamic: t;-*-
+;;; cl.el --- Common Lisp extensions for Emacs
;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007 Free Software Foundation, Inc.
@@ -109,9 +109,11 @@ printer proceeds to the next function on the list.
This variable is not used at present, but it is defined in hopes that
a future Emacs interpreter will be able to use it.")
-(add-hook 'cl-unload-hook 'cl-cannot-unload)
-(defun cl-cannot-unload ()
- (error "Cannot unload the feature `cl'"))
+(defun cl-unload-function ()
+ "Stop unloading of the Common Lisp extensions."
+ (message "Cannot unload the feature `cl'")
+ ;; stop standard unloading!
+ t)
;;; Generalized variables.
;; These macros are defined here so that they
@@ -658,5 +660,10 @@ If ALIST is non-nil, the new pairs are prepended to it."
(run-hooks 'cl-load-hook)
+;; Local variables:
+;; byte-compile-dynamic: t
+;; byte-compile-warnings: (not cl-functions)
+;; End:
+
;; arch-tag: 5f07fa74-f153-4524-9303-21f5be125851
;;; cl.el ends here
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index ade2a23608d..c4ba3e4ca9c 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -147,16 +147,16 @@ Results are displayed with the `elp-results' command."
:group 'elp)
(defcustom elp-sort-by-function 'elp-sort-by-total-time
- "*Non-nil specifies elp results sorting function.
+ "*Non-nil specifies ELP results sorting function.
These functions are currently available:
elp-sort-by-call-count -- sort by the highest call count
elp-sort-by-total-time -- sort by the highest total time
elp-sort-by-average-time -- sort by the highest average times
-You can write you're own sort function. It should adhere to the
-interface specified by the PRED argument for the `sort' defun. Each
-\"element of LIST\" is really a 4 element vector where element 0 is
+You can write your own sort function. It should adhere to the
+interface specified by the PREDICATE argument for `sort'.
+Each \"element of LIST\" is really a 4 element vector where element 0 is
the call count, element 1 is the total time spent in the function,
element 2 is the average time spent in the function, and element 3 is
the symbol's name string."
@@ -164,7 +164,7 @@ the symbol's name string."
:group 'elp)
(defcustom elp-report-limit 1
- "*Prevents some functions from being displayed in the results buffer.
+ "*Prevent some functions from being displayed in the results buffer.
If a number, no function that has been called fewer than that number
of times will be displayed in the output buffer. If nil, all
functions will be displayed."
@@ -173,12 +173,12 @@ functions will be displayed."
:group 'elp)
(defcustom elp-use-standard-output nil
- "*Non-nil says to output to `standard-output' instead of a buffer."
+ "*If non-nil, output to `standard-output' instead of a buffer."
:type 'boolean
:group 'elp)
(defcustom elp-recycle-buffers-p t
- "*nil says to not recycle the `elp-results-buffer'.
+ "*If nil, don't recycle the `elp-results-buffer'.
In other words, a new unique buffer is create every time you run
\\[elp-results]."
:type 'boolean
@@ -372,7 +372,7 @@ Use optional LIST if provided instead."
(mapcar 'elp-restore-function list)))
(defun elp-restore-all ()
- "Restores the original definitions of all functions being profiled."
+ "Restore the original definitions of all functions being profiled."
(interactive)
(elp-restore-list elp-all-instrumented-list))
@@ -412,7 +412,7 @@ Use optional LIST if provided instead."
(elp-instrument-function funsym)))
(defun elp-unset-master ()
- "Unsets the master function."
+ "Unset the master function."
(interactive)
;; when there's no master function, recording is turned on by default.
(setq elp-master nil
@@ -558,7 +558,7 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
(defun elp-results ()
"Display current profiling results.
If `elp-reset-after-results' is non-nil, then current profiling
-information for all instrumented functions are reset after results are
+information for all instrumented functions is reset after results are
displayed."
(interactive)
(let ((curbuf (current-buffer))
@@ -626,9 +626,11 @@ displayed."
(and elp-reset-after-results
(elp-reset-all))))
-(defun elp-unload-hook ()
- (elp-restore-all))
-(add-hook 'elp-unload-hook 'elp-unload-hook)
+(defun elp-unload-function ()
+ "Unload the Emacs Lisp Profiler."
+ (elp-restore-all)
+ ;; continue standard unloading
+ nil)
(provide 'elp)
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 20b91b10547..b3c7c339030 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -192,11 +192,21 @@ TYPE should be nil to find a function, or `defvar' to find a variable."
(defun find-library (library)
"Find the elisp source of LIBRARY."
(interactive
- (list
- (completing-read "Library name: "
- 'locate-file-completion
- (cons (or find-function-source-path load-path)
- (find-library-suffixes)))))
+ (let* ((path (cons (or find-function-source-path load-path)
+ (find-library-suffixes)))
+ (def (if (eq (function-called-at-point) 'require)
+ (save-excursion
+ (backward-up-list)
+ (forward-char)
+ (backward-sexp -2)
+ (thing-at-point 'symbol))
+ (thing-at-point 'symbol))))
+ (when def
+ (setq def (and (locate-file-completion def path 'test) def)))
+ (list
+ (completing-read (if def (format "Library name (default %s): " def)
+ "Library name: ")
+ 'locate-file-completion path nil nil nil def))))
(let ((buf (find-file-noselect (find-library-name library))))
(condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf)))))
diff --git a/lisp/emacs-lisp/lselect.el b/lisp/emacs-lisp/lselect.el
deleted file mode 100644
index 54926a3844e..00000000000
--- a/lisp/emacs-lisp/lselect.el
+++ /dev/null
@@ -1,242 +0,0 @@
-;;; lselect.el --- Lucid interface to X Selections
-
-;; Copyright (C) 1990, 1993, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: emulations
-
-;; This won't completely work until we support or emulate Lucid-style extents.
-;; Based on Lucid's selection code.
-
-;; 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:
-
-;;; Code:
-
-;; The selection code requires us to use certain symbols whose names are
-;; all upper-case; this may seem tasteless, but it makes there be a 1:1
-;; correspondence between these symbols and X Atoms (which are upcased.)
-
-;; This is Lucid/XEmacs stuff
-(defvar mouse-highlight-priority)
-(defvar x-lost-selection-functions)
-(defvar zmacs-regions)
-
-(defalias 'x-get-cutbuffer 'x-get-cut-buffer)
-(defalias 'x-store-cutbuffer 'x-set-cut-buffer)
-
-(or (facep 'primary-selection)
- (make-face 'primary-selection))
-
-(or (facep 'secondary-selection)
- (make-face 'secondary-selection))
-
-(defun x-get-secondary-selection ()
- "Return text selected from some X window."
- (x-get-selection-internal 'SECONDARY 'STRING))
-
-(defvar primary-selection-extent nil
- "The extent of the primary selection; don't use this.")
-
-(defvar secondary-selection-extent nil
- "The extent of the secondary selection; don't use this.")
-
-
-(defun x-select-make-extent-for-selection (selection previous-extent face)
- ;; Given a selection, this makes an extent in the buffer which holds that
- ;; selection, for highlighting purposes. If the selection isn't associated
- ;; with a buffer, this does nothing.
- (let ((buffer nil)
- (valid (and (extentp previous-extent)
- (extent-buffer previous-extent)
- (buffer-name (extent-buffer previous-extent))))
- start end)
- (cond ((stringp selection)
- ;; if we're selecting a string, lose the previous extent used
- ;; to highlight the selection.
- (setq valid nil))
- ((consp selection)
- (setq start (min (car selection) (cdr selection))
- end (max (car selection) (cdr selection))
- valid (and valid
- (eq (marker-buffer (car selection))
- (extent-buffer previous-extent)))
- buffer (marker-buffer (car selection))))
- ((extentp selection)
- (setq start (extent-start-position selection)
- end (extent-end-position selection)
- valid (and valid
- (eq (extent-buffer selection)
- (extent-buffer previous-extent)))
- buffer (extent-buffer selection)))
- )
- (if (and (not valid)
- (extentp previous-extent)
- (extent-buffer previous-extent)
- (buffer-name (extent-buffer previous-extent)))
- (delete-extent previous-extent))
- (if (not buffer)
- ;; string case
- nil
- ;; normal case
- (if valid
- (set-extent-endpoints previous-extent start end)
- (setq previous-extent (make-extent start end buffer))
- ;; use same priority as mouse-highlighting so that conflicts between
- ;; the selection extent and a mouse-highlighted extent are resolved
- ;; by the usual size-and-endpoint-comparison method.
- (set-extent-priority previous-extent mouse-highlight-priority)
- (set-extent-face previous-extent face)))))
-
-
-(defun x-own-selection (selection &optional type)
- "Make a primary X Selection of the given argument.
-The argument may be a string, a cons of two markers, or an extent.
-In the latter cases the selection is considered to be the text
-between the markers, or the between extents endpoints."
- (interactive (if (not current-prefix-arg)
- (list (read-string "Store text for pasting: "))
- (list (cons ;; these need not be ordered.
- (copy-marker (point-marker))
- (copy-marker (mark-marker))))))
- (or type (setq type 'PRIMARY))
- (x-set-selection selection type)
- (cond ((eq type 'PRIMARY)
- (setq primary-selection-extent
- (x-select-make-extent-for-selection
- selection primary-selection-extent 'primary-selection)))
- ((eq type 'SECONDARY)
- (setq secondary-selection-extent
- (x-select-make-extent-for-selection
- selection secondary-selection-extent 'secondary-selection))))
- selection)
-
-
-(defun x-own-secondary-selection (selection &optional type)
- "Make a secondary X Selection of the given argument. The argument may be a
-string or a cons of two markers (in which case the selection is considered to
-be the text between those markers.)"
- (interactive (if (not current-prefix-arg)
- (list (read-string "Store text for pasting: "))
- (list (cons ;; these need not be ordered.
- (copy-marker (point-marker))
- (copy-marker (mark-marker))))))
- (x-own-selection selection 'SECONDARY))
-
-
-(defun x-own-clipboard (string)
- "Paste the given string to the X Clipboard."
- (x-own-selection string 'CLIPBOARD))
-
-
-(defun x-disown-selection (&optional secondary-p)
- "Assuming we own the selection, disown it. With an argument, discard the
-secondary selection instead of the primary selection."
- (x-disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY)))
-
-(defun x-dehilight-selection (selection)
- "for use as a value of `x-lost-selection-functions'."
- (cond ((eq selection 'PRIMARY)
- (if primary-selection-extent
- (let ((inhibit-quit t))
- (delete-extent primary-selection-extent)
- (setq primary-selection-extent nil)))
- (if zmacs-regions (zmacs-deactivate-region)))
- ((eq selection 'SECONDARY)
- (if secondary-selection-extent
- (let ((inhibit-quit t))
- (delete-extent secondary-selection-extent)
- (setq secondary-selection-extent nil)))))
- nil)
-
-(setq x-lost-selection-functions 'x-dehilight-selection)
-
-(defun x-notice-selection-requests (selection type successful)
- "for possible use as the value of `x-sent-selection-functions'."
- (if (not successful)
- (message "Selection request failed to convert %s to %s"
- selection type)
- (message "Sent selection %s as %s" selection type)))
-
-(defun x-notice-selection-failures (selection type successful)
- "for possible use as the value of `x-sent-selection-functions'."
- (or successful
- (message "Selection request failed to convert %s to %s"
- selection type)))
-
-;(setq x-sent-selection-functions 'x-notice-selection-requests)
-;(setq x-sent-selection-functions 'x-notice-selection-failures)
-
-
-;; Random utility functions
-
-(defun x-kill-primary-selection ()
- "If there is a selection, delete the text it covers, and copy it to
-both the kill ring and the Clipboard."
- (interactive)
- (or (x-selection-owner-p) (error "Emacs does not own the primary selection"))
- (setq last-command nil)
- (or primary-selection-extent
- (error "the primary selection is not an extent?"))
- (save-excursion
- (set-buffer (extent-buffer primary-selection-extent))
- (kill-region (extent-start-position primary-selection-extent)
- (extent-end-position primary-selection-extent)))
- (x-disown-selection nil))
-
-(defun x-delete-primary-selection ()
- "If there is a selection, delete the text it covers *without* copying it to
-the kill ring or the Clipboard."
- (interactive)
- (or (x-selection-owner-p) (error "Emacs does not own the primary selection"))
- (setq last-command nil)
- (or primary-selection-extent
- (error "the primary selection is not an extent?"))
- (save-excursion
- (set-buffer (extent-buffer primary-selection-extent))
- (delete-region (extent-start-position primary-selection-extent)
- (extent-end-position primary-selection-extent)))
- (x-disown-selection nil))
-
-(defun x-copy-primary-selection ()
- "If there is a selection, copy it to both the kill ring and the Clipboard."
- (interactive)
- (setq last-command nil)
- (or (x-selection-owner-p) (error "Emacs does not own the primary selection"))
- (or primary-selection-extent
- (error "the primary selection is not an extent?"))
- (save-excursion
- (set-buffer (extent-buffer primary-selection-extent))
- (copy-region-as-kill (extent-start-position primary-selection-extent)
- (extent-end-position primary-selection-extent))))
-
-(defun x-yank-clipboard-selection ()
- "If someone owns a Clipboard selection, insert it at point."
- (interactive)
- (setq last-command nil)
- (let ((clip (x-get-clipboard)))
- (or clip (error "there is no clipboard selection"))
- (push-mark)
- (insert clip)))
-
-(provide 'lselect)
-
-;; arch-tag: 92fa54d4-c5d1-4e9b-ad58-cf1e13930556
-;;; lselect.el ends here
diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el
index d7dd1f19300..3bb93334c3c 100644
--- a/lisp/emacs-lisp/unsafep.el
+++ b/lisp/emacs-lisp/unsafep.el
@@ -116,9 +116,9 @@ in the parse.")
;;;###autoload
(defun unsafep (form &optional unsafep-vars)
- "Return nil if evaluating FORM couldn't possibly do any harm;
-otherwise result is a reason why FORM is unsafe. UNSAFEP-VARS is a list
-of symbols with local bindings."
+ "Return nil if evaluating FORM couldn't possibly do any harm.
+Otherwise result is a reason why FORM is unsafe.
+UNSAFEP-VARS is a list of symbols with local bindings."
(catch 'unsafep
(if (or (eq safe-functions t) ;User turned off safety-checking
(atom form)) ;Atoms are never unsafe
@@ -213,8 +213,8 @@ of symbols with local bindings."
(defun unsafep-function (fun)
"Return nil if FUN is a safe function.
-\(either a safe lambda or a symbol that names a safe function). Otherwise
-result is a reason code."
+\(Either a safe lambda or a symbol that names a safe function).
+Otherwise result is a reason code."
(cond
((eq (car-safe fun) 'lambda)
(unsafep fun unsafep-vars))
@@ -226,8 +226,8 @@ result is a reason code."
`(function ,fun))))
(defun unsafep-progn (list)
- "Return nil if all forms in LIST are safe, or the reason
-for the first unsafe form."
+ "Return nil if all forms in LIST are safe.
+Else, return the reason for the first unsafe form."
(catch 'unsafep-progn
(let (reason)
(dolist (x list)
@@ -236,8 +236,9 @@ for the first unsafe form."
(defun unsafep-let (clause)
"Check the safety of a let binding.
-CLAUSE is a let-binding, either SYM or (SYM) or (SYM VAL). Checks VAL
-and throws a reason to `unsafep' if unsafe. Returns SYM."
+CLAUSE is a let-binding, either SYM or (SYM) or (SYM VAL).
+Check VAL and throw a reason to `unsafep' if unsafe.
+Return SYM."
(let (reason sym)
(if (atom clause)
(setq sym clause)
View Lorry Controller Status