home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / gnu / emacs / sources / 803 < prev    next >
Encoding:
Text File  |  1992-11-18  |  5.2 KB  |  143 lines

  1. Newsgroups: gnu.emacs.sources
  2. Path: sparky!uunet!pipex!demon!edscom!kevin
  3. From: kevin@edscom.demon.co.uk (Kevin Broadey)
  4. Subject: Automatic file carbon-copying
  5. Message-ID: <KEVIN.92Nov18163701@calamityjane.edscom.demon.co.uk>
  6. X-Disclaimer: These opinions are mine: others available on request.
  7. Lines: 130
  8. Sender: kevin@edscom.demon.co.uk (Kevin Broadey)
  9. Organization: EDS-Scicon, Milton Keynes, UK
  10. X-Newsreader: GNUS 3.14.1
  11. Date: Wed, 18 Nov 1992 16:37:06 GMT
  12.  
  13. A while ago Ray Nickson <Ray.Nickson@comp.vuw.ac.nz> posted
  14. carbon-file.el (that's what it says in my file header, anyway!).  This
  15. sits in your `write-file-hooks' and automatically writes your buffer
  16. contents to one or more `carbon-copy' files every time you save it.
  17.  
  18. I found this very useful, except that I often forgot to set up the
  19. carbon-copy file name.
  20.  
  21. To get around this I wrote auto-carbon.el which sits in your
  22. `find-file-hooks'.  It uses a regular expression to trap files which you
  23. may want to carbon-copy and a "replace-match" string to generate the
  24. copy file name.
  25.  
  26. This post includes carbon-file.el for those of you who haven't already
  27. got it.
  28.  
  29. Bug reports, suggestions, improvements and praise to:-
  30.  
  31.     kbroadey@edscom.demon.co.uk
  32.  
  33. ------------------------------------------------------------------------
  34. ;; auto-carbon.el - automatically call carbon-buffer-to-file from
  35. ;;                  find-file-hooks
  36. ;;
  37. ;; Written 04-Nov-92 by Kevin Broadey <kbroadey@edscom.demon.co.uk>
  38. ;;
  39. ;; Usage:
  40. ;;
  41. ;;    (require 'auto-carbon)
  42. ;;    (or (memq 'auto-carbon find-file-hooks)
  43. ;;        (setq find-file-hooks (cons 'auto-carbon find-file-hooks)))
  44.  
  45. (provide 'auto-carbon)
  46.  
  47. (defvar auto-carbon-alist nil
  48.   "ALIST of source regexps and target patterns for automatic file carbon
  49. copying.
  50.  
  51. Each element looks like  (SOURCE . TARGET)  where SOURCE is a regular
  52. expression and TARGET is a  replace-match  compliant replacement string.
  53. This means that \\1 in TARGET is replaced by the first \\( ... \\) expression
  54. in SOURCE and \\& is replaced by the whole of SOURCE.
  55.  
  56. Note that SOURCE is not anchored by default, so you must use ^ and $ to
  57. anchor the match to the beginning or end of the file name.")
  58.  
  59. (defun auto-carbon ()
  60.   "Function for inclusion in `find-file-hooks' which uses `auto-carbon-alist'
  61. to determine whether to carbon-copy a file.
  62.  
  63. Calls `carbon-buffer-to-file' to arrange for carbon-copying."
  64.   (let ((alist auto-carbon-alist)
  65.     (orig-buffer-file-name buffer-file-name)
  66.     carbon-file-name)
  67.  
  68.     ;; Check whether buffer is visiting a file.  Error if not.
  69.     (or buffer-file-name
  70.     (error "Buffer is not visiting a file."))
  71.  
  72.     ;; Scan the alist looking for all matches
  73.     (while alist
  74.       (if (string-match (car (car alist)) orig-buffer-file-name)
  75.       ;; We've got a match.  Switch to a temporary buffer and use it to
  76.       ;; apply the target pattern to the source regexp using
  77.       ;; `replace-match'.  This does the "\&" and "\1" stuff for us.
  78.       ;; Let me know if you know of a version of replace-match that can be
  79.       ;; applied to a string!
  80.       (let ((orig-buf (current-buffer))
  81.         (buf (get-buffer-create " *auto-carbon-scratchpad* ")))
  82.         (set-buffer buf)
  83.         (widen)
  84.         (erase-buffer)
  85.         (insert orig-buffer-file-name)
  86.         (goto-char (point-min))
  87.         (re-search-forward (car (car alist))) ; sets up match data
  88.         (replace-match (cdr (car alist)) t nil)
  89.         (setq carbon-file-name (buffer-substring (point-min) (point-max)))
  90.         (set-buffer orig-buf)
  91.         (kill-buffer buf)
  92.  
  93.         ;; Ask whether to do the carbon copy.
  94.         ;; Note that we have to be back in the original buffer before we
  95.         ;; call carbon-buffer-to-file because it sets a buffer-local
  96.         ;; variable.
  97.         (if (y-or-n-p (format "Carbon copy to %s? " carbon-file-name))
  98.         (carbon-buffer-to-file carbon-file-name)
  99.           )))
  100.  
  101.       ;; Try next element is alist.
  102.       (setq alist (cdr alist)))))
  103. ------------------------------------------------------------------------
  104. ;;;carbon-file.el
  105. ;;;
  106. ;;;Authorizing-Users: Ray Nickson <Ray.Nickson@comp.vuw.ac.nz>
  107.  
  108. ;;;To use, just M-x carbon-buffer-to-file to the remote file name when
  109. ;;;you find the local one (or vice versa).
  110. ;;;(I had to chamge it for distribution; hope it still works)
  111.  
  112. ;;;You can also put the call in the file's Local Variables section with
  113. ;;;an eval, or just set buffer-carbon-file-names there.
  114.  
  115. (defvar buffer-carbon-file-names nil
  116.   "List of files to carbon-copy this buffer into.")
  117. (make-variable-buffer-local 'buffer-carbon-file-names)
  118.  
  119. (defun carbon-buffer-to-file (file)
  120.   "Make FILE be a carbon-copy of the file visited by this buffer.
  121. Any time you save the buffer, changes will go both to the buffer's own file
  122. and to FILE.  Yes, you can carbon to many files at once; the list of files
  123. being carbonned to is in the variable buffer-carbon-file-names."
  124.   (interactive "FCarbon to file: ")
  125.   (setq buffer-carbon-file-names (cons file buffer-carbon-file-names)))
  126.  
  127. (defun write-carbon-files ()
  128.   "A write-file-hook.  See \\[carbon-buffer-to-file]."
  129.   (save-restriction
  130.     (widen)
  131.     (mapcar
  132.      (function (lambda (file)
  133.        (write-region (point-min) (point-max) file)))
  134.      buffer-carbon-file-names))
  135.   nil) ; hook must return nil
  136.  
  137. (setq write-file-hooks (cons 'write-carbon-files write-file-hooks))
  138. ------------------------------------------------------------------------
  139.  
  140. Ends
  141. --
  142. .signature: no such file or directory
  143.