home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / dired / dired-rcs.el < prev    next >
Encoding:
Text File  |  1992-08-18  |  4.1 KB  |  113 lines
  1. ;;;; dired-rcs.el - RCS support for Tree Dired
  2.  
  3. (defconst dired-rcs-version (substring "!Revision: 1.5 !" 11 -2)
  4.   "Id: dired-rcs.el,v 1.5 1991/11/06 13:06:22 sk RelBeta ")
  5.   
  6. ;; Copyright (C) 1991 by Sebastian Kremer <sk@thp.uni-koeln.de>
  7.  
  8. ;; This program is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 1, or (at your option)
  11. ;; any later version.
  12. ;;
  13. ;; This program is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;; GNU General Public License for more details.
  17. ;;
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with this program; if not, write to the Free Software
  20. ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ;; LISPDIR ENTRY for the Elisp Archive ===============================
  23. ;;    LCD Archive Entry:
  24. ;;    dired-rcs|Sebastian Kremer|sk@thp.uni-koeln.de
  25. ;;    |RCS support for Tree Dired 
  26. ;;    |Date: 1991/11/06 13:06:22 |Revision: 1.5 |
  27.  
  28. ;; INSTALLATION ======================================================
  29. ;; 
  30. ;; You need to have my rcs.el loaded for this to work.  It is
  31. ;; available via anonymous ftp from
  32. ;; 
  33. ;;     ftp.thp.Uni-Koeln.DE[134.95.64.1]:/pub/gnu/emacs/rcs.tar.Z
  34. ;;
  35. ;; This will not work with classic (18.xx) Dired, you'll need Tree Dired,
  36. ;; available via anonymous ftp from
  37. ;; 
  38. ;;     ftp.thp.Uni-Koeln.DE[134.95.64.1]:/pub/gnu/emacs/diredall.tar.Z
  39. ;;
  40. ;; Put this file into your load-path and the following in your ~/.emacs:
  41. ;; 
  42. ;;   (autoload 'dired-rcs-mark-rcs-locked-files "dired-rcs")
  43. ;;   (autoload 'dired-rcs-mark-rcs-files "dired-rcs")
  44. ;;
  45. ;; Put this inside your dired-load-hook:
  46. ;; 
  47. ;;   (define-key dired-mode-map "," 'dired-rcs-mark-rcs-files)
  48. ;;   (define-key dired-mode-map "\M-," 'dired-rcs-mark-rcs-locked-files)
  49. ;;
  50.  
  51. (require 'dired)
  52.  
  53. ;;;###autoload
  54. (defun dired-rcs-mark-rcs-locked-files (&optional unflag-p)
  55.   "Mark all files that are under RCS control and RCS-locked.
  56. With prefix argument, unflag all those files.
  57. Mentions RCS files for which a working file was not found in this buffer.
  58. Type \\[dired-why] to see them again."
  59.   (interactive "P")
  60.   (dired-rcs-mark-rcs-files unflag-p t))
  61.  
  62. ;;;###autoload
  63. (defun dired-rcs-mark-rcs-files (&optional unflag-p locked)
  64.   "Mark all files that are under RCS control.
  65. With prefix argument, unflag all those files.
  66. Mentions RCS files for which a working file was not found in this buffer.
  67. Type \\[dired-why] to see them again."
  68.   ;; Returns list of failures, or nil on success.
  69.   ;; Optional arg LOCKED means just mark RCS-locked files.
  70.   (interactive "P")
  71.   (message "%s %sRCS controlled files..."
  72.        (if unflag-p "Unmarking" "Marking")
  73.        (if locked "locked " ""))
  74.   (let ((dired-marker-char (if unflag-p ?\  dired-marker-char))
  75.     rcs-files wf failures count total)
  76.     ;; Loop over subdirs to set `rcs-files'
  77.     (mapcar
  78.      (function
  79.       (lambda (dir)
  80.     (or (equal (file-name-nondirectory (directory-file-name dir))
  81.            "RCS")
  82.         ;; skip inserted RCS subdirs
  83.         (setq rcs-files
  84.           (append (if locked
  85.                   ;; these two functions from sk's rcs.el
  86.                   (rcs-locked-files dir)
  87.                 (rcs-files dir))
  88.               rcs-files)))))
  89.      (mapcar (function car) dired-subdir-alist))
  90.     (setq total (length rcs-files))
  91.     (while rcs-files
  92.       (setq wf (rcs-working-file (car rcs-files))
  93.         rcs-files (cdr rcs-files))
  94.       (save-excursion (if (dired-goto-file wf)
  95.               (dired-mark-file 1)
  96.             (dired-log "RCS working file not found: %s\n" wf)
  97.             (setq failures (cons (dired-make-relative wf)
  98.                          failures)))))
  99.     (if (null failures)
  100.     (message "%d %sRCS file%s %smarked."
  101.          total
  102.          (if locked "locked " "")
  103.          (dired-plural-s total)
  104.          (if unflag-p "un" ""))
  105.       (setq count (length failures))
  106.       (dired-log-summary "RCS working file not found %s" failures)
  107.       (message "%d %sRCS file%s: %d %smarked - %d not found %s."
  108.            total
  109.            (if locked "locked " "")
  110.            (dired-plural-s total) (- total count)
  111.            (if unflag-p "un" "") count failures))
  112.     failures))
  113.