summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/midnight.el9
-rw-r--r--lisp/net/ange-ftp.el30
-rw-r--r--lisp/tooltip.el16
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.