use float-time

4 files changed, 34 insertions, 31 deletions

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  <sds@gnu.org>
+
+        * 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  <schwab@suse.de>
 
         * 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.