home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / interfaces / rcs-supt.el < prev    next >
Encoding:
Text File  |  1990-07-22  |  2.7 KB  |  81 lines
  1. ;From ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!tut.cis.ohio-state.edu!LINUS.MITRE.ORG!guttman Mon Mar  5 09:12:10 1990
  2. ;Article 785 of gnu.emacs.bug:
  3. ;Path: ark1!uakari.primate.wisc.edu!zaphod.mps.ohio-state.edu!tut.cis.ohio-state.edu!LINUS.MITRE.ORG!guttman
  4. ;>From guttman@LINUS.MITRE.ORG
  5. ;Newsgroups: gnu.emacs.bug
  6. ;Subject: Re: RCS mode for gnu emacs ?
  7. ;Message-ID: <9003021409.AA04545@darjeeling.mitre.org>
  8. ;Date: 2 Mar 90 14:09:36 GMT
  9. ;References: <9003011616.AA23343@life.ai.mit.edu>
  10. ;Sender: daemon@tut.cis.ohio-state.edu
  11. ;Distribution: gnu
  12. ;Organization: GNUs Not Usenet
  13. ;Lines: 64
  14. ;
  15. ;I use the enclosed.  It's not super sophisticated, but it works, and you can
  16. ;improve it if you need more.
  17. ;
  18. ;    Josh
  19. ;
  20. ;~~~~~~~~~~~~~~~~
  21.  
  22. ;; file el/rcs-support.el
  23. ;;
  24. ;;; Provide support by checking out files when needed, either with a lock or
  25. ;;; for read-only, and checking them back in, if necessary before emacs exits.
  26.  
  27. (require 'shell)
  28.  
  29. (defvar *rcs-file-read-only* nil)
  30.  
  31. (defun rcs-find-file-noselect (name &optional path)
  32.   "Check out and visit current revision of NAME in current default directory.  
  33. Search PATH and PATH/RCS for RCS file named NAME or NAME,v."
  34.   (let ((rcs-name (if (string-match ",v$" name)
  35.               name
  36.             (concat name ",v")))
  37.     (rcs-path (if (string-match "RCS/$" path)
  38.               path
  39.             (concat path "RCS/"))))    
  40.     (cond ((and (file-exists-p name)
  41.         (file-writable-p name)))
  42.       ((file-exists-p (concat path rcs-name))
  43.        (call-co (concat path rcs-name) default-directory))
  44.       ((file-exists-p (concat rcs-path rcs-name))
  45.        (call-co (concat rcs-path rcs-name) default-directory))
  46.       (t (error "RCS file not found %s" (concat path name))))
  47.     (find-file-noselect name)))
  48.  
  49. (defun call-co (rcs-filename working-dir)
  50.   (switch-to-buffer-other-window (get-buffer-create "*rcs-notes*"))
  51.   (setq default-directory working-dir)
  52.   (if  *rcs-file-read-only*
  53.       (call-process "co" nil t t rcs-filename)
  54.     (call-process "co" nil t t "-l" rcs-filename))
  55.   (insert "\n~~~\n")
  56.   (other-window 1))
  57.  
  58. (defun rcs-find-file (name path read-only)
  59.   "Check out and select current revision of NAME in current default directory.
  60. Prefix arg means don't lock; file will be read only.
  61. Search PATH and PATH/RCS for RCS file named NAME or NAME,v."
  62.   (interactive "sGet RCS-controlled file named: 
  63. DIn RCS directory for: 
  64. P")         
  65.   (let ((*rcs-file-read-only* read-only))
  66.     (switch-to-buffer
  67.      (rcs-find-file-noselect name (expand-file-name path)))))
  68.  
  69. (defun rcs-check-in (buff)
  70.   "Check in RCS file in current-buffer, killing the buffer.  From program, supply BUFF."
  71.   (interactive (list (current-buffer)))
  72.   (let ((filename (buffer-file-name buff)))
  73.     (switch-to-buffer-other-window
  74.      (make-shell "rcs-notes" "ci" nil filename))
  75.     (kill-buffer buff)))
  76.  
  77.  
  78.     
  79.  
  80.  
  81.