/[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 - (hide 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 kaz 1.1.2.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