diff options
| author | Stefan Monnier | 2015-02-05 14:44:26 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2015-02-05 14:44:26 -0500 |
| commit | f06902840eff62e83858a40b4e139b61d254107a (patch) | |
| tree | f8d32fef0bd1110338b31d32d4d762ccf36ec628 | |
| parent | 55eb72816b32f5a869e843036fb122065c1ed56f (diff) | |
| parent | 72229f17ef6609e570e89a1ae86ed80a544e79e8 (diff) | |
| download | emacs-f06902840eff62e83858a40b4e139b61d254107a.tar.gz emacs-f06902840eff62e83858a40b4e139b61d254107a.zip | |
Merge branch 'dynamic-docstrings' into trunk
| -rw-r--r-- | etc/NEWS | 4 | ||||
| -rw-r--r-- | lisp/ChangeLog | 29 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 59 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cconv.el | 31 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-base.el | 3 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-compat.el | 7 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-core.el | 43 | ||||
| -rw-r--r-- | src/ChangeLog | 5 | ||||
| -rw-r--r-- | src/eval.c | 22 |
9 files changed, 141 insertions, 62 deletions
| @@ -599,6 +599,10 @@ in languages like German where downcasing rules depend on grammar. | |||
| 599 | 599 | ||
| 600 | * Lisp Changes in Emacs 25.1 | 600 | * Lisp Changes in Emacs 25.1 |
| 601 | 601 | ||
| 602 | ** lexical closures can use (:documentation <form>) to build their docstring. | ||
| 603 | It should be placed right where the docstring would be, and <form> is then | ||
| 604 | evaluated (and should return a string) when the closure is built. | ||
| 605 | |||
| 602 | ** define-inline provides a new way to define inlinable functions. | 606 | ** define-inline provides a new way to define inlinable functions. |
| 603 | 607 | ||
| 604 | ** New function macroexpand-1 to perform a single step of macroexpansion. | 608 | ** New function macroexpand-1 to perform a single step of macroexpansion. |
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 92026c7c10e..a1e43e14c7b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -10,6 +10,35 @@ | |||
| 10 | 10 | ||
| 11 | 2015-02-05 Stefan Monnier <monnier@iro.umontreal.ca> | 11 | 2015-02-05 Stefan Monnier <monnier@iro.umontreal.ca> |
| 12 | 12 | ||
| 13 | * emacs-lisp/eieio-compat.el (eieio--defmethod): Use new | ||
| 14 | special (:documentation ...) feature. | ||
| 15 | * emacs-lisp/eieio-core.el (eieio-make-class-predicate) | ||
| 16 | (eieio-make-child-predicate): Same. | ||
| 17 | (eieio-copy-parents-into-subclass): Remove unused arg. | ||
| 18 | (eieio-defclass-internal): Adjust call accordingly and remove redundant | ||
| 19 | `pname' var. | ||
| 20 | (eieio--slot-name-index): Remove unused arg `obj' and adjust all | ||
| 21 | callers accordingly. | ||
| 22 | |||
| 23 | * emacs-lisp/cconv.el (cconv--convert-function): | ||
| 24 | Add `docstring' argument. | ||
| 25 | (cconv-convert): Use it to handle the new (:documentation ...) form. | ||
| 26 | (cconv-analyze-form): Handle the new (:documentation ...) form. | ||
| 27 | |||
| 28 | * emacs-lisp/bytecomp.el: | ||
| 29 | (byte-compile-initial-macro-environment): Use macroexp-progn. | ||
| 30 | (byte-compile-cl-warn): Don't silence use of cl-macroexpand-all. | ||
| 31 | (byte-compile-file-form-defvar-function): Rename from | ||
| 32 | byte-compile-file-form-define-abbrev-table. | ||
| 33 | (defvaralias, byte-compile-file-form-custom-declare-variable): Use it. | ||
| 34 | (byte-compile): Use byte-compile-top-level rather than | ||
| 35 | byte-compile-lambda so we can compile non-values. | ||
| 36 | (byte-compile-form): Add warnings for failed uses of lexical vars via | ||
| 37 | quoted symbols. | ||
| 38 | (byte-compile-unfold-bcf): Improve message for failed inlining. | ||
| 39 | (byte-compile-make-closure): Handle new format of internal-make-closure | ||
| 40 | for dynamically-generated docstrings. | ||
| 41 | |||
| 13 | * delsel.el: Deprecate the `kill' option. Use lexical-binding. | 42 | * delsel.el: Deprecate the `kill' option. Use lexical-binding. |
| 14 | (open-line): Delete like all other commands, instead of killing. | 43 | (open-line): Delete like all other commands, instead of killing. |
| 15 | (delete-active-region): Don't define any return any value. | 44 | (delete-active-region): Don't define any return any value. |
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2bd8d07851b..548aaa9626b 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -31,6 +31,10 @@ | |||
| 31 | ;; faster. [`LAP' == `Lisp Assembly Program'.] | 31 | ;; faster. [`LAP' == `Lisp Assembly Program'.] |
| 32 | ;; The user entry points are byte-compile-file and byte-recompile-directory. | 32 | ;; The user entry points are byte-compile-file and byte-recompile-directory. |
| 33 | 33 | ||
| 34 | ;;; Todo: | ||
| 35 | |||
| 36 | ;; - Turn "not bound at runtime" functions into autoloads. | ||
| 37 | |||
| 34 | ;;; Code: | 38 | ;;; Code: |
| 35 | 39 | ||
| 36 | ;; ======================================================================== | 40 | ;; ======================================================================== |
| @@ -450,7 +454,7 @@ Return the compile-time value of FORM." | |||
| 450 | (eval-when-compile . ,(lambda (&rest body) | 454 | (eval-when-compile . ,(lambda (&rest body) |
| 451 | (let ((result nil)) | 455 | (let ((result nil)) |
| 452 | (byte-compile-recurse-toplevel | 456 | (byte-compile-recurse-toplevel |
| 453 | (cons 'progn body) | 457 | (macroexp-progn body) |
| 454 | (lambda (form) | 458 | (lambda (form) |
| 455 | (setf result | 459 | (setf result |
| 456 | (byte-compile-eval | 460 | (byte-compile-eval |
| @@ -459,7 +463,7 @@ Return the compile-time value of FORM." | |||
| 459 | (list 'quote result)))) | 463 | (list 'quote result)))) |
| 460 | (eval-and-compile . ,(lambda (&rest body) | 464 | (eval-and-compile . ,(lambda (&rest body) |
| 461 | (byte-compile-recurse-toplevel | 465 | (byte-compile-recurse-toplevel |
| 462 | (cons 'progn body) | 466 | (macroexp-progn body) |
| 463 | (lambda (form) | 467 | (lambda (form) |
| 464 | ;; Don't compile here, since we don't know | 468 | ;; Don't compile here, since we don't know |
| 465 | ;; whether to compile as byte-compile-form | 469 | ;; whether to compile as byte-compile-form |
| @@ -1458,7 +1462,7 @@ extra args." | |||
| 1458 | ;; These would sometimes be warned about | 1462 | ;; These would sometimes be warned about |
| 1459 | ;; but such warnings are never useful, | 1463 | ;; but such warnings are never useful, |
| 1460 | ;; so don't warn about them. | 1464 | ;; so don't warn about them. |
| 1461 | macroexpand cl-macroexpand-all | 1465 | macroexpand |
| 1462 | cl--compiling-file)))) | 1466 | cl--compiling-file)))) |
| 1463 | (byte-compile-warn "function `%s' from cl package called at runtime" | 1467 | (byte-compile-warn "function `%s' from cl package called at runtime" |
| 1464 | func))) | 1468 | func))) |
| @@ -2319,10 +2323,12 @@ list that represents a doc string reference. | |||
| 2319 | form)) | 2323 | form)) |
| 2320 | 2324 | ||
| 2321 | (put 'define-abbrev-table 'byte-hunk-handler | 2325 | (put 'define-abbrev-table 'byte-hunk-handler |
| 2322 | 'byte-compile-file-form-define-abbrev-table) | 2326 | 'byte-compile-file-form-defvar-function) |
| 2323 | (defun byte-compile-file-form-define-abbrev-table (form) | 2327 | (put 'defvaralias 'byte-hunk-handler 'byte-compile-file-form-defvar-function) |
| 2324 | (if (eq 'quote (car-safe (car-safe (cdr form)))) | 2328 | |
| 2325 | (byte-compile--declare-var (car-safe (cdr (cadr form))))) | 2329 | (defun byte-compile-file-form-defvar-function (form) |
| 2330 | (pcase-let (((or `',name (let name nil)) (nth 1 form))) | ||
| 2331 | (if name (byte-compile--declare-var name))) | ||
| 2326 | (byte-compile-keep-pending form)) | 2332 | (byte-compile-keep-pending form)) |
| 2327 | 2333 | ||
| 2328 | (put 'custom-declare-variable 'byte-hunk-handler | 2334 | (put 'custom-declare-variable 'byte-hunk-handler |
| @@ -2330,8 +2336,7 @@ list that represents a doc string reference. | |||
| 2330 | (defun byte-compile-file-form-custom-declare-variable (form) | 2336 | (defun byte-compile-file-form-custom-declare-variable (form) |
| 2331 | (when (byte-compile-warning-enabled-p 'callargs) | 2337 | (when (byte-compile-warning-enabled-p 'callargs) |
| 2332 | (byte-compile-nogroup-warn form)) | 2338 | (byte-compile-nogroup-warn form)) |
| 2333 | (byte-compile--declare-var (nth 1 (nth 1 form))) | 2339 | (byte-compile-file-form-defvar-function form)) |
| 2334 | (byte-compile-keep-pending form)) | ||
| 2335 | 2340 | ||
| 2336 | (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) | 2341 | (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) |
| 2337 | (defun byte-compile-file-form-require (form) | 2342 | (defun byte-compile-file-form-require (form) |
| @@ -2580,17 +2585,11 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2580 | fun) | 2585 | fun) |
| 2581 | (t | 2586 | (t |
| 2582 | (when (symbolp form) | 2587 | (when (symbolp form) |
| 2583 | (unless (memq (car-safe fun) '(closure lambda)) | ||
| 2584 | (error "Don't know how to compile %S" fun)) | ||
| 2585 | (setq lexical-binding (eq (car fun) 'closure)) | 2588 | (setq lexical-binding (eq (car fun) 'closure)) |
| 2586 | (setq fun (byte-compile--reify-function fun))) | 2589 | (setq fun (byte-compile--reify-function fun))) |
| 2587 | (unless (eq (car-safe fun) 'lambda) | ||
| 2588 | (error "Don't know how to compile %S" fun)) | ||
| 2589 | ;; Expand macros. | 2590 | ;; Expand macros. |
| 2590 | (setq fun (byte-compile-preprocess fun)) | 2591 | (setq fun (byte-compile-preprocess fun)) |
| 2591 | ;; Get rid of the `function' quote added by the `lambda' macro. | 2592 | (setq fun (byte-compile-top-level fun nil 'eval)) |
| 2592 | (if (eq (car-safe fun) 'function) (setq fun (cadr fun))) | ||
| 2593 | (setq fun (byte-compile-lambda fun)) | ||
| 2594 | (if macro (push 'macro fun)) | 2593 | (if macro (push 'macro fun)) |
| 2595 | (if (symbolp form) | 2594 | (if (symbolp form) |
| 2596 | (fset form fun) | 2595 | (fset form fun) |
| @@ -2966,6 +2965,16 @@ for symbols generated by the byte compiler itself." | |||
| 2966 | (interactive-only | 2965 | (interactive-only |
| 2967 | (or (get fn 'interactive-only) | 2966 | (or (get fn 'interactive-only) |
| 2968 | (memq fn byte-compile-interactive-only-functions)))) | 2967 | (memq fn byte-compile-interactive-only-functions)))) |
| 2968 | (when (memq fn '(set symbol-value run-hooks ;; add-to-list | ||
| 2969 | add-hook remove-hook run-hook-with-args | ||
| 2970 | run-hook-with-args-until-success | ||
| 2971 | run-hook-with-args-until-failure)) | ||
| 2972 | (pcase (cdr form) | ||
| 2973 | (`(',var . ,_) | ||
| 2974 | (when (assq var byte-compile-lexical-variables) | ||
| 2975 | (byte-compile-log-warning | ||
| 2976 | (format "%s cannot use lexical var `%s'" fn var) | ||
| 2977 | nil :error))))) | ||
| 2969 | (when (macroexp--const-symbol-p fn) | 2978 | (when (macroexp--const-symbol-p fn) |
| 2970 | (byte-compile-warn "`%s' called as a function" fn)) | 2979 | (byte-compile-warn "`%s' called as a function" fn)) |
| 2971 | (when (and (byte-compile-warning-enabled-p 'interactive-only) | 2980 | (when (and (byte-compile-warning-enabled-p 'interactive-only) |
| @@ -3079,8 +3088,9 @@ for symbols generated by the byte compiler itself." | |||
| 3079 | (dotimes (_ (- (/ (1+ fmax2) 2) alen)) | 3088 | (dotimes (_ (- (/ (1+ fmax2) 2) alen)) |
| 3080 | (byte-compile-push-constant nil))) | 3089 | (byte-compile-push-constant nil))) |
| 3081 | ((zerop (logand fmax2 1)) | 3090 | ((zerop (logand fmax2 1)) |
| 3082 | (byte-compile-log-warning "Too many arguments for inlined function" | 3091 | (byte-compile-log-warning |
| 3083 | nil :error) | 3092 | (format "Too many arguments for inlined function %S" form) |
| 3093 | nil :error) | ||
| 3084 | (byte-compile-discard (- alen (/ fmax2 2)))) | 3094 | (byte-compile-discard (- alen (/ fmax2 2)))) |
| 3085 | (t | 3095 | (t |
| 3086 | ;; Turn &rest args into a list. | 3096 | ;; Turn &rest args into a list. |
| @@ -3453,15 +3463,22 @@ discarding." | |||
| 3453 | (if byte-compile--for-effect (setq byte-compile--for-effect nil) | 3463 | (if byte-compile--for-effect (setq byte-compile--for-effect nil) |
| 3454 | (let* ((vars (nth 1 form)) | 3464 | (let* ((vars (nth 1 form)) |
| 3455 | (env (nth 2 form)) | 3465 | (env (nth 2 form)) |
| 3456 | (body (nthcdr 3 form)) | 3466 | (docstring-exp (nth 3 form)) |
| 3467 | (body (nthcdr 4 form)) | ||
| 3457 | (fun | 3468 | (fun |
| 3458 | (byte-compile-lambda `(lambda ,vars . ,body) nil (length env)))) | 3469 | (byte-compile-lambda `(lambda ,vars . ,body) nil (length env)))) |
| 3459 | (cl-assert (> (length env) 0)) ;Otherwise, we don't need a closure. | 3470 | (cl-assert (or (> (length env) 0) |
| 3471 | docstring-exp)) ;Otherwise, we don't need a closure. | ||
| 3460 | (cl-assert (byte-code-function-p fun)) | 3472 | (cl-assert (byte-code-function-p fun)) |
| 3461 | (byte-compile-form `(make-byte-code | 3473 | (byte-compile-form `(make-byte-code |
| 3462 | ',(aref fun 0) ',(aref fun 1) | 3474 | ',(aref fun 0) ',(aref fun 1) |
| 3463 | (vconcat (vector . ,env) ',(aref fun 2)) | 3475 | (vconcat (vector . ,env) ',(aref fun 2)) |
| 3464 | ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun))))))) | 3476 | ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun)))) |
| 3477 | (if docstring-exp | ||
| 3478 | `(,(car rest) | ||
| 3479 | ,docstring-exp | ||
| 3480 | ,@(cddr rest)) | ||
| 3481 | rest))))))) | ||
| 3465 | 3482 | ||
| 3466 | (defun byte-compile-get-closed-var (form) | 3483 | (defun byte-compile-get-closed-var (form) |
| 3467 | "Byte-compile the special `internal-get-closed-var' form." | 3484 | "Byte-compile the special `internal-get-closed-var' form." |
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index e9d33e6c646..fa824075933 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el | |||
| @@ -48,7 +48,7 @@ | |||
| 48 | ;; if the function is suitable for lambda lifting (if all calls are known) | 48 | ;; if the function is suitable for lambda lifting (if all calls are known) |
| 49 | ;; | 49 | ;; |
| 50 | ;; (lambda (v0 ...) ... fv0 .. fv1 ...) => | 50 | ;; (lambda (v0 ...) ... fv0 .. fv1 ...) => |
| 51 | ;; (internal-make-closure (v0 ...) (fv1 ...) | 51 | ;; (internal-make-closure (v0 ...) (fv0 ...) <doc> |
| 52 | ;; ... (internal-get-closed-var 0) ... (internal-get-closed-var 1) ...) | 52 | ;; ... (internal-get-closed-var 0) ... (internal-get-closed-var 1) ...) |
| 53 | ;; | 53 | ;; |
| 54 | ;; If the function has no free variables, we don't do anything. | 54 | ;; If the function has no free variables, we don't do anything. |
| @@ -65,6 +65,14 @@ | |||
| 65 | ;; | 65 | ;; |
| 66 | ;;; Code: | 66 | ;;; Code: |
| 67 | 67 | ||
| 68 | ;; PROBLEM cases found during conversion to lexical binding. | ||
| 69 | ;; We should try and detect and warn about those cases, even | ||
| 70 | ;; for lexical-binding==nil to help prepare the migration. | ||
| 71 | ;; - Uses of run-hooks, and friends. | ||
| 72 | ;; - Cases where we want to apply the same code to different vars depending on | ||
| 73 | ;; some test. These sometimes use a (let ((foo (if bar 'a 'b))) | ||
| 74 | ;; ... (symbol-value foo) ... (set foo ...)). | ||
| 75 | |||
| 68 | ;; TODO: (not just for cconv but also for the lexbind changes in general) | 76 | ;; TODO: (not just for cconv but also for the lexbind changes in general) |
| 69 | ;; - let (e)debug find the value of lexical variables from the stack. | 77 | ;; - let (e)debug find the value of lexical variables from the stack. |
| 70 | ;; - make eval-region do the eval-sexp-add-defvars dance. | 78 | ;; - make eval-region do the eval-sexp-add-defvars dance. |
| @@ -87,9 +95,8 @@ | |||
| 87 | ;; the bytecomp only compiles it once. | 95 | ;; the bytecomp only compiles it once. |
| 88 | ;; - Since we know here when a variable is not mutated, we could pass that | 96 | ;; - Since we know here when a variable is not mutated, we could pass that |
| 89 | ;; info to the byte-compiler, e.g. by using a new `immutable-let'. | 97 | ;; info to the byte-compiler, e.g. by using a new `immutable-let'. |
| 90 | ;; - add tail-calls to bytecode.c and the byte compiler. | ||
| 91 | ;; - call known non-escaping functions with `goto' rather than `call'. | 98 | ;; - call known non-escaping functions with `goto' rather than `call'. |
| 92 | ;; - optimize mapcar to a while loop. | 99 | ;; - optimize mapc to a dolist loop. |
| 93 | 100 | ||
| 94 | ;; (defmacro dlet (binders &rest body) | 101 | ;; (defmacro dlet (binders &rest body) |
| 95 | ;; ;; Works in both lexical and non-lexical mode. | 102 | ;; ;; Works in both lexical and non-lexical mode. |
| @@ -195,7 +202,7 @@ Returns a form where all lambdas don't have any free variables." | |||
| 195 | (unless (memq (car b) s) (push b res))) | 202 | (unless (memq (car b) s) (push b res))) |
| 196 | (nreverse res))) | 203 | (nreverse res))) |
| 197 | 204 | ||
| 198 | (defun cconv--convert-function (args body env parentform) | 205 | (defun cconv--convert-function (args body env parentform &optional docstring) |
| 199 | (cl-assert (equal body (caar cconv-freevars-alist))) | 206 | (cl-assert (equal body (caar cconv-freevars-alist))) |
| 200 | (let* ((fvs (cdr (pop cconv-freevars-alist))) | 207 | (let* ((fvs (cdr (pop cconv-freevars-alist))) |
| 201 | (body-new '()) | 208 | (body-new '()) |
| @@ -240,11 +247,11 @@ Returns a form where all lambdas don't have any free variables." | |||
| 240 | `(,@(nreverse special-forms) (let ,letbind . ,body-new))))) | 247 | `(,@(nreverse special-forms) (let ,letbind . ,body-new))))) |
| 241 | 248 | ||
| 242 | (cond | 249 | (cond |
| 243 | ((null envector) ;if no freevars - do nothing | 250 | ((not (or envector docstring)) ;If no freevars - do nothing. |
| 244 | `(function (lambda ,args . ,body-new))) | 251 | `(function (lambda ,args . ,body-new))) |
| 245 | (t | 252 | (t |
| 246 | `(internal-make-closure | 253 | `(internal-make-closure |
| 247 | ,args ,envector . ,body-new))))) | 254 | ,args ,envector ,docstring . ,body-new))))) |
| 248 | 255 | ||
| 249 | (defun cconv-convert (form env extend) | 256 | (defun cconv-convert (form env extend) |
| 250 | ;; This function actually rewrites the tree. | 257 | ;; This function actually rewrites the tree. |
| @@ -407,7 +414,9 @@ places where they originally did not directly appear." | |||
| 407 | cond-forms))) | 414 | cond-forms))) |
| 408 | 415 | ||
| 409 | (`(function (lambda ,args . ,body) . ,_) | 416 | (`(function (lambda ,args . ,body) . ,_) |
| 410 | (cconv--convert-function args body env form)) | 417 | (let ((docstring (if (eq :documentation (car-safe (car body))) |
| 418 | (cconv-convert (cadr (pop body)) env extend)))) | ||
| 419 | (cconv--convert-function args body env form docstring))) | ||
| 411 | 420 | ||
| 412 | (`(internal-make-closure . ,_) | 421 | (`(internal-make-closure . ,_) |
| 413 | (byte-compile-report-error | 422 | (byte-compile-report-error |
| @@ -533,7 +542,7 @@ FORM is the parent form that binds this var." | |||
| 533 | ;; use = `(,binder ,read ,mutated ,captured ,called) | 542 | ;; use = `(,binder ,read ,mutated ,captured ,called) |
| 534 | (pcase vardata | 543 | (pcase vardata |
| 535 | (`(,_ nil nil nil nil) nil) | 544 | (`(,_ nil nil nil nil) nil) |
| 536 | (`((,(and (pred (lambda (var) (eq ?_ (aref (symbol-name var) 0)))) var) . ,_) | 545 | (`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_) |
| 537 | ,_ ,_ ,_ ,_) | 546 | ,_ ,_ ,_ ,_) |
| 538 | (byte-compile-log-warning | 547 | (byte-compile-log-warning |
| 539 | (format "%s `%S' not left unused" varkind var)))) | 548 | (format "%s `%S' not left unused" varkind var)))) |
| @@ -643,6 +652,8 @@ and updates the data stored in ENV." | |||
| 643 | (cconv--analyze-use vardata form "variable")))) | 652 | (cconv--analyze-use vardata form "variable")))) |
| 644 | 653 | ||
| 645 | (`(function (lambda ,vrs . ,body-forms)) | 654 | (`(function (lambda ,vrs . ,body-forms)) |
| 655 | (when (eq :documentation (car-safe (car body-forms))) | ||
| 656 | (cconv-analyze-form (cadr (pop body-forms)) env)) | ||
| 646 | (cconv--analyze-function vrs body-forms env form)) | 657 | (cconv--analyze-function vrs body-forms env form)) |
| 647 | 658 | ||
| 648 | (`(setq . ,forms) | 659 | (`(setq . ,forms) |
| @@ -665,6 +676,10 @@ and updates the data stored in ENV." | |||
| 665 | (dolist (forms cond-forms) | 676 | (dolist (forms cond-forms) |
| 666 | (dolist (form forms) (cconv-analyze-form form env)))) | 677 | (dolist (form forms) (cconv-analyze-form form env)))) |
| 667 | 678 | ||
| 679 | ;; ((and `(quote ,v . ,_) (guard (assq v env))) | ||
| 680 | ;; (byte-compile-log-warning | ||
| 681 | ;; (format "Possible confusion variable/symbol for `%S'" v))) | ||
| 682 | |||
| 668 | (`(quote . ,_) nil) ; quote form | 683 | (`(quote . ,_) nil) ; quote form |
| 669 | (`(function . ,_) nil) ; same as quote | 684 | (`(function . ,_) nil) ; same as quote |
| 670 | 685 | ||
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 46585ee76c6..fcf02b92736 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el | |||
| @@ -290,8 +290,7 @@ constructor functions are considered valid. | |||
| 290 | Second, any text properties will be stripped from strings." | 290 | Second, any text properties will be stripped from strings." |
| 291 | (cond ((consp proposed-value) | 291 | (cond ((consp proposed-value) |
| 292 | ;; Lists with something in them need special treatment. | 292 | ;; Lists with something in them need special treatment. |
| 293 | (let ((slot-idx (eieio--slot-name-index class | 293 | (let ((slot-idx (eieio--slot-name-index class slot)) |
| 294 | nil slot)) | ||
| 295 | (type nil) | 294 | (type nil) |
| 296 | (classtype nil)) | 295 | (classtype nil)) |
| 297 | (setq slot-idx (- slot-idx | 296 | (setq slot-idx (- slot-idx |
diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index fcca99d79d5..7468c040e10 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el | |||
| @@ -188,11 +188,10 @@ Summary: | |||
| 188 | (args (help-function-arglist code 'preserve-names)) | 188 | (args (help-function-arglist code 'preserve-names)) |
| 189 | (doc-only (if docstring | 189 | (doc-only (if docstring |
| 190 | (let ((split (help-split-fundoc docstring nil))) | 190 | (let ((split (help-split-fundoc docstring nil))) |
| 191 | (if split (cdr split) docstring)))) | 191 | (if split (cdr split) docstring))))) |
| 192 | (new-docstring (help-add-fundoc-usage doc-only | ||
| 193 | (cons 'cl-cnm args)))) | ||
| 194 | ;; FIXME: ¡Add new-docstring to those closures! | ||
| 195 | (lambda (cnm &rest args) | 192 | (lambda (cnm &rest args) |
| 193 | (:documentation | ||
| 194 | (help-add-fundoc-usage doc-only (cons 'cl-cnm args))) | ||
| 196 | (cl-letf (((symbol-function 'call-next-method) cnm) | 195 | (cl-letf (((symbol-function 'call-next-method) cnm) |
| 197 | ((symbol-function 'next-method-p) | 196 | ((symbol-function 'next-method-p) |
| 198 | (lambda () (cl--generic-isnot-nnm-p cnm)))) | 197 | (lambda () (cl--generic-isnot-nnm-p cnm)))) |
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 77d8c01388b..fa8fefa1df0 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el | |||
| @@ -288,16 +288,17 @@ It creates an autoload function for CNAME's constructor." | |||
| 288 | 288 | ||
| 289 | (defun eieio-make-class-predicate (class) | 289 | (defun eieio-make-class-predicate (class) |
| 290 | (lambda (obj) | 290 | (lambda (obj) |
| 291 | ;; (:docstring (format "Test OBJ to see if it's an object of type %S." | 291 | (:documentation |
| 292 | ;; class)) | 292 | (format "Return non-nil if OBJ is an object of type `%S'.\n\n(fn OBJ)" |
| 293 | class)) | ||
| 293 | (and (eieio-object-p obj) | 294 | (and (eieio-object-p obj) |
| 294 | (same-class-p obj class)))) | 295 | (same-class-p obj class)))) |
| 295 | 296 | ||
| 296 | (defun eieio-make-child-predicate (class) | 297 | (defun eieio-make-child-predicate (class) |
| 297 | (lambda (obj) | 298 | (lambda (obj) |
| 298 | ;; (:docstring (format | 299 | (:documentation |
| 299 | ;; "Test OBJ to see if it's an object is a child of type %S." | 300 | (format "Return non-nil if OBJ is an object of type `%S' or a subclass. |
| 300 | ;; class)) | 301 | \n(fn OBJ)" class)) |
| 301 | (and (eieio-object-p obj) | 302 | (and (eieio-object-p obj) |
| 302 | (object-of-class-p obj class)))) | 303 | (object-of-class-p obj class)))) |
| 303 | 304 | ||
| @@ -312,8 +313,7 @@ See `defclass' for more information." | |||
| 312 | (run-hooks 'eieio-hook) | 313 | (run-hooks 'eieio-hook) |
| 313 | (setq eieio-hook nil) | 314 | (setq eieio-hook nil) |
| 314 | 315 | ||
| 315 | (let* ((pname superclasses) | 316 | (let* ((oldc (let ((c (eieio--class-v cname))) (if (eieio--class-p c) c))) |
| 316 | (oldc (let ((c (eieio--class-v cname))) (if (eieio--class-p c) c))) | ||
| 317 | (newc (if (and oldc (not (eieio--class-default-object-cache oldc))) | 317 | (newc (if (and oldc (not (eieio--class-default-object-cache oldc))) |
| 318 | ;; The oldc class is a stub setup by eieio-defclass-autoload. | 318 | ;; The oldc class is a stub setup by eieio-defclass-autoload. |
| 319 | ;; Reuse it instead of creating a new one, so that existing | 319 | ;; Reuse it instead of creating a new one, so that existing |
| @@ -338,9 +338,9 @@ See `defclass' for more information." | |||
| 338 | (setf (eieio--class-children newc) children) | 338 | (setf (eieio--class-children newc) children) |
| 339 | (remhash cname eieio-defclass-autoload-map)))) | 339 | (remhash cname eieio-defclass-autoload-map)))) |
| 340 | 340 | ||
| 341 | (if pname | 341 | (if superclasses |
| 342 | (progn | 342 | (progn |
| 343 | (dolist (p pname) | 343 | (dolist (p superclasses) |
| 344 | (if (not (and p (symbolp p))) | 344 | (if (not (and p (symbolp p))) |
| 345 | (error "Invalid parent class %S" p) | 345 | (error "Invalid parent class %S" p) |
| 346 | (let ((c (eieio--class-v p))) | 346 | (let ((c (eieio--class-v p))) |
| @@ -396,7 +396,7 @@ See `defclass' for more information." | |||
| 396 | 396 | ||
| 397 | ;; Before adding new slots, let's add all the methods and classes | 397 | ;; Before adding new slots, let's add all the methods and classes |
| 398 | ;; in from the parent class. | 398 | ;; in from the parent class. |
| 399 | (eieio-copy-parents-into-subclass newc superclasses) | 399 | (eieio-copy-parents-into-subclass newc) |
| 400 | 400 | ||
| 401 | ;; Store the new class vector definition into the symbol. We need to | 401 | ;; Store the new class vector definition into the symbol. We need to |
| 402 | ;; do this first so that we can call defmethod for the accessor. | 402 | ;; do this first so that we can call defmethod for the accessor. |
| @@ -784,7 +784,7 @@ if default value is nil." | |||
| 784 | )) | 784 | )) |
| 785 | )) | 785 | )) |
| 786 | 786 | ||
| 787 | (defun eieio-copy-parents-into-subclass (newc _parents) | 787 | (defun eieio-copy-parents-into-subclass (newc) |
| 788 | "Copy into NEWC the slots of PARENTS. | 788 | "Copy into NEWC the slots of PARENTS. |
| 789 | Follow the rules of not overwriting early parents when applying to | 789 | Follow the rules of not overwriting early parents when applying to |
| 790 | the new child class." | 790 | the new child class." |
| @@ -911,7 +911,7 @@ Argument FN is the function calling this verifier." | |||
| 911 | (if (eieio--class-p c) (eieio-class-un-autoload obj)) | 911 | (if (eieio--class-p c) (eieio-class-un-autoload obj)) |
| 912 | c)) | 912 | c)) |
| 913 | (t (eieio--object-class-object obj)))) | 913 | (t (eieio--object-class-object obj)))) |
| 914 | (c (eieio--slot-name-index class obj slot))) | 914 | (c (eieio--slot-name-index class slot))) |
| 915 | (if (not c) | 915 | (if (not c) |
| 916 | ;; It might be missing because it is a :class allocated slot. | 916 | ;; It might be missing because it is a :class allocated slot. |
| 917 | ;; Let's check that info out. | 917 | ;; Let's check that info out. |
| @@ -935,7 +935,7 @@ Fills in OBJ's SLOT with its default value." | |||
| 935 | (cl-check-type slot symbol) | 935 | (cl-check-type slot symbol) |
| 936 | (let* ((cl (cond ((symbolp obj) (eieio--class-v obj)) | 936 | (let* ((cl (cond ((symbolp obj) (eieio--class-v obj)) |
| 937 | (t (eieio--object-class-object obj)))) | 937 | (t (eieio--object-class-object obj)))) |
| 938 | (c (eieio--slot-name-index cl obj slot))) | 938 | (c (eieio--slot-name-index cl slot))) |
| 939 | (if (not c) | 939 | (if (not c) |
| 940 | ;; It might be missing because it is a :class allocated slot. | 940 | ;; It might be missing because it is a :class allocated slot. |
| 941 | ;; Let's check that info out. | 941 | ;; Let's check that info out. |
| @@ -973,7 +973,7 @@ Fills in OBJ's SLOT with VALUE." | |||
| 973 | (cl-check-type obj eieio-object) | 973 | (cl-check-type obj eieio-object) |
| 974 | (cl-check-type slot symbol) | 974 | (cl-check-type slot symbol) |
| 975 | (let* ((class (eieio--object-class-object obj)) | 975 | (let* ((class (eieio--object-class-object obj)) |
| 976 | (c (eieio--slot-name-index class obj slot))) | 976 | (c (eieio--slot-name-index class slot))) |
| 977 | (if (not c) | 977 | (if (not c) |
| 978 | ;; It might be missing because it is a :class allocated slot. | 978 | ;; It might be missing because it is a :class allocated slot. |
| 979 | ;; Let's check that info out. | 979 | ;; Let's check that info out. |
| @@ -997,7 +997,7 @@ Fills in the default value in CLASS' in SLOT with VALUE." | |||
| 997 | (setq class (eieio--class-object class)) | 997 | (setq class (eieio--class-object class)) |
| 998 | (cl-check-type class eieio--class) | 998 | (cl-check-type class eieio--class) |
| 999 | (cl-check-type slot symbol) | 999 | (cl-check-type slot symbol) |
| 1000 | (let* ((c (eieio--slot-name-index class nil slot))) | 1000 | (let* ((c (eieio--slot-name-index class slot))) |
| 1001 | (if (not c) | 1001 | (if (not c) |
| 1002 | ;; It might be missing because it is a :class allocated slot. | 1002 | ;; It might be missing because it is a :class allocated slot. |
| 1003 | ;; Let's check that info out. | 1003 | ;; Let's check that info out. |
| @@ -1021,12 +1021,9 @@ Fills in the default value in CLASS' in SLOT with VALUE." | |||
| 1021 | 1021 | ||
| 1022 | ;;; EIEIO internal search functions | 1022 | ;;; EIEIO internal search functions |
| 1023 | ;; | 1023 | ;; |
| 1024 | (defun eieio--slot-name-index (class obj slot) | 1024 | (defun eieio--slot-name-index (class slot) |
| 1025 | "In CLASS for OBJ find the index of the named SLOT. | 1025 | "In CLASS find the index of the named SLOT. |
| 1026 | The slot is a symbol which is installed in CLASS by the `defclass' | 1026 | The slot is a symbol which is installed in CLASS by the `defclass' call. |
| 1027 | call. OBJ can be nil, but if it is an object, and the slot in question | ||
| 1028 | is protected, access will be allowed if OBJ is a child of the currently | ||
| 1029 | scoped class. | ||
| 1030 | If SLOT is the value created with :initarg instead, | 1027 | If SLOT is the value created with :initarg instead, |
| 1031 | reverse-lookup that name, and recurse with the associated slot value." | 1028 | reverse-lookup that name, and recurse with the associated slot value." |
| 1032 | ;; Removed checks to outside this call | 1029 | ;; Removed checks to outside this call |
| @@ -1035,7 +1032,7 @@ reverse-lookup that name, and recurse with the associated slot value." | |||
| 1035 | (if (integerp fsi) | 1032 | (if (integerp fsi) |
| 1036 | (+ (eval-when-compile eieio--object-num-slots) fsi) | 1033 | (+ (eval-when-compile eieio--object-num-slots) fsi) |
| 1037 | (let ((fn (eieio--initarg-to-attribute class slot))) | 1034 | (let ((fn (eieio--initarg-to-attribute class slot))) |
| 1038 | (if fn (eieio--slot-name-index class obj fn) nil))))) | 1035 | (if fn (eieio--slot-name-index class fn) nil))))) |
| 1039 | 1036 | ||
| 1040 | (defun eieio--class-slot-name-index (class slot) | 1037 | (defun eieio--class-slot-name-index (class slot) |
| 1041 | "In CLASS find the index of the named SLOT. | 1038 | "In CLASS find the index of the named SLOT. |
| @@ -1255,7 +1252,7 @@ method invocation orders of the involved classes." | |||
| 1255 | (eieio--class-precedence-list tag)))) | 1252 | (eieio--class-precedence-list tag)))) |
| 1256 | 1253 | ||
| 1257 | 1254 | ||
| 1258 | ;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "b568ffb3c90ed5d0ae673f0051d608ee") | 1255 | ;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "5b04c9a8fff2bd3f3d3ac54aba0f65b7") |
| 1259 | ;;; Generated autoloads from eieio-compat.el | 1256 | ;;; Generated autoloads from eieio-compat.el |
| 1260 | 1257 | ||
| 1261 | (autoload 'eieio--defalias "eieio-compat" "\ | 1258 | (autoload 'eieio--defalias "eieio-compat" "\ |
diff --git a/src/ChangeLog b/src/ChangeLog index 2c9b6c8375b..15d8d27a921 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2015-02-05 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * eval.c (Ffunction): Handle the new (:documentation ...) form. | ||
| 4 | (syms_of_eval): Declare `:documentation'. | ||
| 5 | |||
| 1 | 2015-02-05 Martin Rudalics <rudalics@gmx.at> | 6 | 2015-02-05 Martin Rudalics <rudalics@gmx.at> |
| 2 | 7 | ||
| 3 | * xdisp.c (Fwindow_text_pixel_size): Remove optional BUFFER | 8 | * xdisp.c (Fwindow_text_pixel_size): Remove optional BUFFER |
diff --git a/src/eval.c b/src/eval.c index b98b224e622..e828da9288f 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -575,10 +575,23 @@ usage: (function ARG) */) | |||
| 575 | if (!NILP (Vinternal_interpreter_environment) | 575 | if (!NILP (Vinternal_interpreter_environment) |
| 576 | && CONSP (quoted) | 576 | && CONSP (quoted) |
| 577 | && EQ (XCAR (quoted), Qlambda)) | 577 | && EQ (XCAR (quoted), Qlambda)) |
| 578 | /* This is a lambda expression within a lexical environment; | 578 | { /* This is a lambda expression within a lexical environment; |
| 579 | return an interpreted closure instead of a simple lambda. */ | 579 | return an interpreted closure instead of a simple lambda. */ |
| 580 | return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, | 580 | Lisp_Object cdr = XCDR (quoted); |
| 581 | XCDR (quoted))); | 581 | Lisp_Object tmp = cdr; |
| 582 | if (CONSP (tmp) | ||
| 583 | && (tmp = XCDR (tmp), CONSP (tmp)) | ||
| 584 | && (tmp = XCAR (tmp), CONSP (tmp)) | ||
| 585 | && (EQ (QCdocumentation, XCAR (tmp)))) | ||
| 586 | { /* Handle the special (:documentation <form>) to build the docstring | ||
| 587 | dynamically. */ | ||
| 588 | Lisp_Object docstring = eval_sub (Fcar (XCDR (tmp))); | ||
| 589 | CHECK_STRING (docstring); | ||
| 590 | cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr)))); | ||
| 591 | } | ||
| 592 | return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, | ||
| 593 | cdr)); | ||
| 594 | } | ||
| 582 | else | 595 | else |
| 583 | /* Simply quote the argument. */ | 596 | /* Simply quote the argument. */ |
| 584 | return quoted; | 597 | return quoted; |
| @@ -3668,6 +3681,7 @@ before making `inhibit-quit' nil. */); | |||
| 3668 | DEFSYM (Qand_rest, "&rest"); | 3681 | DEFSYM (Qand_rest, "&rest"); |
| 3669 | DEFSYM (Qand_optional, "&optional"); | 3682 | DEFSYM (Qand_optional, "&optional"); |
| 3670 | DEFSYM (Qclosure, "closure"); | 3683 | DEFSYM (Qclosure, "closure"); |
| 3684 | DEFSYM (QCdocumentation, ":documentation"); | ||
| 3671 | DEFSYM (Qdebug, "debug"); | 3685 | DEFSYM (Qdebug, "debug"); |
| 3672 | 3686 | ||
| 3673 | DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger, | 3687 | DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger, |