/[meta-cvs]/meta-cvs/F-5E30677BF94A6FA7AD45BAA270984CFA.lisp
ViewVC logotype

Contents of /meta-cvs/F-5E30677BF94A6FA7AD45BAA270984CFA.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.2.1 - (show annotations)
Sun Oct 27 00:25:39 2002 UTC (11 years, 5 months ago) by kaz
Branch: mcvs-1-0-branch
Changes since 1.1: +62 -0 lines
New link command for creating symlinks.

* mcvs-main.lisp (*link-options*): New option constant.
(*mcvs-command-table*): Entries for new command added.
(*usage*): Help text added.

* link.lisp: New file.
(mcvs-link, mcvs-link-wrapper): New functions.
1 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
4
5 (require "system")
6 (require "mapping")
7 (require "chatter")
8 (provide "link")
9
10 (defun mcvs-link (target name)
11 (in-sandbox-root-dir
12 (let ((mapping (mapping-read *mcvs-map*))
13 (name (real-to-abstract-path (sandbox-translate-path name))))
14 (let ((existing (mapping-lookup mapping name))
15 (need-new-entry t))
16 (chatter-debug "Synchronizing.~%")
17 (mapping-synchronize)
18 (when existing
19 (with-slots (path kind (tgt target)) existing
20 (chatter-debug "Clobbering existing object.~%")
21 (unlink (abstract-to-real-path path))
22 (cond
23 ((eq kind :symlink)
24 (chatter-debug "Editing existing link.~%")
25 (setf tgt target)
26 (setf need-new-entry nil)
27 (symlink target (abstract-to-real-path path)))
28 (t (setf mapping
29 (remove name mapping
30 :test #'path-equal
31 :key #'mapping-entry-path))))))
32 (when need-new-entry
33 (push (make-mapping-entry :kind :symlink
34 :id (mapping-generate-id :no-dir t :prefix "S-")
35 :path name
36 :target target)
37 mapping))
38 (mapping-write mapping *mcvs-map* :sort-map t)
39 (chatter-debug "Updating file structure.~%")
40 (mapping-update))))
41 (values))
42
43 (defun mcvs-link-wrapper (global-options command-options args)
44 (declare (ignore global-options command-options))
45 (when (/= (length args) 2)
46 (error "specify link target and link name."))
47 (mcvs-link (first args) (second args)))
48
49 (defconstant *link-help*
50 "Syntax:
51
52 mcvs link target-path name
53
54 Semantics:
55
56 Create a symbolic link with the given, pointing to the given target path.
57 Note the braindamaged reverse syntax, which is designed to be consistent
58 with the Unix ``ln'' command. To make the symbolic link @foo -> bar,
59 use ``mcvs ln bar foo''.
60
61 Another way to add links is to create a symlink, and then use the add
62 command.")

  ViewVC Help
Powered by ViewVC 1.1.5