Mercurial > emacs
changeset 30481:b603c68fff56
use float-time
| author | Sam Steingold <sds@gnu.org> |
|---|---|
| date | Wed, 26 Jul 2000 18:44:36 +0000 |
| parents | 5ef94127f946 |
| children | d9af2c1682d5 |
| files | lisp/ChangeLog lisp/midnight.el lisp/net/ange-ftp.el lisp/tooltip.el |
| diffstat | 4 files changed, 34 insertions(+), 31 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Wed Jul 26 18:41:15 2000 +0000 +++ b/lisp/ChangeLog Wed Jul 26 18:44:36 2000 +0000 @@ -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
--- a/lisp/midnight.el Wed Jul 26 18:41:15 2000 +0000 +++ b/lisp/midnight.el Wed Jul 26 18:44:36 2000 +0000 @@ -63,11 +63,6 @@ ;;; 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 @@ (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 @@ 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)
--- a/lisp/net/ange-ftp.el Wed Jul 26 18:41:15 2000 +0000 +++ b/lisp/net/ange-ftp.el Wed Jul 26 18:44:36 2000 +0000 @@ -3357,6 +3357,17 @@ )))) (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 @@ (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 @@ (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 @@ (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 @@ ;;;; 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 @@ (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 @@ 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 "]"))
--- a/lisp/tooltip.el Wed Jul 26 18:41:15 2000 +0000 +++ b/lisp/tooltip.el Wed Jul 26 18:44:36 2000 +0000 @@ -102,7 +102,7 @@ :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 @@ ;;; 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 @@ 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 @@ (xdb (concat "p " expr)) (sdb (concat expr "/")) (perldb expr))) - + (defun tooltip-gud-tips (event) "Show tip for identifier or selection under the mouse.