+2011-06-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Miscellaneous tweaks.
+ * emacs-lisp/cl-macs.el (dolist, dotimes): Use the same strategy for
+ lexical scoping as in subr.el's dolist and dotimes.
+ * emacs-lisp/bytecomp.el (byte-compile-unfold-bcf):
+ Silence compiler warning.
+ * thingatpt.el (forward-whitespace): Trivial coding style fix.
+ * subr.el (with-output-to-temp-buffer): Provide an edebug spec.
+ * international/ccl.el (ccl-compile): Trivial simplification.
+ * help-fns.el (help-do-arg-highlight): Silence compiler warning.
+ * emacs-lisp/testcover.el (testcover-end): Remove spurious
+ `printflag' argument.
+ * emacs-lisp/byte-run.el (make-obsolete, make-obsolete-variable):
+ Purecopy the whole obsolescence data.
+
2011-06-01 Leo Liu <sdl.web@gmail.com>
* net/rcirc.el (rcirc-decode-coding-system): Revert last change;
The warning will say that CURRENT-NAME should be used instead.
If CURRENT-NAME is a string, that is the `use instead' message
\(it should end with a period, and not start with a capital).
-If provided, WHEN should be a string indicating when the function
+WHEN should be a string indicating when the function
was first made obsolete, for example a date or a release number."
(interactive "aMake function obsolete: \nxObsoletion replacement: ")
(put obsolete-name 'byte-obsolete-info
;; The second entry used to hold the `byte-compile' handler, but
;; is not used any more nowadays.
- (list (purecopy current-name) nil (purecopy when)))
+ (purecopy (list current-name nil when)))
obsolete-name)
(set-advertised-calling-convention
;; New code should always provide the `when' argument.
(intern str))
(car (read-from-string (read-string "Obsoletion replacement: ")))))
(put obsolete-name 'byte-obsolete-variable
- (cons
- (if (stringp current-name)
- (purecopy current-name)
- current-name) (purecopy when)))
+ (purecopy (cons current-name when)))
obsolete-name)
(set-advertised-calling-convention
;; New code should always provide the `when' argument.
(cond
((<= (+ alen alen) fmax2)
;; Add missing &optional (or &rest) arguments.
- (dotimes (i (- (/ (1+ fmax2) 2) alen))
+ (dotimes (_ (- (/ (1+ fmax2) 2) alen))
(byte-compile-push-constant nil)))
((zerop (logand fmax2 1))
(byte-compile-log-warning "Too many arguments for inlined function"
;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder)))
;; binders)))
-;; (defmacro letrec (binders &rest body)
-;; ;; Only useful in lexical-binding mode.
-;; ;; As a special-form, we could implement it more efficiently (and cleanly,
-;; ;; making the vars actually unbound during evaluation of the binders).
-;; `(let ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder))
-;; binders)
-;; ,@(delq nil (mapcar (lambda (binder) (if (consp binder) `(setq ,@binder)))
-;; binders))
-;; ,@body))
-
(eval-when-compile (require 'cl))
(defconst cconv-liftwhen 6
\(fn (VAR LIST [RESULT]) BODY...)"
(let ((temp (make-symbol "--cl-dolist-temp--")))
- (list 'block nil
- (list* 'let (list (list temp (nth 1 spec)) (car spec))
- (list* 'while temp (list 'setq (car spec) (list 'car temp))
- (append body (list (list 'setq temp
- (list 'cdr temp)))))
- (if (cdr (cdr spec))
- (cons (list 'setq (car spec) nil) (cdr (cdr spec)))
- '(nil))))))
+ ;; FIXME: Copy&pasted from subr.el.
+ `(block nil
+ ;; This is not a reliable test, but it does not matter because both
+ ;; semantics are acceptable, tho one is slightly faster with dynamic
+ ;; scoping and the other is slightly faster (and has cleaner semantics)
+ ;; with lexical scoping.
+ ,(if lexical-binding
+ `(let ((,temp ,(nth 1 spec)))
+ (while ,temp
+ (let ((,(car spec) (car ,temp)))
+ ,@body
+ (setq ,temp (cdr ,temp))))
+ ,@(if (cdr (cdr spec))
+ ;; FIXME: This let often leads to "unused var" warnings.
+ `((let ((,(car spec) nil)) ,@(cdr (cdr spec))))))
+ `(let ((,temp ,(nth 1 spec))
+ ,(car spec))
+ (while ,temp
+ (setq ,(car spec) (car ,temp))
+ ,@body
+ (setq ,temp (cdr ,temp)))
+ ,@(if (cdr (cdr spec))
+ `((setq ,(car spec) nil) ,@(cddr spec))))))))
;;;###autoload
(defmacro dotimes (spec &rest body)
nil.
\(fn (VAR COUNT [RESULT]) BODY...)"
- (let ((temp (make-symbol "--cl-dotimes-temp--")))
- (list 'block nil
- (list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0))
- (list* 'while (list '< (car spec) temp)
- (append body (list (list 'incf (car spec)))))
- (or (cdr (cdr spec)) '(nil))))))
+ (let ((temp (make-symbol "--cl-dotimes-temp--"))
+ (end (nth 1 spec)))
+ ;; FIXME: Copy&pasted from subr.el.
+ `(block nil
+ ;; This is not a reliable test, but it does not matter because both
+ ;; semantics are acceptable, tho one is slightly faster with dynamic
+ ;; scoping and the other has cleaner semantics.
+ ,(if lexical-binding
+ (let ((counter '--dotimes-counter--))
+ `(let ((,temp ,end)
+ (,counter 0))
+ (while (< ,counter ,temp)
+ (let ((,(car spec) ,counter))
+ ,@body)
+ (setq ,counter (1+ ,counter)))
+ ,@(if (cddr spec)
+ ;; FIXME: This let often leads to "unused var" warnings.
+ `((let ((,(car spec) ,counter)) ,@(cddr spec))))))
+ `(let ((,temp ,end)
+ (,(car spec) 0))
+ (while (< ,(car spec) ,temp)
+ ,@body
+ (incf ,(car spec)))
+ ,@(cdr (cdr spec)))))))
;;;###autoload
(defmacro do-symbols (spec &rest body)
"Turn off instrumentation of all macros and functions in FILENAME."
(interactive "fStop covering file: ")
(let ((buf (find-file-noselect filename)))
- (eval-buffer buf t)))
+ (eval-buffer buf)))
;;;=========================================================================
(defun help-do-arg-highlight (doc args)
(with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
(modify-syntax-entry ?\- "w")
- (dolist (arg args doc)
+ (dolist (arg args)
(setq doc (replace-regexp-in-string
;; This is heuristic, but covers all common cases
;; except ARG1-ARG2
"\\(?:-[{([<`\"].*?\\)?"; for ARG-{x}, (x), <x>, [x], `x'
"\\>") ; end of word
(help-highlight-arg arg)
- doc t t 1)))))
+ doc t t 1)))
+ doc))
(defun help-highlight-arguments (usage doc &rest args)
(when (and usage (string-match "^(" usage))
;;;###autoload
(defun ccl-compile (ccl-program)
"Return the compiled code of CCL-PROGRAM as a vector of integers."
- (if (or (null (consp ccl-program))
- (null (integerp (car ccl-program)))
- (null (listp (car (cdr ccl-program)))))
- (error "CCL: Invalid CCL program: %s" ccl-program))
+ (unless (and (consp ccl-program)
+ (integerp (car ccl-program))
+ (listp (car (cdr ccl-program))))
+ (error "CCL: Invalid CCL program: %s" ccl-program))
(if (null (vectorp ccl-program-vector))
(setq ccl-program-vector (make-vector 8192 0)))
(setq ccl-loop-head nil ccl-breaks nil)
buffer temporarily current, and the window that was used to display it
temporarily selected. But it doesn't run `temp-buffer-show-hook'
if it uses `temp-buffer-show-function'."
+ (declare (debug t))
(let ((old-dir (make-symbol "old-dir"))
(buf (make-symbol "buf")))
`(let* ((,old-dir default-directory)
(re-search-forward "[ \t]+\\|\n" nil 'move arg)
(while (< arg 0)
(if (re-search-backward "[ \t]+\\|\n" nil 'move)
- (or (eq (char-after (match-beginning 0)) 10)
+ (or (eq (char-after (match-beginning 0)) \n)
(skip-chars-backward " \t")))
(setq arg (1+ arg)))))
#define Bcurrent_column 0151
#define Bindent_to 0152
#ifdef BYTE_CODE_SAFE
-#define Bscan_buffer 0153 /* No longer generated as of v18 */
+#define Bscan_buffer 0153 /* No longer generated as of v18. */
#endif
#define Beolp 0154
#define Beobp 0155
save_restriction_save ());
break;
- case Bcatch: /* FIXME: ill-suited for lexbind */
+ case Bcatch: /* FIXME: ill-suited for lexbind. */
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
break;
}
- case Bunwind_protect: /* FIXME: avoid closure for lexbind */
+ case Bunwind_protect: /* FIXME: avoid closure for lexbind. */
record_unwind_protect (Fprogn, POP);
break;
- case Bcondition_case: /* FIXME: ill-suited for lexbind */
+ case Bcondition_case: /* FIXME: ill-suited for lexbind. */
{
Lisp_Object handlers, body;
handlers = POP;
PUSH (*ptr);
break;
}
- /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */
case Bstack_set:
+ /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */
{
Lisp_Object *ptr = top - (FETCH);
*ptr = POP;
projects / emacs.git / commitdiff