From: Sam Steingold Date: Wed, 26 Jul 2000 18:44:36 +0000 (+0000) Subject: use float-time X-Git-Tag: emacs-pretest-21.0.90~2590 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a1f84f6d16f1fe08bbfb16ac4928a5f08679a9e2;p=emacs.git use float-time --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c18144af04a..69997691b32 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2000-07-26 Sam Steingold + + * net/ange-ftp.el (ange-ftp-file-newer-than-file-p): New function. + (ange-ftp-real-file-newer-than-file-p): New function. + (ange-ftp-verify-visited-file-modtime): Use `float-time'. + (ange-ftp-dot-to-slash): Removed (use `subst-char-in-string'). + + * tooltip.el (tooltip-float-time): Removed (use `float-time'). + * midnight.el (midnight-float-time): Ditto. + 2000-07-26 Andreas Schwab * files.el (normal-backup-enable-predicate): Correct diff --git a/lisp/midnight.el b/lisp/midnight.el index 2c05ad14d19..2995dbd8ed6 100644 --- a/lisp/midnight.el +++ b/lisp/midnight.el @@ -63,11 +63,6 @@ call `cancel-timer' or `timer-activate' on `midnight-timer' instead." ;;; time conversion -(defun midnight-float-time (&optional tm) - "Convert `current-time' to a float number of seconds." - (multiple-value-bind (s0 s1 s2) (or tm (current-time)) - (+ (* (float (ash 1 16)) s0) (float s1) (* 0.0000001 s2)))) - (defun midnight-time-float (num) "Convert the float number of seconds since epoch to the list of 3 integers." (let* ((div (ash 1 16)) (1st (floor num div))) @@ -77,7 +72,7 @@ call `cancel-timer' or `timer-activate' on `midnight-timer' instead." (defun midnight-buffer-display-time (&optional buf) "Return the time-stamp of the given buffer, or current buffer, as float." (with-current-buffer (or buf (current-buffer)) - (when buffer-display-time (midnight-float-time buffer-display-time)))) + (when buffer-display-time (float-time buffer-display-time)))) ;;; clean-buffer-list stuff @@ -177,7 +172,7 @@ the current date/time, buffer name, how many seconds ago it was displayed (can be nil if the buffer was never displayed) and its lifetime, i.e., its \"age\" when it will be purged." (interactive) - (let ((tm (midnight-float-time)) bts (ts (format-time-string "%Y-%m-%d %T")) + (let ((tm (float-time)) bts (ts (format-time-string "%Y-%m-%d %T")) (bufs (buffer-list)) buf delay cbld bn) (while (setq buf (pop bufs)) (setq bts (midnight-buffer-display-time buf) bn (buffer-name buf) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 693be20a8ac..e710540f785 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -3357,6 +3357,17 @@ system TYPE.") )))) (ange-ftp-real-file-attributes file)))) +(defun ange-ftp-file-newer-than-file-p (f1 f2) + (let ((f1-parsed (ange-ftp-ftp-name f1)) + (f2-parsed (ange-ftp-ftp-name f2))) + (if (or f1-parsed f2-parsed) + (let ((f1-mt (nth 5 (file-attributes f1))) + (f2-mt (nth 5 (file-attributes f2)))) + (cond ((null f1-mt) nil) + ((null f2-mt) t) + (t (> (float-time f1-mt) (float-time f2-mt))))) + (ange-ftp-real-file-newer-than-file-p f1 f2)))) + (defun ange-ftp-file-writable-p (file) (setq file (expand-file-name file)) (if (ange-ftp-ftp-name file) @@ -3417,9 +3428,7 @@ system TYPE.") (let ((file-mdtm (ange-ftp-file-modtime name)) (buf-mdtm (with-current-buffer buf (visited-file-modtime)))) (or (zerop (car file-mdtm)) - (< (car file-mdtm) (car buf-mdtm)) - (and (= (car file-mdtm) (car buf-mdtm)) - (< (cadr file-mdtm) (cdr buf-mdtm))))) + (< (float-time file-mdtm) (float-time buf-mdtm)))) (ange-ftp-real-verify-visited-file-modtime buf)))) ;;;; ------------------------------------------------------------ @@ -4164,6 +4173,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (put 'copy-file 'ange-ftp 'ange-ftp-copy-file) (put 'rename-file 'ange-ftp 'ange-ftp-rename-file) (put 'file-attributes 'ange-ftp 'ange-ftp-file-attributes) +(put 'file-newer-than-file-p 'ange-ftp 'ange-ftp-file-newer-than-file-p) (put 'file-name-all-completions 'ange-ftp 'ange-ftp-file-name-all-completions) (put 'file-name-completion 'ange-ftp 'ange-ftp-file-name-completion) (put 'insert-directory 'ange-ftp 'ange-ftp-insert-directory) @@ -4245,6 +4255,8 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (ange-ftp-run-real-handler 'rename-file args)) (defun ange-ftp-real-file-attributes (&rest args) (ange-ftp-run-real-handler 'file-attributes args)) +(defun ange-ftp-real-file-newer-than-file-p (&rest args) + (ange-ftp-run-real-handler 'file-newer-than-file-p args)) (defun ange-ftp-real-file-name-all-completions (&rest args) (ange-ftp-run-real-handler 'file-name-all-completions args)) (defun ange-ftp-real-file-name-completion (&rest args) @@ -4727,13 +4739,6 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ;;;; VMS support. ;;;; ------------------------------------------------------------ -(defun ange-ftp-dot-to-slash (string) - (mapconcat (lambda (char) - (if (= char ?.) - (vector ?/) - (vector char))) - string "")) - ;; Convert NAME from UNIX-ish to VMS. If REVERSE given then convert from VMS ;; to UNIX-ish. (defun ange-ftp-fix-name-for-vms (name &optional reverse) @@ -4752,7 +4757,8 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (setq file (substring name (match-beginning 3) (match-end 3)))) (and dir - (setq dir (ange-ftp-dot-to-slash (substring dir 1 -1)))) + (setq dir (subst-char-in-string + ?. ?/ (substring dir 1 -1) t))) (concat (and drive (concat "/" drive "/")) dir (and dir "/") @@ -4765,7 +4771,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") name (substring name (match-end 0)))) (setq tmp (file-name-directory name)) (if tmp - (setq dir (ange-ftp-dot-to-slash (substring tmp 0 -1)))) + (setq dir (subst-char-in-string ?. ?/ (substring tmp 0 -1) t))) (setq file (file-name-nondirectory name)) (concat drive (and dir (concat "[" (if drive nil ".") dir "]")) diff --git a/lisp/tooltip.el b/lisp/tooltip.el index b3fc461ff21..a7484dc7fd5 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -102,7 +102,7 @@ Do so after `tooltip-short-delay'." :tag "GUD modes" :group 'tooltip) - + (defcustom tooltip-gud-display '((eq (tooltip-event-buffer tooltip-gud-event) (marker-buffer overlay-arrow-position))) @@ -195,18 +195,10 @@ With ARG, turn tooltip mode on if and only if ARG is positive." ;;; Timeout for tooltip display -(defun tooltip-float-time () - "Return the values of `current-time' as a float." - (let ((now (current-time))) - (+ (* 65536.0 (nth 0 now)) - (nth 1 now) - (/ (nth 2 now) 1000000.0)))) - - (defun tooltip-delay () "Return the delay in seconds for the next tooltip." (let ((delay tooltip-delay) - (now (tooltip-float-time))) + (now (float-time))) (when (and tooltip-hide-time (< (- now tooltip-hide-time) tooltip-recent-seconds)) (setq delay tooltip-short-delay)) @@ -287,7 +279,7 @@ ACTIVATEP non-nil means activate mouse motion events." Value is non-nil if tooltip was open." (tooltip-disable-timeout) (when (x-hide-tip) - (setq tooltip-hide-time (tooltip-float-time)))) + (setq tooltip-hide-time (float-time)))) @@ -397,7 +389,7 @@ If TOOLTIP-GUD-DEREFERENCE is t, also prepend a `*' to EXPR." (xdb (concat "p " expr)) (sdb (concat expr "/")) (perldb expr))) - + (defun tooltip-gud-tips (event) "Show tip for identifier or selection under the mouse.