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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by kaz, Sun Oct 27 00:25:39 2002 UTC revision 1.1.2.1 by kaz, Sun Oct 27 00:25:39 2002 UTC
# Line 0  Line 1 
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.")

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.1.2.1

  ViewVC Help
Powered by ViewVC 1.1.5