summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorKenichi Handa <handa@m17n.org>2011-07-07 08:28:00 +0900
committerKenichi Handa <handa@m17n.org>2011-07-07 08:28:00 +0900
commitd2a0a50628933d3cdb09818eee2e17f55e22531f (patch)
treed19c8e71eb63eb6ccd204c2f36f406e4cf853154 /lisp/emacs-lisp
parentc805dec0b5fa81b5c9f2b724e2ec12a17d723aca (diff)
parent354cf0ba0b20108c9776be1d868458893bc2cd54 (diff)
downloademacs-d2a0a50628933d3cdb09818eee2e17f55e22531f.tar.gz
emacs-d2a0a50628933d3cdb09818eee2e17f55e22531f.tar.bz2
emacs-d2a0a50628933d3cdb09818eee2e17f55e22531f.zip
merge trunk
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/benchmark.el5
-rw-r--r--lisp/emacs-lisp/bytecomp.el2
-rw-r--r--lisp/emacs-lisp/derived.el10
-rw-r--r--lisp/emacs-lisp/elp.el6
-rw-r--r--lisp/emacs-lisp/find-func.el21
-rw-r--r--lisp/emacs-lisp/lisp-mode.el119
-rw-r--r--lisp/emacs-lisp/re-builder.el3
-rw-r--r--lisp/emacs-lisp/smie.el8
-rw-r--r--lisp/emacs-lisp/timer.el41
9 files changed, 107 insertions, 108 deletions
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index 86063c512c6..aa84a075b76 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -39,9 +39,8 @@
(setq ,t1 (current-time))
,@forms
(setq ,t2 (current-time))
- (+ (* (- (car ,t2) (car ,t1)) 65536.0)
- (- (nth 1 ,t2) (nth 1 ,t1))
- (* (- (nth 2 ,t2) (nth 2 ,t1)) 1.0e-6)))))
+ (float-time (time-subtract ,t2 ,t1)))))
+
(put 'benchmark-elapse 'edebug-form-spec t)
(put 'benchmark-elapse 'lisp-indent-function 0)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 127f93c6858..223e9667ac3 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -355,7 +355,7 @@ else the global value will be modified."
(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
- goto-line comint-run delete-backward-char)
+ goto-line comint-run delete-backward-char switch-to-buffer)
"List of commands that are not meant to be called from Lisp.")
(defvar byte-compile-not-obsolete-vars nil
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 1db98ac39c8..4fda2bf1d52 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -253,8 +253,14 @@ No problems result if this variable is not bound.
`(let ((parent (char-table-parent ,syntax)))
(unless (and parent
(not (eq parent (standard-syntax-table))))
- (set-char-table-parent ,syntax (syntax-table)))))))
-
+ (set-char-table-parent ,syntax (syntax-table)))))
+ ,(when declare-abbrev
+ `(unless (or (abbrev-table-get ,abbrev :parents)
+ ;; This can happen if the major mode defines
+ ;; the abbrev-table to be its parent's.
+ (eq ,abbrev local-abbrev-table))
+ (abbrev-table-put ,abbrev :parents
+ (list local-abbrev-table))))))
(use-local-map ,map)
,(when syntax `(set-syntax-table ,syntax))
,(when abbrev `(setq local-abbrev-table ,abbrev))
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index 73af3a5708f..b89b6decfc9 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -282,7 +282,7 @@ FUNSYM must be a symbol of a defined function."
;; the function so that non-local exists are still recorded. TBD:
;; I haven't tested non-local exits at all, so no guarantees.
;;
- ;; The 1st element is the total amount of time in usecs that have
+ ;; The 1st element is the total amount of time in seconds that has
;; been spent inside this function. This number is added to on
;; function exit.
;;
@@ -424,9 +424,7 @@ Use optional LIST if provided instead."
(defsubst elp-elapsed-time (start end)
- (+ (* (- (car end) (car start)) 65536.0)
- (- (car (cdr end)) (car (cdr start)))
- (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0)))
+ (float-time (time-subtract end start)))
(defun elp-wrapper (funsym interactive-p args)
"This function has been instrumented for profiling by the ELP.
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 9c4a3e9832c..0194af2e3a8 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -141,6 +141,15 @@ See the functions `find-function' and `find-variable'."
(dolist (suffix (get-load-suffixes) (nreverse suffixes))
(unless (string-match "elc" suffix) (push suffix suffixes)))))
+(defun find-library--load-name (library)
+ (let ((name library))
+ (dolist (dir load-path)
+ (let ((rel (file-relative-name library dir)))
+ (if (and (not (string-match "\\`\\.\\./" rel))
+ (< (length rel) (length name)))
+ (setq name rel))))
+ (unless (equal name library) name)))
+
(defun find-library-name (library)
"Return the absolute file name of the Emacs Lisp source of LIBRARY.
LIBRARY should be a string (the name of the library)."
@@ -148,13 +157,23 @@ LIBRARY should be a string (the name of the library)."
;; the same name.
(if (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library)
(setq library (replace-match "" t t library)))
- (or
+ (or
(locate-file library
(or find-function-source-path load-path)
(find-library-suffixes))
(locate-file library
(or find-function-source-path load-path)
load-file-rep-suffixes)
+ (when (file-name-absolute-p library)
+ (let ((rel (find-library--load-name library)))
+ (when rel
+ (or
+ (locate-file rel
+ (or find-function-source-path load-path)
+ (find-library-suffixes))
+ (locate-file rel
+ (or find-function-source-path load-path)
+ load-file-rep-suffixes)))))
(error "Can't find library %s" library)))
(defvar find-function-C-source-directory
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 04299aec099..c8620aaa439 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -38,46 +38,46 @@
(define-abbrev-table 'lisp-mode-abbrev-table ())
(defvar emacs-lisp-mode-syntax-table
- (let ((table (make-syntax-table)))
- (let ((i 0))
- (while (< i ?0)
- (modify-syntax-entry i "_ " table)
- (setq i (1+ i)))
- (setq i (1+ ?9))
- (while (< i ?A)
- (modify-syntax-entry i "_ " table)
- (setq i (1+ i)))
- (setq i (1+ ?Z))
- (while (< i ?a)
- (modify-syntax-entry i "_ " table)
- (setq i (1+ i)))
- (setq i (1+ ?z))
- (while (< i 128)
- (modify-syntax-entry i "_ " table)
- (setq i (1+ i)))
- (modify-syntax-entry ?\s " " table)
- ;; Non-break space acts as whitespace.
- (modify-syntax-entry ?\x8a0 " " table)
- (modify-syntax-entry ?\t " " table)
- (modify-syntax-entry ?\f " " table)
- (modify-syntax-entry ?\n "> " table)
- ;; This is probably obsolete since nowadays such features use overlays.
- ;; ;; Give CR the same syntax as newline, for selective-display.
- ;; (modify-syntax-entry ?\^m "> " table)
- (modify-syntax-entry ?\; "< " table)
- (modify-syntax-entry ?` "' " table)
- (modify-syntax-entry ?' "' " table)
- (modify-syntax-entry ?, "' " table)
- (modify-syntax-entry ?@ "' " table)
- ;; Used to be singlequote; changed for flonums.
- (modify-syntax-entry ?. "_ " table)
- (modify-syntax-entry ?# "' " table)
- (modify-syntax-entry ?\" "\" " table)
- (modify-syntax-entry ?\\ "\\ " table)
- (modify-syntax-entry ?\( "() " table)
- (modify-syntax-entry ?\) ")( " table)
- (modify-syntax-entry ?\[ "(] " table)
- (modify-syntax-entry ?\] ")[ " table))
+ (let ((table (make-syntax-table))
+ (i 0))
+ (while (< i ?0)
+ (modify-syntax-entry i "_ " table)
+ (setq i (1+ i)))
+ (setq i (1+ ?9))
+ (while (< i ?A)
+ (modify-syntax-entry i "_ " table)
+ (setq i (1+ i)))
+ (setq i (1+ ?Z))
+ (while (< i ?a)
+ (modify-syntax-entry i "_ " table)
+ (setq i (1+ i)))
+ (setq i (1+ ?z))
+ (while (< i 128)
+ (modify-syntax-entry i "_ " table)
+ (setq i (1+ i)))
+ (modify-syntax-entry ?\s " " table)
+ ;; Non-break space acts as whitespace.
+ (modify-syntax-entry ?\x8a0 " " table)
+ (modify-syntax-entry ?\t " " table)
+ (modify-syntax-entry ?\f " " table)
+ (modify-syntax-entry ?\n "> " table)
+ ;; This is probably obsolete since nowadays such features use overlays.
+ ;; ;; Give CR the same syntax as newline, for selective-display.
+ ;; (modify-syntax-entry ?\^m "> " table)
+ (modify-syntax-entry ?\; "< " table)
+ (modify-syntax-entry ?` "' " table)
+ (modify-syntax-entry ?' "' " table)
+ (modify-syntax-entry ?, "' " table)
+ (modify-syntax-entry ?@ "' " table)
+ ;; Used to be singlequote; changed for flonums.
+ (modify-syntax-entry ?. "_ " table)
+ (modify-syntax-entry ?# "' " table)
+ (modify-syntax-entry ?\" "\" " table)
+ (modify-syntax-entry ?\\ "\\ " table)
+ (modify-syntax-entry ?\( "() " table)
+ (modify-syntax-entry ?\) ")( " table)
+ (modify-syntax-entry ?\[ "(] " table)
+ (modify-syntax-entry ?\] ")[ " table)
table)
"Syntax table used in `emacs-lisp-mode'.")
@@ -525,7 +525,6 @@ if that value is non-nil."
"Keymap for Lisp Interaction mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
-(defvar lisp-interaction-mode-abbrev-table lisp-mode-abbrev-table)
(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
"Major mode for typing and evaluating Lisp forms.
Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
@@ -790,25 +789,25 @@ Reinitialize the face according to the `defface' specification."
;; `defface' is macroexpanded to `custom-declare-face'.
((eq (car form) 'custom-declare-face)
;; Reset the face.
- (setq face-new-frame-defaults
- (assq-delete-all (eval (nth 1 form) lexical-binding)
- face-new-frame-defaults))
- (put (eval (nth 1 form) lexical-binding) 'face-defface-spec nil)
- ;; Setting `customized-face' to the new spec after calling
- ;; the form, but preserving the old saved spec in `saved-face',
- ;; imitates the situation when the new face spec is set
- ;; temporarily for the current session in the customize
- ;; buffer, thus allowing `face-user-default-spec' to use the
- ;; new customized spec instead of the saved spec.
- ;; Resetting `saved-face' temporarily to nil is needed to let
- ;; `defface' change the spec, regardless of a saved spec.
- (prog1 `(prog1 ,form
- (put ,(nth 1 form) 'saved-face
- ',(get (eval (nth 1 form) lexical-binding)
- 'saved-face))
- (put ,(nth 1 form) 'customized-face
- ,(nth 2 form)))
- (put (eval (nth 1 form) lexical-binding) 'saved-face nil)))
+ (let ((face-symbol (eval (nth 1 form) lexical-binding)))
+ (setq face-new-frame-defaults
+ (assq-delete-all face-symbol face-new-frame-defaults))
+ (put face-symbol 'face-defface-spec nil)
+ (put face-symbol 'face-documentation (nth 3 form))
+ ;; Setting `customized-face' to the new spec after calling
+ ;; the form, but preserving the old saved spec in `saved-face',
+ ;; imitates the situation when the new face spec is set
+ ;; temporarily for the current session in the customize
+ ;; buffer, thus allowing `face-user-default-spec' to use the
+ ;; new customized spec instead of the saved spec.
+ ;; Resetting `saved-face' temporarily to nil is needed to let
+ ;; `defface' change the spec, regardless of a saved spec.
+ (prog1 `(prog1 ,form
+ (put ,(nth 1 form) 'saved-face
+ ',(get face-symbol 'saved-face))
+ (put ,(nth 1 form) 'customized-face
+ ,(nth 2 form)))
+ (put face-symbol 'saved-face nil))))
((eq (car form) 'progn)
(cons 'progn (mapcar 'eval-defun-1 (cdr form))))
(t form)))
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 5ce18d020c9..ebbd6ff1fdf 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -714,8 +714,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions."
(remove-hook 'after-change-functions 'reb-auto-update t)
(remove-hook 'kill-buffer-hook 'reb-kill-buffer t)
(when (reb-mode-buffer-p)
- (reb-delete-overlays)
- (funcall (or (default-value 'major-mode) 'fundamental-mode)))))
+ (reb-delete-overlays))))
;; continue standard unloading
nil)
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 17cc5668b5f..cad7c8419b2 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -229,14 +229,18 @@ one of those elements share the same precedence level and associativity."
;; the trouble, and it lets the writer of the BNF
;; be a bit more sloppy by skipping uninteresting base
;; cases which are terminals but not OPs.
- (assert (not (member (cadr rhs) nts)))
+ (when (member (cadr rhs) nts)
+ (error "Adjacent non-terminals: %s %s"
+ (car rhs) (cadr rhs)))
(pushnew (cadr rhs) first-ops)))
(let ((shr (reverse rhs)))
(if (not (member (car shr) nts))
(pushnew (car shr) last-ops)
(pushnew (car shr) last-nts)
(when (consp (cdr shr))
- (assert (not (member (cadr shr) nts)))
+ (when (member (cadr shr) nts)
+ (error "Adjacent non-terminals: %s %s"
+ (cadr shr) (car shr)))
(pushnew (cadr shr) last-ops)))))
(push (cons nt first-ops) first-ops-table)
(push (cons nt last-ops) last-ops-table)
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 0a035175041..0e007ff7176 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -110,38 +110,16 @@ of SECS seconds since the epoch. SECS may be a fraction."
(defun timer-relative-time (time secs &optional usecs)
"Advance TIME by SECS seconds and optionally USECS microseconds.
SECS may be either an integer or a floating point number."
- ;; FIXME: we should just use (time-add time (list 0 secs usecs))
- (let ((high (car time))
- (low (if (consp (cdr time)) (nth 1 time) (cdr time)))
- (micro (if (numberp (car-safe (cdr-safe (cdr time))))
- (nth 2 time)
- 0)))
- ;; Add
- (if usecs (setq micro (+ micro usecs)))
- (if (floatp secs)
- (setq micro (+ micro (floor (* 1000000 (- secs (floor secs)))))))
- (setq low (+ low (floor secs)))
-
- ;; Normalize
- ;; `/' rounds towards zero while `mod' returns a positive number,
- ;; so we can't rely on (= a (+ (* 100 (/ a 100)) (mod a 100))).
- (setq low (+ low (/ micro 1000000) (if (< micro 0) -1 0)))
- (setq micro (mod micro 1000000))
- (setq high (+ high (/ low 65536) (if (< low 0) -1 0)))
- (setq low (logand low 65535))
-
- (list high low (and (/= micro 0) micro))))
+ (let ((delta (if (floatp secs)
+ (seconds-to-time secs)
+ (list (floor secs 65536) (mod secs 65536)))))
+ (if usecs
+ (setq delta (time-add delta (list 0 0 usecs))))
+ (time-add time delta)))
(defun timer--time-less-p (t1 t2)
"Say whether time value T1 is less than time value T2."
- ;; FIXME just use time-less-p.
- (destructuring-bind (high1 low1 micro1) (timer--time t1)
- (destructuring-bind (high2 low2 micro2) (timer--time t2)
- (or (< high1 high2)
- (and (= high1 high2)
- (or (< low1 low2)
- (and (= low1 low2)
- (< micro1 micro2))))))))
+ (time-less-p (timer--time t1) (timer--time t2)))
(defun timer-inc-time (timer secs &optional usecs)
"Increment the time set in TIMER by SECS seconds and USECS microseconds.
@@ -273,10 +251,7 @@ how many will really happen.")
"Calculate number of seconds from when TIMER will run, until TIME.
TIMER is a timer, and stands for the time when its next repeat is scheduled.
TIME is a time-list."
- ;; FIXME: (float-time (time-subtract (timer--time timer) time))
- (let ((high (- (car time) (timer--high-seconds timer)))
- (low (- (nth 1 time) (timer--low-seconds timer))))
- (+ low (* high 65536))))
+ (float-time (time-subtract time (timer--time timer))))
(defun timer-event-handler (timer)
"Call the handler for the timer TIMER.