Commit a1f84f6d authored by Sam Steingold's avatar Sam Steingold

use float-time

parent 34a7a267
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
......
......@@ -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)
......
......@@ -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 "]"))
......
......@@ -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.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment