Mercurial > hg > xemacs-beta

comparison lisp/efs/efs-cp-p.el @ 98:0d2f883870bc r20-1b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 8fc7fe29b841
children 8b8b7f3559a2 8619ce7e4c50
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
1 ;; -*-Emacs-Lisp-*-
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;
4 ;; File: efs-cp-p.el
5 ;; Release: $efs release: 1.15 $
6 ;; Version: $Revision: 1.1 $
7 ;; RCS:
8 ;; Description: Support for preserving file modtimes with copies. i.e. cp -p
9 ;; Author: Sandy Rutherford <sandy@ibm550.sissa.it>
10 ;; Created: Fri Feb 18 03:28:22 1994 by sandy on ibm550
11 ;; Modified: Sun Nov 27 12:17:33 1994 by sandy on gandalf
12 ;; Language: Emacs-Lisp
13 ;;
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15
16 ;;; This file is part of efs. See efs.el for copyright
17 ;;; (it's copylefted) and warrranty (there isn't one) information.
18
19 (provide 'efs-cp-p)
20 (require 'efs)
21
22 ;;;; Internal Variables
23
24 (defconst efs-cp-p-version
25 (concat (substring "$efs release: 1.15 $" 14 -2)
26 "/"
27 (substring "$Revision: 1.1 $" 11 -2)))
28
29 (defvar efs-local-timezone nil)
30 ;; cache.
31
32 ;;; Utility functions
33
34 (efs-define-fun efs-gmt-time ()
35 ;; Get the time as the number of seconds elapsed since midnight,
36 ;; Jan 1, 1970, GMT. Emacs 18 doesn't have `current-time' function.
37 (let ((time (current-time)))
38 (list (car time) (nth 1 time))))
39
40 (defun efs-local-time ()
41 (let ((str (current-time-string)))
42 (efs-seconds-elapsed
43 (string-to-int (substring str -4))
44 (cdr (assoc (substring str 4 7) efs-month-alist))
45 (string-to-int (substring str 8 10))
46 (string-to-int (substring str 11 13))
47 (string-to-int (substring str 14 16))
48 0))) ; don't care about seconds
49
50 (defun efs-local-timezone ()
51 ;; Returns the local timezone as an integer. Right two digits the minutes,
52 ;; others the hours.
53 (or efs-local-timezone
54 (setq efs-local-timezone
55 (let* ((local (efs-local-time))
56 (gmt (efs-gmt-time))
57 (sign 1)
58 (diff (efs-time-minus local gmt))
59 hours minutes)
60 ;; 2^16 is 36 hours.
61 (if (zerop (car diff))
62 (setq diff (nth 1 diff))
63 (error "Weird timezone!"))
64 (setq diff (/ (- (nth 1 local) (nth 1 gmt)) 60))
65 (setq hours (/ diff 60))
66 (setq minutes (% diff 60))
67 (if (< diff 0)
68 (setq sign -1
69 hours (- hours)
70 minutes (- minutes)))
71 ;; Round minutes
72 (setq minutes (* 10 (/ (+ minutes 5) 10)))
73 (if (= minutes 60)
74 (setq hours (1+ hours)
75 minutes 0))
76 (* sign (+ (* hours 100) minutes))))))
77
78 (defun efs-last-day-of-month (month year)
79 ;; The last day in MONTH during YEAR.
80 ;; Taken from calendar.el. Thanks.
81 (if (and
82 (or
83 (and (= (% year 4) 0)
84 (/= (% year 100) 0)) ; leap-year-p
85 (= (% year 400) 0))
86 (= month 2))
87 29
88 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
89
90 (defun efs-make-date-local (year month day hour minutes seconds)
91 ;; Takes a GMT date (list of integers), and returns the local time.
92 (let* ((lzone (efs-local-timezone))
93 (lminutes (% lzone 100))
94 (lhour (/ lzone 100)))
95 (setq minutes (+ minutes lminutes))
96 (cond ((> minutes 60)
97 (setq minutes (- minutes 60)
98 hour (1+ hour)))
99 ((< minutes 0)
100 (setq minutes (+ minutes 60)
101 hour (1- hour))))
102 (setq hour (+ lhour hour))
103 (if (or (< hour 0) (> hour 23))
104 (progn
105 (cond ((< hour 0)
106 (setq hour (+ hour 24)
107 day (1- day)))
108 ((> hour 23)
109 (setq hour (- hour 24)
110 day (1+ day))))
111 (if (or (zerop day) (> day
112 (efs-last-day-of-month month year)))
113 (cond ((zerop day)
114 (setq month (1- month))
115 (if (zerop month)
116 (setq year (1- year)
117 month 12))
118 (setq day (efs-last-day-of-month month year)))
119 ((> day (efs-last-day-of-month month year))
120 (setq month (1+ month)
121 day 1)
122 (if (= month 13)
123 (setq year (1+ year)
124 month 1)))))))
125 (list year month day hour minutes seconds)))
126
127 ;;;; Entry function
128
129 (defun efs-set-mdtm-of (filename newname &optional cont)
130 ;; NEWNAME must be local
131 ;; Always works NOWAIT = 0
132 (let* ((parsed (efs-ftp-path filename))
133 (host (car parsed))
134 (user (nth 1 parsed))
135 (file (nth 2 parsed)))
136 (if (efs-get-host-property host 'mdtm-failed)
137 (and cont (efs-call-cont cont 'failed "" "") nil)
138 (efs-send-cmd
139 host user
140 (list 'quote 'mdtm file)
141 nil nil
142 (efs-cont (result line cont-lines) (host newname cont)
143 (if (or result
144 (not (string-match efs-mdtm-msgs line)))
145 (efs-set-host-property host 'mdtm-failed t)
146 (let ((time (apply 'efs-make-date-local
147 (mapcar 'string-to-int
148 (list
149 (substring line 4 8)
150 (substring line 8 10)
151 (substring line 10 12)
152 (substring line 12 14)
153 (substring line 14 16)
154 (substring line 16 18))))))
155 (if time
156 (call-process "touch" nil 0 nil "-t"
157 (format "%04d%02d%02d%02d%02d.%02d"
158 (car time) (nth 1 time)
159 (nth 2 time) (nth 3 time)
160 (nth 4 time) (nth 5 time))
161 newname))))
162 (if cont (efs-call-cont cont result line cont-lines)))
163 0))))
164
165 ;;; end of efs-cp-p.el