diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/benchmark.el | 5 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/derived.el | 10 | ||||
| -rw-r--r-- | lisp/emacs-lisp/elp.el | 6 | ||||
| -rw-r--r-- | lisp/emacs-lisp/find-func.el | 21 | ||||
| -rw-r--r-- | lisp/emacs-lisp/lisp-mode.el | 119 | ||||
| -rw-r--r-- | lisp/emacs-lisp/re-builder.el | 3 | ||||
| -rw-r--r-- | lisp/emacs-lisp/smie.el | 8 | ||||
| -rw-r--r-- | lisp/emacs-lisp/timer.el | 41 |
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. |