Mercurial > emacs
annotate lisp/shadowfile.el @ 110410:f2e111723c3a
Merge changes made in Gnus trunk.
Reimplement nnimap, and do tweaks to the rest of the code to support that.
* gnus-int.el (gnus-finish-retrieve-group-infos)
(gnus-retrieve-group-data-early): New functions.
* gnus-range.el (gnus-range-nconcat): New function.
* gnus-start.el (gnus-get-unread-articles): Support early retrieval of
data.
(gnus-read-active-for-groups): Support finishing the early retrieval of
data.
* gnus-sum.el (gnus-summary-move-article): Pass the move-to group name
if the move is internal, so that nnimap can do fast internal moves.
* gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for
nnimap usage.
* nnimap.el: Rewritten.
* nnmail.el (nnmail-inhibit-default-split-group): New internal variable
to allow the mail splitting to not return a default group. This is
useful for nnimap, which will leave unmatched mail in the inbox.
* utf7.el (utf7-encode): Autoload.
Implement shell connection.
* nnimap.el (nnimap-open-shell-stream): New function.
(nnimap-open-connection): Use it.
Get the number of lines by using BODYSTRUCTURE.
(nnimap-transform-headers): Get the number of lines in each message.
(nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the
number of lines.
Not all servers return UIDNEXT. Work past this problem.
Remove junk from end of file.
Fix typo in "bogus" section.
Make capabilties be case-insensitive.
Require cl when compiling.
Don't bug out if the LIST command doesn't have any parameters.
2010-09-17 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change)
* nnimap.el (nnimap-get-groups): Don't bug out if the LIST command
doesn't have any parameters.
(mm-text-html-renderer): Document gnus-article-html.
2010-09-17 Julien Danjou <julien@danjou.info> (tiny fix)
* mm-decode.el (mm-text-html-renderer): Document gnus-article-html.
* dgnushack.el: Define netrc-credentials.
If the user doesn't have a /etc/services, supply some sensible port defaults.
Have `unseen-or-unread' select an unread unseen article first.
(nntp-open-server): Return whether the open was successful or not.
Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ).
Save result so that it doesn't say "failed" all the time.
Add ~/.authinfo to the default, since that's probably most useful for users.
Don't use the "finish" method when we're reading from the agent.
Add some more nnimap-relevant agent stuff to nnagent.el.
* nnimap.el (nnimap-with-process-buffer): Removed.
Revert one line that was changed by mistake in the last checkin.
(nnimap-open-connection): Don't error out when we can't make a connection
nnimap-related changes to avoid bugging out if we can't contact a server.
* gnus-start.el (gnus-get-unread-articles): Don't try to scan groups
from methods that are denied.
* nnimap.el (nnimap-possibly-change-group): Return nil if we can't log
in.
(nnimap-finish-retrieve-group-infos): Make sure we're not waiting for
nothing.
* gnus-sum.el (gnus-select-newsgroup): Indent.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sat, 18 Sep 2010 10:02:19 +0000 |
parents | 1d1d5d9bd884 |
children | 376148b31b5e |
rev | line source |
---|---|
36041 | 1 ;;; shadowfile.el --- automatic file copying |
5119 | 2 |
64762
41bb365f41c4
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64091
diff
changeset
|
3 ;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, |
106815 | 4 ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
13337 | 5 |
25278 | 6 ;; Author: Boris Goldowsky <boris@gnu.org> |
36041 | 7 ;; Keywords: comm files |
13337 | 8 |
9 ;; This file is part of GNU Emacs. | |
5119 | 10 |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
13337 | 12 ;; it under the terms of the GNU General Public License as published by |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
13337 | 15 |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
14169 | 23 |
36041 | 24 ;;; Commentary: |
5119 | 25 |
14169 | 26 ;; This package helps you to keep identical copies of files in more than one |
27 ;; place - possibly on different machines. When you save a file, it checks | |
28 ;; whether it is on the list of files with "shadows", and if so, it tries to | |
85828
04fb80d58b60
(shadow-join): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
29 ;; copy it when you exit Emacs (or use the shadow-copy-files command). |
5119 | 30 |
14169 | 31 ;; Installation & Use: |
32 | |
36041 | 33 ;; Add clusters (if necessary) and file groups with shadow-define-cluster, |
14169 | 34 ;; shadow-define-literal-group, and shadow-define-regexp-group (see the |
36041 | 35 ;; documentation for these functions for information on how and when to use |
36 ;; them). After doing this once, everything should be automatic. | |
5119 | 37 |
14169 | 38 ;; The lists of clusters and shadows are saved in a file called .shadows, |
85828
04fb80d58b60
(shadow-join): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
39 ;; so that they can be remembered from one Emacs session to another, even |
04fb80d58b60
(shadow-join): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
40 ;; (as much as possible) if the Emacs session terminates abnormally. The |
14169 | 41 ;; files needing to be copied are stored in .shadow_todo; if a file cannot |
42 ;; be copied for any reason, it will stay on the list to be tried again | |
43 ;; next time. The .shadows file should itself have shadows on all your | |
44 ;; accounts so that the information in it is consistent everywhere, but | |
45 ;; .shadow_todo is local information and should have no shadows. | |
46 | |
47 ;; If you do not want to copy a particular file, you can answer "no" and | |
85828
04fb80d58b60
(shadow-join): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
48 ;; be asked again next time you hit C-x 4 s or exit Emacs. If you do not |
14169 | 49 ;; want to be asked again, use shadow-cancel, and you will not be asked |
50 ;; until you change the file and save it again. If you do not want to | |
51 ;; shadow that file ever again, you can edit it out of the .shadows | |
52 ;; buffer. Anytime you edit the .shadows buffer, you must type M-x | |
53 ;; shadow-read-files to load in the new information, or your changes will | |
54 ;; be overwritten! | |
5119 | 55 |
14169 | 56 ;; Bugs & Warnings: |
57 ;; | |
58 ;; - It is bad to have two emacses both running shadowfile at the same | |
59 ;; time. It tries to detect this condition, but is not always successful. | |
60 ;; | |
61 ;; - You have to be careful not to edit a file in two locations | |
62 ;; before shadowfile has had a chance to copy it; otherwise | |
63 ;; "updating shadows" will overwrite one of the changed versions. | |
64 ;; | |
65 ;; - It ought to check modification times of both files to make sure | |
66 ;; it is doing the right thing. This will have to wait until | |
67 ;; file-newer-than-file-p works between machines. | |
68 ;; | |
69 ;; - It will not make directories for you, it just fails to copy files | |
70 ;; that belong in non-existent directories. | |
71 ;; | |
25278 | 72 ;; Please report any bugs to me (boris@gnu.org). Also let me know |
14169 | 73 ;; if you have suggestions or would like to be informed of updates. |
5119 | 74 |
36041 | 75 |
5119 | 76 ;;; Code: |
77 | |
78 (require 'ange-ftp) | |
79 | |
80 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
81 ;;; Variables | |
82 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
83 | |
21088 | 84 (defgroup shadow nil |
85 "Automatic file copying when saving a file." | |
86 :prefix "shadow-" | |
36041 | 87 :link '(emacs-commentary-link "shadowfile") |
21088 | 88 :group 'files) |
89 | |
90 (defcustom shadow-noquery nil | |
100171 | 91 "If t, always copy shadow files without asking. |
5288
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
92 If nil \(the default), always ask. If not nil and not t, ask only if there |
21088 | 93 is no buffer currently visiting the file." |
22598
dcb17af08ae0
(shadow-noquery): Use `other' widget type.
Andreas Schwab <schwab@suse.de>
parents:
21408
diff
changeset
|
94 :type '(choice (const t) (const nil) (other :tag "Ask if no buffer" maybe)) |
21088 | 95 :group 'shadow) |
5119 | 96 |
21088 | 97 (defcustom shadow-inhibit-message nil |
100171 | 98 "If non-nil, do not display a message when a file needs copying." |
21088 | 99 :type 'boolean |
100 :group 'shadow) | |
5119 | 101 |
21088 | 102 (defcustom shadow-inhibit-overload nil |
73749
0ccca06d2010
(shadow-define-regexp-group, shadow-literal-groups, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
68651
diff
changeset
|
103 "If non-nil, shadowfile won't redefine \\[save-buffers-kill-emacs]. |
79278
15ad52029dc2
(shadow-inhibit-overload, shadow-remove-from-todo, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
104 Normally it overloads the function `save-buffers-kill-emacs' to check for |
15ad52029dc2
(shadow-inhibit-overload, shadow-remove-from-todo, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
105 files that have been changed and need to be copied to other systems." |
21088 | 106 :type 'boolean |
107 :group 'shadow) | |
5119 | 108 |
21088 | 109 (defcustom shadow-info-file nil |
36041 | 110 "File to keep shadow information in. |
111 The `shadow-info-file' should be shadowed to all your accounts to | |
21088 | 112 ensure consistency. Default: ~/.shadows" |
113 :type '(choice (const nil) file) | |
114 :group 'shadow) | |
5119 | 115 |
21088 | 116 (defcustom shadow-todo-file nil |
5119 | 117 "File to store the list of uncopied shadows in. |
118 This means that if a remote system is down, or for any reason you cannot or | |
36041 | 119 decide not to copy your shadow files at the end of one Emacs session, it will |
120 remember and ask you again in your next Emacs session. | |
5119 | 121 This file must NOT be shadowed to any other system, it is host-specific. |
21088 | 122 Default: ~/.shadow_todo" |
123 :type '(choice (const nil) file) | |
124 :group 'shadow) | |
125 | |
5119 | 126 |
127 ;;; The following two variables should in most cases initialize themselves | |
128 ;;; correctly. They are provided as variables in case the defaults are wrong | |
129 ;;; on your machine \(and for efficiency). | |
130 | |
131 (defvar shadow-system-name (system-name) | |
132 "The complete hostname of this machine.") | |
133 | |
134 (defvar shadow-homedir nil | |
135 "Your home directory on this machine.") | |
136 | |
137 ;;; | |
138 ;;; Internal variables whose values are stored in the info and todo files: | |
139 ;;; | |
140 | |
141 (defvar shadow-clusters nil | |
36041 | 142 "List of host clusters \(see `shadow-define-cluster').") |
5119 | 143 |
144 (defvar shadow-literal-groups nil | |
145 "List of files that are shared between hosts. | |
146 This list contains shadow structures with literal filenames, created by | |
73749
0ccca06d2010
(shadow-define-regexp-group, shadow-literal-groups, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
68651
diff
changeset
|
147 `shadow-define-literal-group'.") |
5119 | 148 |
149 (defvar shadow-regexp-groups nil | |
150 "List of file types that are shared between hosts. | |
36041 | 151 This list contains shadow structures with regexps matching filenames, |
152 created by `shadow-define-regexp-group'.") | |
5119 | 153 |
154 ;;; | |
155 ;;; Other internal variables: | |
156 ;;; | |
157 | |
158 (defvar shadow-files-to-copy nil) ; List of files that need to | |
159 ; be copied to remote hosts. | |
160 | |
161 (defvar shadow-hashtable nil) ; for speed | |
162 | |
163 (defvar shadow-info-buffer nil) ; buf visiting shadow-info-file | |
164 (defvar shadow-todo-buffer nil) ; buf visiting shadow-todo-file | |
165 | |
166 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
167 ;;; Syntactic sugar; General list and string manipulation | |
168 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
169 | |
170 (defun shadow-union (a b) | |
36041 | 171 "Add members of list A to list B if not equal to items already in B." |
5119 | 172 (if (null a) |
173 b | |
174 (if (member (car a) b) | |
175 (shadow-union (cdr a) b) | |
176 (shadow-union (cdr a) (cons (car a) b))))) | |
177 | |
178 (defun shadow-find (func list) | |
73749
0ccca06d2010
(shadow-define-regexp-group, shadow-literal-groups, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
68651
diff
changeset
|
179 "If FUNC applied to some element of LIST is non-nil, return first such element." |
5119 | 180 (while (and list (not (funcall func (car list)))) |
181 (setq list (cdr list))) | |
182 (car list)) | |
183 | |
184 (defun shadow-remove-if (func list) | |
185 "Remove elements satisfying FUNC from LIST. | |
186 Nondestructive; actually returns a copy of the list with the elements removed." | |
187 (if list | |
188 (if (funcall func (car list)) | |
189 (shadow-remove-if func (cdr list)) | |
190 (cons (car list) (shadow-remove-if func (cdr list)))) | |
191 nil)) | |
192 | |
193 (defun shadow-regexp-superquote (string) | |
36041 | 194 "Like `regexp-quote', but includes the ^ and $. |
195 This makes sure regexp matches nothing but STRING." | |
5119 | 196 (concat "^" (regexp-quote string) "$")) |
197 | |
198 (defun shadow-suffix (prefix string) | |
199 "If PREFIX begins STRING, return the rest. | |
73749
0ccca06d2010
(shadow-define-regexp-group, shadow-literal-groups, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
68651
diff
changeset
|
200 Return value is non-nil if PREFIX and STRING are `string=' up to the length of |
5119 | 201 PREFIX." |
202 (let ((lp (length prefix)) | |
203 (ls (length string))) | |
204 (if (and (>= ls lp) | |
205 (string= prefix (substring string 0 lp))) | |
206 (substring string lp)))) | |
207 | |
208 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
209 ;;; Clusters and sites | |
210 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
211 | |
212 ;;; I use the term `site' to refer to a string which may be the name of a | |
213 ;;; cluster or a literal hostname. All user-level commands should accept | |
214 ;;; either. | |
215 | |
216 (defun shadow-make-cluster (name primary regexp) | |
36041 | 217 "Create a shadow cluster. |
218 It is called NAME, uses the PRIMARY hostname and REGEXP matching all | |
219 hosts in the cluster. The variable `shadow-clusters' associates the | |
220 names of clusters to these structures. This function is for program | |
221 use: to create clusters interactively, use `shadow-define-cluster' | |
222 instead." | |
5119 | 223 (list name primary regexp)) |
224 | |
225 (defmacro shadow-cluster-name (cluster) | |
226 "Return the name of the CLUSTER." | |
227 (list 'elt cluster 0)) | |
228 | |
229 (defmacro shadow-cluster-primary (cluster) | |
230 "Return the primary hostname of a CLUSTER." | |
231 (list 'elt cluster 1)) | |
232 | |
233 (defmacro shadow-cluster-regexp (cluster) | |
234 "Return the regexp matching hosts in a CLUSTER." | |
235 (list 'elt cluster 2)) | |
236 | |
237 (defun shadow-set-cluster (name primary regexp) | |
36041 | 238 "Put cluster NAME on the list of clusters. |
239 Replace old definition, if any. PRIMARY and REGEXP are the | |
5119 | 240 information defining the cluster. For interactive use, call |
36041 | 241 `shadow-define-cluster' instead." |
5119 | 242 (let ((rest (shadow-remove-if |
243 (function (lambda (x) (equal name (car x)))) | |
244 shadow-clusters))) | |
36041 | 245 (setq shadow-clusters |
5119 | 246 (cons (shadow-make-cluster name primary regexp) |
247 rest)))) | |
248 | |
249 (defmacro shadow-get-cluster (name) | |
250 "Return cluster named NAME, or nil." | |
251 (list 'assoc name 'shadow-clusters)) | |
252 | |
253 (defun shadow-site-primary (site) | |
254 "If SITE is a cluster, return primary host, otherwise return SITE." | |
255 (let ((c (shadow-get-cluster site))) | |
256 (if c | |
257 (shadow-cluster-primary c) | |
258 site))) | |
259 | |
260 ;;; SITES | |
261 | |
262 (defun shadow-site-cluster (site) | |
36041 | 263 "Given a SITE \(hostname or cluster name), return cluster it is in, or nil." |
5119 | 264 (or (assoc site shadow-clusters) |
265 (shadow-find | |
266 (function (lambda (x) | |
267 (string-match (shadow-cluster-regexp x) | |
268 site))) | |
269 shadow-clusters))) | |
270 | |
271 (defun shadow-read-site () | |
272 "Read a cluster name or hostname from the minibuffer." | |
273 (let ((ans (completing-read "Host or cluster name [RET when done]: " | |
274 shadow-clusters))) | |
275 (if (equal "" ans) | |
276 nil | |
277 ans))) | |
278 | |
279 (defun shadow-site-match (site1 site2) | |
78492
7c8949dbfa0d
Replace `iff' in doc-strings and comments.
Glenn Morris <rgm@gnu.org>
parents:
78236
diff
changeset
|
280 "Non-nil if SITE1 is or includes SITE2. |
73749
0ccca06d2010
(shadow-define-regexp-group, shadow-literal-groups, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
68651
diff
changeset
|
281 Each may be a host or cluster name; if they are clusters, regexp of SITE1 will |
0ccca06d2010
(shadow-define-regexp-group, shadow-literal-groups, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
68651
diff
changeset
|
282 be matched against the primary of SITE2." |
5119 | 283 (or (string-equal site1 site2) ; quick check |
284 (let* ((cluster1 (shadow-get-cluster site1)) | |
285 (primary2 (shadow-site-primary site2))) | |
286 (if cluster1 | |
287 (string-match (shadow-cluster-regexp cluster1) primary2) | |
288 (string-equal site1 primary2))))) | |
289 | |
290 (defun shadow-get-user (site) | |
36041 | 291 "Return the default username for a SITE." |
5119 | 292 (ange-ftp-get-user (shadow-site-primary site))) |
293 | |
294 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
295 ;;; Filename manipulation | |
296 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
297 | |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
298 (defun shadow-parse-fullname (fullname) |
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
299 "Parse FULLNAME into \(site user path) list. |
79278
15ad52029dc2
(shadow-inhibit-overload, shadow-remove-from-todo, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
300 Leave it alone if it already is one. Return nil if the argument is |
36041 | 301 not a full ange-ftp pathname." |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
302 (if (listp fullname) |
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
303 fullname |
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
304 (ange-ftp-ftp-name fullname))) |
5119 | 305 |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
306 (defun shadow-parse-name (name) |
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
307 "Parse any NAME into \(site user name) list. |
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
308 Argument can be a simple name, full ange-ftp name, or already a hup list." |
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
309 (or (shadow-parse-fullname name) |
5119 | 310 (list shadow-system-name |
311 (user-login-name) | |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
312 name))) |
5119 | 313 |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
314 (defsubst shadow-make-fullname (host user name) |
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
315 "Make an ange-ftp style fullname out of HOST, USER (optional), and NAME. |
5119 | 316 This is probably not as general as it ought to be." |
36041 | 317 (concat "/" |
5119 | 318 (if user (concat user "@")) |
319 host ":" | |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
320 name)) |
5119 | 321 |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
322 (defun shadow-replace-name-component (fullname newname) |
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
323 "Return FULLNAME with the name component changed to NEWNAME." |
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
324 (let ((hup (shadow-parse-fullname fullname))) |
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
325 (shadow-make-fullname (nth 0 hup) (nth 1 hup) newname))) |
5119 | 326 |
327 (defun shadow-local-file (file) | |
36041 | 328 "If FILE is at this site, remove /user@host part. |
329 If refers to a different system or a different user on this system, | |
330 return nil." | |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
331 (let ((hup (shadow-parse-fullname file))) |
5119 | 332 (cond ((null hup) file) |
333 ((and (shadow-site-match (nth 0 hup) shadow-system-name) | |
334 (string-equal (nth 1 hup) (user-login-name))) | |
335 (nth 2 hup)) | |
336 (t nil)))) | |
337 | |
338 (defun shadow-expand-cluster-in-file-name (file) | |
36041 | 339 "If hostname part of FILE is a cluster, expand it to cluster's primary hostname. |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
340 Will return the name bare if it is a local file." |
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
341 (let ((hup (shadow-parse-name file)) |
5119 | 342 cluster) |
343 (cond ((null hup) file) | |
344 ((shadow-local-file hup)) | |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
345 ((shadow-make-fullname (shadow-site-primary (nth 0 hup)) |
5119 | 346 (nth 1 hup) |
347 (nth 2 hup)))))) | |
348 | |
349 (defun shadow-expand-file-name (file &optional default) | |
73749
0ccca06d2010
(shadow-define-regexp-group, shadow-literal-groups, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
68651
diff
changeset
|
350 "Expand file name and get FILE's true name." |
5119 | 351 (file-truename (expand-file-name file default))) |
352 | |
353 (defun shadow-contract-file-name (file) | |
36041 | 354 "Simplify FILE. |
355 Do so by replacing (when possible) home directory with ~, and hostname | |
356 with cluster name that includes it. Filename should be absolute and | |
357 true." | |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
358 (let* ((hup (shadow-parse-name file)) |
5119 | 359 (homedir (if (shadow-local-file hup) |
360 shadow-homedir | |
361 (file-name-as-directory | |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
362 (nth 2 (shadow-parse-fullname |
5119 | 363 (expand-file-name |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
364 (shadow-make-fullname |
5119 | 365 (nth 0 hup) (nth 1 hup) "~"))))))) |
366 (suffix (shadow-suffix homedir (nth 2 hup))) | |
367 (cluster (shadow-site-cluster (nth 0 hup)))) | |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
368 (shadow-make-fullname |
5119 | 369 (if cluster |
370 (shadow-cluster-name cluster) | |
371 (nth 0 hup)) | |
372 (nth 1 hup) | |
36041 | 373 (if suffix |
5119 | 374 (concat "~/" suffix) |
375 (nth 2 hup))))) | |
376 | |
377 (defun shadow-same-site (pattern file) | |
378 "True if the site of PATTERN and of FILE are on the same site. | |
379 If usernames are supplied, they must also match exactly. PATTERN and FILE may | |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
380 be lists of host, user, name, or ange-ftp file names. FILE may also be just a |
5119 | 381 local filename." |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
382 (let ((pattern-sup (shadow-parse-fullname pattern)) |
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
383 (file-sup (shadow-parse-name file))) |
5119 | 384 (and |
385 (shadow-site-match (nth 0 pattern-sup) (nth 0 file-sup)) | |
386 (or (null (nth 1 pattern-sup)) | |
387 (string-equal (nth 1 pattern-sup) (nth 1 file-sup)))))) | |
388 | |
389 (defun shadow-file-match (pattern file &optional regexp) | |
36041 | 390 "Return t if PATTERN matches FILE. |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
391 If REGEXP is supplied and non-nil, the file part of the pattern is a regular |
5119 | 392 expression, otherwise it must match exactly. The sites and usernames must |
79278
15ad52029dc2
(shadow-inhibit-overload, shadow-remove-from-todo, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
393 match---see `shadow-same-site'. The pattern must be in full ange-ftp format, |
15ad52029dc2
(shadow-inhibit-overload, shadow-remove-from-todo, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
394 but the file can be any valid filename. This function does not do any |
15ad52029dc2
(shadow-inhibit-overload, shadow-remove-from-todo, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
395 filename expansion or contraction, you must do that yourself first." |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
396 (let* ((pattern-sup (shadow-parse-fullname pattern)) |
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
397 (file-sup (shadow-parse-name file))) |
5119 | 398 (and (shadow-same-site pattern-sup file-sup) |
36041 | 399 (if regexp |
5119 | 400 (string-match (nth 2 pattern-sup) (nth 2 file-sup)) |
401 (string-equal (nth 2 pattern-sup) (nth 2 file-sup)))))) | |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43971
diff
changeset
|
402 |
5119 | 403 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
404 ;;; User-level Commands | |
405 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
406 | |
36041 | 407 ;;;###autoload |
5119 | 408 (defun shadow-define-cluster (name) |
36041 | 409 "Edit \(or create) the definition of a cluster NAME. |
5119 | 410 This is a group of hosts that share directories, so that copying to or from |
411 one of them is sufficient to update the file on all of them. Clusters are | |
412 defined by a name, the network address of a primary host \(the one we copy | |
79278
15ad52029dc2
(shadow-inhibit-overload, shadow-remove-from-todo, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
413 files to), and a regular expression that matches the hostnames of all the |
15ad52029dc2
(shadow-inhibit-overload, shadow-remove-from-todo, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
414 sites in the cluster." |
5119 | 415 (interactive (list (completing-read "Cluster name: " shadow-clusters () ()))) |
416 (let* ((old (shadow-get-cluster name)) | |
417 (primary (read-string "Primary host: " | |
36041 | 418 (if old (shadow-cluster-primary old) |
5119 | 419 name))) |
420 (regexp (let (try-regexp) | |
421 (while (not | |
36041 | 422 (string-match |
5119 | 423 (setq try-regexp |
36041 | 424 (read-string |
5119 | 425 "Regexp matching all host names: " |
426 (if old (shadow-cluster-regexp old) | |
427 (shadow-regexp-superquote primary)))) | |
428 primary)) | |
429 (message "Regexp doesn't include the primary host!") | |
430 (sit-for 2)) | |
431 try-regexp)) | |
36041 | 432 ; (username (read-no-blanks-input |
65680
ed770a0a7846
2005-09-24 Emilio C. Lopes <eclig@gmx.net>
Romain Francoise <romain@orebokech.com>
parents:
64762
diff
changeset
|
433 ; (format "Username (default %s): " |
5119 | 434 ; (shadow-get-user primary)) |
435 ; (if old (or (shadow-cluster-username old) "") | |
436 ; (user-login-name)))) | |
437 ) | |
438 ; (if (string-equal "" username) (setq username nil)) | |
439 (shadow-set-cluster name primary regexp))) | |
440 | |
36041 | 441 ;;;###autoload |
5119 | 442 (defun shadow-define-literal-group () |
443 "Declare a single file to be shared between sites. | |
444 It may have different filenames on each site. When this file is edited, the | |
445 new version will be copied to each of the other locations. Sites can be | |
36041 | 446 specific hostnames, or names of clusters \(see `shadow-define-cluster')." |
5119 | 447 (interactive) |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
448 (let* ((hup (shadow-parse-fullname |
5119 | 449 (shadow-contract-file-name (buffer-file-name)))) |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
450 (name (nth 2 hup)) |
5119 | 451 user site group) |
452 (while (setq site (shadow-read-site)) | |
65680
ed770a0a7846
2005-09-24 Emilio C. Lopes <eclig@gmx.net>
Romain Francoise <romain@orebokech.com>
parents:
64762
diff
changeset
|
453 (setq user (read-string (format "Username (default %s): " |
5119 | 454 (shadow-get-user site))) |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
455 name (read-string "Filename: " name)) |
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
456 (setq group (cons (shadow-make-fullname site |
5119 | 457 (if (string-equal "" user) |
458 (shadow-get-user site) | |
459 user) | |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
460 name) |
5119 | 461 group))) |
462 (setq shadow-literal-groups (cons group shadow-literal-groups))) | |
463 (shadow-write-info-file)) | |
464 | |
36041 | 465 ;;;###autoload |
5119 | 466 (defun shadow-define-regexp-group () |
467 "Make each of a group of files be shared between hosts. | |
468 Prompts for regular expression; files matching this are shared between a list | |
36041 | 469 of sites, which are also prompted for. The filenames must be identical on all |
79278
15ad52029dc2
(shadow-inhibit-overload, shadow-remove-from-todo, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
470 hosts \(if they aren't, use `shadow-define-literal-group' instead of this |
15ad52029dc2
(shadow-inhibit-overload, shadow-remove-from-todo, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
471 function). Each site can be either a hostname or the name of a cluster \(see |
36041 | 472 `shadow-define-cluster')." |
5119 | 473 (interactive) |
36041 | 474 (let ((regexp (read-string |
475 "Filename regexp: " | |
5119 | 476 (if (buffer-file-name) |
477 (shadow-regexp-superquote | |
478 (nth 2 | |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
479 (shadow-parse-name |
5119 | 480 (shadow-contract-file-name |
481 (buffer-file-name)))))))) | |
482 site sites usernames) | |
483 (while (setq site (shadow-read-site)) | |
484 (setq sites (cons site sites)) | |
36041 | 485 (setq usernames |
5119 | 486 (cons (read-string (format "Username for %s: " site) |
487 (shadow-get-user site)) | |
488 usernames))) | |
36041 | 489 (setq shadow-regexp-groups |
5119 | 490 (cons (shadow-make-group regexp sites usernames) |
491 shadow-regexp-groups)) | |
492 (shadow-write-info-file))) | |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43971
diff
changeset
|
493 |
5119 | 494 (defun shadow-shadows () |
495 ;; Mostly for debugging. | |
496 "Interactive function to display shadows of a buffer." | |
497 (interactive) | |
85828
04fb80d58b60
(shadow-join): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
498 (let ((msg (mapconcat #'cdr (shadow-shadows-of (buffer-file-name)) " "))) |
14349
96692e2ba103
(shadow-shadows, shadow-add-to-todo): Pass proper format string to message.
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
499 (message "%s" |
36041 | 500 (if (zerop (length msg)) |
5119 | 501 "No shadows." |
502 msg)))) | |
503 | |
504 (defun shadow-copy-files (&optional arg) | |
505 "Copy all pending shadow files. | |
506 With prefix argument, copy all pending files without query. | |
36041 | 507 Pending copies are stored in variable `shadow-files-to-copy', and in |
508 `shadow-todo-file' if necessary. This function is invoked by | |
509 `shadow-save-buffers-kill-emacs', so it is not usually necessary to | |
5119 | 510 call it manually." |
511 (interactive "P") | |
57748
a5bb249b0f3b
(shadow-copy-files): Use interactive-p
Richard M. Stallman <rms@gnu.org>
parents:
57544
diff
changeset
|
512 (if (not shadow-files-to-copy) |
105372
bd2966850aac
Use `called-interactively-p' instead of `interactive-p'.
Juanma Barranquero <lekktu@gmail.com>
parents:
100908
diff
changeset
|
513 (if (called-interactively-p 'interactive) |
57748
a5bb249b0f3b
(shadow-copy-files): Use interactive-p
Richard M. Stallman <rms@gnu.org>
parents:
57544
diff
changeset
|
514 (message "No files need to be shadowed.")) |
5119 | 515 (save-excursion |
516 (map-y-or-n-p (function | |
517 (lambda (pair) | |
5288
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
518 (or arg shadow-noquery |
5119 | 519 (format "Copy shadow file %s? " (cdr pair))))) |
520 (function shadow-copy-file) | |
521 shadow-files-to-copy | |
522 '("shadow" "shadows" "copy")) | |
523 (shadow-write-todo-file t)))) | |
524 | |
525 (defun shadow-cancel () | |
526 "Cancel the instruction to copy some files. | |
527 Prompts for which copy operations to cancel. You will not be asked to copy | |
528 them again, unless you make more changes to the files. To cancel a shadow | |
36041 | 529 permanently, remove the group from `shadow-literal-groups' or |
530 `shadow-regexp-groups'." | |
5119 | 531 (interactive) |
532 (map-y-or-n-p (function (lambda (pair) | |
36041 | 533 (format "Cancel copying %s to %s? " |
5119 | 534 (car pair) (cdr pair)))) |
36041 | 535 (function (lambda (pair) |
5119 | 536 (shadow-remove-from-todo pair))) |
537 shadow-files-to-copy | |
538 '("shadow" "shadows" "cancel copy")) | |
36041 | 539 (message "There are %d shadows to be updated." |
14349
96692e2ba103
(shadow-shadows, shadow-add-to-todo): Pass proper format string to message.
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
540 (length shadow-files-to-copy)) |
5119 | 541 (shadow-write-todo-file)) |
542 | |
543 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
544 ;;; Internal functions | |
545 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
546 | |
547 (defun shadow-make-group (regexp sites usernames) | |
36041 | 548 "Make a description of a file group--- |
5119 | 549 actually a list of regexp ange-ftp file names---from REGEXP \(name of file to |
550 be shadowed), list of SITES, and corresponding list of USERNAMES for each | |
551 site." | |
552 (if sites | |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
553 (cons (shadow-make-fullname (car sites) (car usernames) regexp) |
5119 | 554 (shadow-make-group regexp (cdr sites) (cdr usernames))) |
555 nil)) | |
556 | |
557 (defun shadow-copy-file (s) | |
558 "Copy one shadow file." | |
36041 | 559 (let* ((buffer |
560 (cond ((get-file-buffer | |
5288
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
561 (abbreviate-file-name (shadow-expand-file-name (car s))))) |
5119 | 562 ((not (file-readable-p (car s))) |
563 (if (y-or-n-p | |
36041 | 564 (format "Cannot find file %s--cancel copy request? " |
5119 | 565 (car s))) |
566 (shadow-remove-from-todo s)) | |
567 nil) | |
5288
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
568 ((or (eq t shadow-noquery) |
36041 | 569 (y-or-n-p |
570 (format "No buffer for %s -- update shadow anyway? " | |
5288
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
571 (car s)))) |
5119 | 572 (find-file-noselect (car s))))) |
573 (to (shadow-expand-cluster-in-file-name (cdr s)))) | |
27685 | 574 (when buffer |
5119 | 575 (set-buffer buffer) |
95366
52e3cee99f90
* progmodes/flymake.el (flymake-save-buffer-in-file):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
576 (condition-case i |
100645
4caea5d62b15
(shadow-copy-file): Handle buffer-swapped-with.
Richard M. Stallman <rms@gnu.org>
parents:
100171
diff
changeset
|
577 (progn |
100680
10bc85aa8a95
(shadow-copy-file): Revert previous change.
Richard M. Stallman <rms@gnu.org>
parents:
100645
diff
changeset
|
578 (write-region nil nil to) |
95366
52e3cee99f90
* progmodes/flymake.el (flymake-save-buffer-in-file):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
579 (shadow-remove-from-todo s)) |
52e3cee99f90
* progmodes/flymake.el (flymake-save-buffer-in-file):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94678
diff
changeset
|
580 (error (message "Shadow %s not updated!" (cdr s))))))) |
5119 | 581 |
582 (defun shadow-shadows-of (file) | |
36041 | 583 "Return copy operations needed to update FILE. |
584 Filename should have clusters expanded, but otherwise can have any format. | |
5119 | 585 Return value is a list of dotted pairs like \(from . to), where from |
586 and to are absolute file names." | |
587 (or (symbol-value (intern-soft file shadow-hashtable)) | |
588 (let* ((absolute-file (shadow-expand-file-name | |
589 (or (shadow-local-file file) file) | |
590 shadow-homedir)) | |
591 (canonical-file (shadow-contract-file-name absolute-file)) | |
36041 | 592 (shadows |
5119 | 593 (mapcar (function (lambda (shadow) |
594 (cons absolute-file shadow))) | |
595 (append | |
596 (shadow-shadows-of-1 | |
597 canonical-file shadow-literal-groups nil) | |
598 (shadow-shadows-of-1 | |
599 canonical-file shadow-regexp-groups t))))) | |
600 (set (intern file shadow-hashtable) shadows)))) | |
601 | |
602 (defun shadow-shadows-of-1 (file groups regexp) | |
36041 | 603 "Return list of FILE's shadows in GROUPS. |
604 Consider them as regular expressions if third arg REGEXP is true." | |
5119 | 605 (if groups |
606 (let ((nonmatching | |
36041 | 607 (shadow-remove-if |
5119 | 608 (function (lambda (x) (shadow-file-match x file regexp))) |
609 (car groups)))) | |
610 (append (cond ((equal nonmatching (car groups)) nil) | |
36041 | 611 (regexp |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
612 (let ((realname (nth 2 (shadow-parse-fullname file)))) |
36041 | 613 (mapcar |
614 (function | |
615 (lambda (x) | |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
616 (shadow-replace-name-component x realname))) |
5119 | 617 nonmatching))) |
618 (t nonmatching)) | |
619 (shadow-shadows-of-1 file (cdr groups) regexp))))) | |
620 | |
621 (defun shadow-add-to-todo () | |
36041 | 622 "If current buffer has shadows, add them to the list needing to be copied." |
623 (let ((shadows (shadow-shadows-of | |
624 (shadow-expand-file-name | |
5119 | 625 (buffer-file-name (current-buffer)))))) |
27685 | 626 (when shadows |
5119 | 627 (setq shadow-files-to-copy |
628 (shadow-union shadows shadow-files-to-copy)) | |
27685 | 629 (when (not shadow-inhibit-message) |
14349
96692e2ba103
(shadow-shadows, shadow-add-to-todo): Pass proper format string to message.
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
630 (message "%s" (substitute-command-keys |
96692e2ba103
(shadow-shadows, shadow-add-to-todo): Pass proper format string to message.
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
631 "Use \\[shadow-copy-files] to update shadows.")) |
5119 | 632 (sit-for 1)) |
633 (shadow-write-todo-file))) | |
85828
04fb80d58b60
(shadow-join): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
634 nil) ; Return nil for write-file-functions |
5119 | 635 |
636 (defun shadow-remove-from-todo (pair) | |
36041 | 637 "Remove PAIR from `shadow-files-to-copy'. |
79278
15ad52029dc2
(shadow-inhibit-overload, shadow-remove-from-todo, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
638 PAIR must be `eq' to one of the elements of that list." |
36041 | 639 (setq shadow-files-to-copy |
5119 | 640 (shadow-remove-if (function (lambda (s) (eq s pair))) |
641 shadow-files-to-copy))) | |
642 | |
643 (defun shadow-read-files () | |
36041 | 644 "Visit and load `shadow-info-file' and `shadow-todo-file'. |
645 Thus restores shadowfile's state from your last Emacs session. | |
79278
15ad52029dc2
(shadow-inhibit-overload, shadow-remove-from-todo, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
646 Return t unless files were locked; then return nil." |
5119 | 647 (interactive) |
5288
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
648 (if (and (fboundp 'file-locked-p) |
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
649 (or (stringp (file-locked-p shadow-info-file)) |
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
650 (stringp (file-locked-p shadow-todo-file)))) |
5119 | 651 (progn |
73749
0ccca06d2010
(shadow-define-regexp-group, shadow-literal-groups, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
68651
diff
changeset
|
652 (message "Shadowfile is running in another Emacs; can't have two.") |
5119 | 653 (beep) |
654 (sit-for 3) | |
655 nil) | |
656 (save-excursion | |
27685 | 657 (when shadow-info-file |
5119 | 658 (set-buffer (setq shadow-info-buffer |
659 (find-file-noselect shadow-info-file))) | |
27685 | 660 (when (and (not (buffer-modified-p)) |
661 (file-newer-than-file-p (make-auto-save-file-name) | |
662 shadow-info-file)) | |
5119 | 663 (erase-buffer) |
36041 | 664 (message "Data recovered from %s." |
5119 | 665 (car (insert-file-contents (make-auto-save-file-name)))) |
666 (sit-for 1)) | |
62459
b89461946700
Replace `eval-current-buffer' by `eval-buffer'.
Juanma Barranquero <lekktu@gmail.com>
parents:
57748
diff
changeset
|
667 (eval-buffer)) |
27685 | 668 (when shadow-todo-file |
36041 | 669 (set-buffer (setq shadow-todo-buffer |
5119 | 670 (find-file-noselect shadow-todo-file))) |
27685 | 671 (when (and (not (buffer-modified-p)) |
672 (file-newer-than-file-p (make-auto-save-file-name) | |
673 shadow-todo-file)) | |
5119 | 674 (erase-buffer) |
36041 | 675 (message "Data recovered from %s." |
5119 | 676 (car (insert-file-contents (make-auto-save-file-name)))) |
677 (sit-for 1)) | |
62459
b89461946700
Replace `eval-current-buffer' by `eval-buffer'.
Juanma Barranquero <lekktu@gmail.com>
parents:
57748
diff
changeset
|
678 (eval-buffer nil)) |
5119 | 679 (shadow-invalidate-hashtable)) |
680 t)) | |
681 | |
682 (defun shadow-write-info-file () | |
36041 | 683 "Write out information to `shadow-info-file'. |
684 Also clear `shadow-hashtable', since when there are new shadows | |
685 defined, the old hashtable info is invalid." | |
5119 | 686 (shadow-invalidate-hashtable) |
687 (if shadow-info-file | |
688 (save-excursion | |
689 (if (not shadow-info-buffer) | |
690 (setq shadow-info-buffer (find-file-noselect shadow-info-file))) | |
691 (set-buffer shadow-info-buffer) | |
692 (delete-region (point-min) (point-max)) | |
693 (shadow-insert-var 'shadow-clusters) | |
694 (shadow-insert-var 'shadow-literal-groups) | |
695 (shadow-insert-var 'shadow-regexp-groups)))) | |
696 | |
697 (defun shadow-write-todo-file (&optional save) | |
73749
0ccca06d2010
(shadow-define-regexp-group, shadow-literal-groups, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
68651
diff
changeset
|
698 "Write out information to `shadow-todo-file'. |
0ccca06d2010
(shadow-define-regexp-group, shadow-literal-groups, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
68651
diff
changeset
|
699 With non-nil argument also saves the buffer." |
5119 | 700 (save-excursion |
701 (if (not shadow-todo-buffer) | |
702 (setq shadow-todo-buffer (find-file-noselect shadow-todo-file))) | |
703 (set-buffer shadow-todo-buffer) | |
704 (delete-region (point-min) (point-max)) | |
705 (shadow-insert-var 'shadow-files-to-copy) | |
706 (if save (shadow-save-todo-file)))) | |
707 | |
708 (defun shadow-save-todo-file () | |
709 (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer)) | |
105994
009383a57ce8
* x-dnd.el (x-dnd-maybe-call-test-function):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105372
diff
changeset
|
710 (with-current-buffer shadow-todo-buffer |
36041 | 711 (condition-case nil ; have to continue even in case of |
5119 | 712 (basic-save-buffer) ; error, otherwise kill-emacs might |
713 (error ; not work! | |
714 (message "WARNING: Can't save shadow todo file; it is locked!") | |
715 (sit-for 1)))))) | |
716 | |
717 (defun shadow-invalidate-hashtable () | |
718 (setq shadow-hashtable (make-vector 37 0))) | |
719 | |
720 (defun shadow-insert-var (variable) | |
79278
15ad52029dc2
(shadow-inhibit-overload, shadow-remove-from-todo, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
721 "Build a `setq' to restore VARIABLE. |
15ad52029dc2
(shadow-inhibit-overload, shadow-remove-from-todo, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
722 Prettily insert a `setq' command which, when later evaluated, |
15ad52029dc2
(shadow-inhibit-overload, shadow-remove-from-todo, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
723 will restore VARIABLE to its current setting. |
73749
0ccca06d2010
(shadow-define-regexp-group, shadow-literal-groups, shadow-insert-var):
Juanma Barranquero <lekktu@gmail.com>
parents:
68651
diff
changeset
|
724 VARIABLE must be the name of a variable whose value is a list." |
5119 | 725 (let ((standard-output (current-buffer))) |
726 (insert (format "(setq %s" variable)) | |
727 (cond ((consp (eval variable)) | |
36041 | 728 (insert "\n '(") |
5119 | 729 (prin1 (car (eval variable))) |
730 (let ((rest (cdr (eval variable)))) | |
731 (while rest | |
732 (insert "\n ") | |
733 (prin1 (car rest)) | |
734 (setq rest (cdr rest))) | |
735 (insert "))\n\n"))) | |
736 (t (insert " ") | |
737 (prin1 (eval variable)) | |
738 (insert ")\n\n"))))) | |
739 | |
740 (defun shadow-save-buffers-kill-emacs (&optional arg) | |
741 "Offer to save each buffer and copy shadows, then kill this Emacs process. | |
742 With prefix arg, silently save all file-visiting buffers, then kill. | |
743 | |
744 Extended by shadowfile to automatically save `shadow-todo-file' and | |
745 look for files that have been changed and need to be copied to other systems." | |
746 ;; This function is necessary because we need to get control and save | |
747 ;; the todo file /after/ saving other files, but /before/ the warning | |
748 ;; message about unsaved buffers (because it can get modified by the | |
749 ;; action of saving other buffers). `kill-emacs-hook' is no good | |
750 ;; because it is not called at the correct time, and also because it is | |
751 ;; called when the terminal is disconnected and we cannot ask whether | |
752 ;; to copy files. | |
753 (interactive "P") | |
754 (shadow-save-todo-file) | |
755 (save-some-buffers arg t) | |
756 (shadow-copy-files) | |
757 (shadow-save-todo-file) | |
758 (and (or (not (memq t (mapcar (function | |
759 (lambda (buf) (and (buffer-file-name buf) | |
760 (buffer-modified-p buf)))) | |
761 (buffer-list)))) | |
762 (yes-or-no-p "Modified buffers exist; exit anyway? ")) | |
763 (or (not (fboundp 'process-list)) | |
97142 | 764 ;; process-list is not defined on MSDOS. |
5119 | 765 (let ((processes (process-list)) |
766 active) | |
767 (while processes | |
43971 | 768 (and (memq (process-status (car processes)) '(run stop open listen)) |
769 (process-query-on-exit-flag (car processes)) | |
5119 | 770 (setq active t)) |
771 (setq processes (cdr processes))) | |
772 (or (not active) | |
773 (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))) | |
774 (kill-emacs))) | |
775 | |
776 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
36041 | 777 ;;; Lucid Emacs compatibility |
5119 | 778 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
779 | |
5288
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
780 ;; This is on hold until someone tells me about a working version of |
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
781 ;; map-ynp for Lucid Emacs. |
5119 | 782 |
27685 | 783 ;(when (string-match "Lucid" emacs-version) |
5288
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
784 ; (require 'symlink-fix) |
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
785 ; (require 'ange-ftp) |
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
786 ; (require 'map-ynp) |
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
787 ; (if (not (fboundp 'file-truename)) |
36041 | 788 ; (fset 'shadow-expand-file-name |
5288
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
789 ; (symbol-function 'symlink-expand-file-name))) |
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
790 ; (if (not (fboundp 'ange-ftp-ftp-name)) |
c32c5d1aa89d
(shadow-noquery): Use it.
Richard M. Stallman <rms@gnu.org>
parents:
5119
diff
changeset
|
791 ; (fset 'ange-ftp-ftp-name |
50426
23d82f089582
(shadow-parse-fullname): Renamed from shadow-parse-fullpath.
Richard M. Stallman <rms@gnu.org>
parents:
49597
diff
changeset
|
792 ; (symbol-function 'ange-ftp-ftp-name)))) |
5119 | 793 |
794 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
795 ;;; Hook us up | |
796 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
797 | |
36041 | 798 ;;;###autoload |
5119 | 799 (defun shadow-initialize () |
36041 | 800 "Set up file shadowing." |
801 (interactive) | |
5119 | 802 (if (null shadow-homedir) |
803 (setq shadow-homedir | |
804 (file-name-as-directory (shadow-expand-file-name "~")))) | |
805 (if (null shadow-info-file) | |
36041 | 806 (setq shadow-info-file |
98867
6e47884b9b26
(shadow-initialize) <shadow-info-file, shadow-todo-file>: Run file names
Eli Zaretskii <eliz@gnu.org>
parents:
97142
diff
changeset
|
807 (shadow-expand-file-name (convert-standard-filename "~/.shadows")))) |
5119 | 808 (if (null shadow-todo-file) |
36041 | 809 (setq shadow-todo-file |
98867
6e47884b9b26
(shadow-initialize) <shadow-info-file, shadow-todo-file>: Run file names
Eli Zaretskii <eliz@gnu.org>
parents:
97142
diff
changeset
|
810 (shadow-expand-file-name |
6e47884b9b26
(shadow-initialize) <shadow-info-file, shadow-todo-file>: Run file names
Eli Zaretskii <eliz@gnu.org>
parents:
97142
diff
changeset
|
811 (convert-standard-filename "~/.shadow_todo")))) |
5119 | 812 (if (not (shadow-read-files)) |
813 (progn | |
814 (message "Shadowfile information files not found - aborting") | |
815 (beep) | |
816 (sit-for 3)) | |
27685 | 817 (when (and (not shadow-inhibit-overload) |
818 (not (fboundp 'shadow-orig-save-buffers-kill-emacs))) | |
36041 | 819 (defalias 'shadow-orig-save-buffers-kill-emacs |
820 (symbol-function 'save-buffers-kill-emacs)) | |
821 (defalias 'save-buffers-kill-emacs 'shadow-save-buffers-kill-emacs)) | |
85828
04fb80d58b60
(shadow-join): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
822 (add-hook 'write-file-functions 'shadow-add-to-todo) |
5119 | 823 (define-key ctl-x-4-map "s" 'shadow-copy-files))) |
824 | |
85828
04fb80d58b60
(shadow-join): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
825 (defun shadowfile-unload-function () |
04fb80d58b60
(shadow-join): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
826 (substitute-key-definition 'shadow-copy-files nil ctl-x-4-map) |
04fb80d58b60
(shadow-join): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
827 (when (fboundp 'shadow-orig-save-buffers-kill-emacs) |
04fb80d58b60
(shadow-join): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
828 (fset 'save-buffers-kill-emacs |
04fb80d58b60
(shadow-join): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
829 (symbol-function 'shadow-orig-save-buffers-kill-emacs))) |
04fb80d58b60
(shadow-join): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
830 ;; continue standard unloading |
04fb80d58b60
(shadow-join): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
78492
diff
changeset
|
831 nil) |
57544
9eb4eed0a14c
(shadowfile-unload-hook): Set as variable w/ add-hook.
Richard M. Stallman <rms@gnu.org>
parents:
52401
diff
changeset
|
832 |
36041 | 833 (provide 'shadowfile) |
834 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
835 ;; arch-tag: e2f4cdd7-2bab-4def-9130-9e69b412b79e |
5119 | 836 ;;; shadowfile.el ends here |