home *** CD-ROM | disk | FTP | other *** search
/ SGI Developer Toolbox 6.1 / SGI Developer Toolbox 6.1 - Disc 4.iso / public / GNU / emacs.inst / emacs19.idb / usr / gnu / lib / emacs / site-lisp / ptools.el.z / ptools.el
Encoding:
Text File  |  1994-08-02  |  5.3 KB  |  157 lines
  1. ;;; Basic ptools package       ;; -*-Mode: Lisp -*-
  2. ;;;
  3. ;;; Originally by Kipp Hickman with help from Terry Weissman
  4. ;;; Hacked up further by Michael Toy
  5. ;;;
  6. ;;; more mods by Scott Henry
  7. ;;;
  8. ;;; sets ROOT to $WORKAREA/root and TOOLROOT to $WORKAREA/toolroot
  9. ;;;  so those should be symlinks (if necessary) to the real root & toolroot
  10.  
  11. (defvar ptools-dir "/usr/local/bin/ptools/")
  12. ;; be able to specify options to the ptools commands
  13. (defvar p_modify-options nil)
  14. (defvar p_unmodify-options "-u")        ; updates with highest RCS revision
  15. (defvar p_rdiff-options "-g")           ; uses gdiff instead of diff
  16. (defvar p_finalize-options "-B")        ; don't bugpost
  17. (defvar p_integrate-options nil)
  18.  
  19.  
  20.  
  21. (defun strip-matching-strings (src &rest matches)
  22.   "Return a version of SRC with all strings matching MATCHES removed"
  23.   (let* ((match-one
  24.           (lambda (astring match-list)
  25.             (cond
  26.              ((eq match-list nil) nil)
  27.              ((string-match (car match-list) astring) t)
  28.              (t (funcall match-one astring (cdr match-list)))
  29.              )
  30.             )
  31.           )
  32.          (sms1
  33.           (lambda (lstr)
  34.             (cond
  35.              ((eq lstr nil) nil)
  36.              ((funcall match-one (car lstr) matches)
  37.               (funcall sms1 (cdr lstr)))
  38.              (t (cons (car lstr) (funcall sms1 (cdr lstr))))
  39.              )
  40.             )
  41.           )
  42.          )
  43.     (funcall sms1 src)
  44.     )
  45.   ) 
  46.  
  47. (defun p_root (relative-root)
  48.   "Set the ptools environment variables appropriately for a new workarea"
  49.   (interactive "DWorkarea: ")
  50.   (setq new-root (expand-file-name relative-root))
  51.   (cond
  52.    ((not (file-accessible-directory-p new-root))
  53.     (error "Error: %s is not a directory" new-root))
  54.    ((not (file-readable-p (concat new-root ".workarea")))
  55.     (error "Error: Can't access %s.workarea" new-root))
  56.    (t
  57.     (setq
  58.      process-environment
  59.      (append
  60.       (list
  61.        (concat "WORKAREA=" new-root)
  62.        (concat "ROOT=" new-root "root")
  63.        (concat "TOOLROOT=" new-root "toolroot"))
  64.       (strip-matching-strings process-environment
  65.                               "WORKAREA=" "ROOT=" "TOOLROOT="))))
  66.    )
  67.   )
  68.  
  69.  
  70. (defun p_modify ()
  71.   "Run p_modify on the file in the current buffer"
  72.   (interactive)
  73.   (if (not buffer-read-only)
  74.       (error "Buffer is not read-only"))
  75.   (shell-command (concat ptools-dir "p_modify " p_modify-options " "
  76.                          (file-name-nondirectory buffer-file-name)))
  77.   (revert-buffer t t))
  78.  
  79. (defun p_unmodify ()
  80.   "Run p_unmodify on the file in the current buffer"
  81.   (interactive)
  82.   (if buffer-read-only
  83.       (error "Buffer is already read-only"))
  84.   (shell-command (concat ptools-dir "p_unmodify " p_unmodify-options " "
  85.                          (file-name-nondirectory buffer-file-name)))
  86.   (revert-buffer t t))
  87.  
  88. (defun p_integrate ()
  89.   "Run p_integrate on the file in the current buffer"
  90.   (interactive)
  91.   (if buffer-read-only
  92.       (error "Buffer is read-only - modify first"))
  93.   (shell-command (concat ptools-dir "p_integrate " p_integrate-options " "
  94.                          (file-name-nondirectory buffer-file-name))))
  95.  
  96. (defun p_finalize (arg)
  97.   "Run p_finalize on the file in the current buffer"
  98.   (interactive "sFinalize message: ")
  99.   (shell-command (concat ptools-dir "p_finalize " p_finalize-options " -m \"" arg "\" "
  100.                          (file-name-nondirectory buffer-file-name)))
  101.   (revert-buffer t t))
  102.  
  103. (defun p_rdiff ()
  104.   "Run p_rdiff on the file in the current buffer"
  105.   (interactive)
  106.   (shell-command (concat ptools-dir "p_rdiff " p_rdiff-options " "
  107.                          (file-name-nondirectory buffer-file-name)))
  108.   )
  109.  
  110.  
  111. (defun p_fetal ()
  112.   "Run p_modify -f on the file in the current buffer"
  113.   (interactive)
  114.   (shell-command (concat ptools-dir "p_modify -f " p_modify-options " "
  115.                          (file-name-nondirectory buffer-file-name)))
  116.   )
  117.  
  118. ;;; I think this is a dumb idea for a default, but you can do it if you want to
  119. ;(modify-frame-parameters (selected-frame) '((menu-bar-lines . 2)))
  120.      
  121. ;; Make a menu keymap (with a prompt string)
  122. ;; to be the menu bar item's definition.
  123. ;; I stole this from somewhere.  I have no idea how this works,
  124. ;; and I'd really like to know what the third argument
  125. (define-key global-map [menu-bar ptools]
  126.   (cons "PTools" (make-sparse-keymap "PTools")))
  127.  
  128. ;; Make specific subcommands in the item's submenu.
  129.  
  130. (define-key global-map [menu-bar ptools p_fetal]
  131.   '("p_fetal" . p_fetal))
  132. (define-key global-map [menu-bar ptools p_unmodify]
  133.   '("p_unmodify" . p_unmodify))
  134. (define-key global-map [menu-bar ptools p_rdiff]
  135.   '("p_rdiff" . p_rdiff))
  136. (define-key global-map [menu-bar ptools p_finalize]
  137.   '("p_finalize" . p_finalize))
  138. (define-key global-map [menu-bar ptools p_integrate]
  139.   '("p_integrate" . p_integrate))
  140. (define-key global-map [menu-bar ptools p_modify]
  141.   '("p_modify" . p_modify))
  142. (define-key global-map [menu-bar ptools p_root]
  143.   '("New Workarea ..." . p_root))
  144.  
  145. (provide 'ptools)
  146. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  147. ;; The following local variable definition causes this emacs code
  148. ;; to be byte compiled every time I save it.
  149. ;;    From: makke@wins.uia.ac.be (Marc Gemis)
  150. ;;
  151. ;; Local variables:
  152. ;; mode: lisp
  153. ;; indent-tabs-mode: nil
  154. ;; eval: (defun byte-compile-this-file () (write-region (point-min) (point-max) buffer-file-name nil 't) (byte-compile-file buffer-file-name) nil)
  155. ;; write-file-hooks: (byte-compile-this-file)
  156. ;; End:
  157.