home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / s / sable.zip / SABLE.EL < prev   
Lisp/Scheme  |  1993-03-25  |  18KB  |  493 lines
  1. ; Newsgroups: gnu.emacs.sources
  2. ; Path: hal.com!decwrl!sun-barr!ames!saimiri.primate.wisc.edu!zaphod.mps.ohio-state.edu!magnus.acs.ohio-state.edu!bgsuvax!att!att!dptg!ucs!skdutta
  3. ; From: skdutta@ucs.att.com (Saumen Dutta)
  4. ; Subject: emacs front end for sable.
  5. ; Organization: AT&T Universal Card Services, Jacksonville FL
  6. ; Date: Mon, 9 Nov 1992 10:13:09 GMT
  7. ; 
  8. ; Sable is a product for managing configuration control and releases of 
  9. ; software. The command set of sable is extensive and complicated. The
  10. ; command line interface requires the presence of Korn Shell. It has
  11. ; a curses interface too but that requires user to type many fields
  12. ; before a command can be executed. The following utility helps users
  13. ; to use the power of emacs and execute sable commands from within
  14. ; emacs. You need to have sable and korn shell to use this.
  15. ;;
  16. ;;
  17. ;; sable.el -- front end code for using Sable from GNU Emacs
  18. ;;             by Saumen K. Dutta (skdutta@ucs.att.com)
  19. ;;             v1.0 October 31 1992
  20. ;;
  21. ;;
  22.  
  23. ;; LCD Archive Entry:
  24. ;; sable|Saumen Dutta|skdutta@ucs.att.com|
  25. ;; Front end code for using Sable from GNU Emacs|
  26. ;; 92-10-31|1.0|~/interfaces/sable.el.Z|
  27.  
  28. ;;
  29. ;; Description:
  30. ;;       sable.el is a GNU Emacs utility to help Assigned Developers
  31. ;; to interact with sable in a friendly manner. Most of the commands
  32. ;; are reduced to simple keystrokes. Parameters of the frequently used
  33. ;; commands are stored and can be reused. Issuing of edget and edput
  34. ;; to get and put files are not required as the program can find out
  35. ;; the next logical operation. Buffers are loaded direcly from the 
  36. ;; command so that all the required sable commands and file editing can
  37. ;; be tackled from the same emacs environment. Limited report and query
  38. ;; support is also available.
  39. ;;
  40. ;;
  41.  
  42. ;;
  43. ;; Use:
  44. ;;    To start the environment you need to issue `M-x sable'. From then on
  45. ;; all global keymapping will take into effect. Press C-ch for help
  46. ;;
  47.  
  48. ;;
  49. ;; User Modifiable Variables (don't modify these unless you are required to!)
  50. ;;
  51.  
  52. (defvar sable-ksh-program "ksh" "The korn shell executable")
  53. (defvar sable-buffer "*sable*" "Name of the sable buffer")
  54.  
  55. ;;;
  56. ;;; VARIABLES
  57. ;;;
  58.  
  59. (defvar sable-ksh-process nil "Process running the sable")
  60. (defvar sable-generic nil "Name of the sable generic")
  61. (defvar sable-mr nil "Name of the sable modification request")
  62. (defvar sable-dir nil "directory from where edgotten in sable")
  63. (defvar sable-command nil "sable command string to be executed")
  64. (defvar sable-process-status nil "Status of the sable process, The following
  65.   conventions are followed, 0 = sable process has started, 1 = sable process
  66.   has returned successfully and 2 = sable process has failed")
  67. (defvar sable-file nil "file to be operated upon by sable")
  68. (defvar sable-autodependency nil "level of autodependency")
  69. (defvar sable-query-relation nil "relation name of the sable query")
  70.  
  71.  
  72. (defun sable-start-ksh ()
  73.     "Start the ksh and initialize sable environment"
  74.     ;; first time or if process dies
  75.     (if (and (processp sable-ksh-process)
  76.          (or (eq 'stop (process-status sable-ksh-process))
  77.          (eq 'run (process-status sable-ksh-process)))) nil
  78.     (setq sable-ksh-process   ;; [re]start the ksh process
  79.           (start-process "sable" 
  80.                  (get-buffer-create sable-buffer) 
  81.                  sable-ksh-program))
  82.     (save-excursion
  83.       (set-buffer sable-buffer)
  84.       (set-marker (process-mark sable-ksh-process) 1)))
  85.     (set-process-filter sable-ksh-process 'sable-filter)
  86.         (process-kill-without-query sable-ksh-process)
  87.     (setq sable-command (concat ". sablime " sable-generic))
  88.     (sable-process-command)
  89.     (message "Done!"))
  90.  
  91.  
  92. (defun sable-filter(process input)
  93.   "Filter for the Sable process to catch sable errors"
  94.   (let ((old-buffer (current-buffer)))
  95.     (unwind-protect
  96.     (set-buffer (process-buffer process))
  97.     (save-excursion
  98.       (goto-char (process-mark process))
  99.       (insert input)
  100.       (set-marker (process-mark process) (point)))
  101.       (goto-char (process-mark process))
  102.       (set-buffer old-buffer)))
  103.       
  104.   ;; search for the bell character in the input
  105.   (if (eq nil (string-match "\007" input)) (setq sable-process-status 1)
  106.     (progn (display-buffer (process-buffer process))
  107.        (setq sable-process-status 2)
  108.        (error "Sable Error..." ))))
  109.  
  110.  
  111. (defun sable-process-command()
  112.   "Process the sable command"
  113.   (setq sable-process-status 0)
  114.   (message "Sending command to sable...")
  115.   (save-excursion
  116.     (set-buffer (process-buffer sable-ksh-process))
  117.     (erase-buffer))
  118.   (process-send-string sable-ksh-process 
  119.                (concat sable-command "\n")) 
  120.   (accept-process-output)
  121.   ;; guarantees that the sable buffer is loaded fully
  122.   (while (eq sable-process-status 0) (sleep-for 1)))
  123.  
  124.  
  125.  
  126. (defun sable-edget-(&optional long)
  127.   "short edget without a parameter, long edget with one"
  128.   (if (buffer-file-name) 
  129.       (progn (setq sable-file (file-name-nondirectory buffer-file-name))
  130.          (if (or (eq sable-mr nil) long)
  131.          (setq sable-mr (read-string "MR Number: " sable-mr)))
  132.          (if (or (eq sable-dir nil) long)
  133.          (setq sable-dir (read-string "Directory: " sable-dir)))
  134.          ;; Change the directory to the buffer's one before composing the command
  135.          (setq sable-command (concat "cd " (file-name-directory buffer-file-name) "; "))
  136.          ;; Now form the sable command from the global variables
  137.          (setq sable-command (format 
  138.                   "%s edget g=%s mr=%s rm=y dir=%s srf=%s prompt=n"
  139.                   sable-command sable-generic sable-mr sable-dir
  140.                   sable-file))
  141.          (sable-process-command)
  142.          (if (eq sable-process-status 1) 
  143.          (progn
  144.            ;; making sure that the file is gotten properly
  145.            (while (eq (file-writable-p buffer-file-name) nil) (sleep-for 1))           
  146.            (revert-buffer nil t)
  147.            (message "Done!"))))
  148.     (error "There is no file associated with buffer %s" (buffer-name))))
  149.  
  150.  
  151. (defun sable-unedget-(&optional long)
  152.   "short unedget without a parameter, long unedget with one"
  153.   (if (buffer-file-name) 
  154.       (progn (setq sable-file (file-name-nondirectory buffer-file-name))
  155.          (if (or (eq sable-mr nil) long)
  156.          (setq sable-mr (read-string "MR Number: " sable-mr)))
  157.          (if (or (eq sable-dir nil) long)
  158.          (setq sable-dir (read-string "Directory: " sable-dir)))
  159.          ;; Change the directory to the buffer's one before composing the command
  160.          (setq sable-command (concat "cd " (file-name-directory buffer-file-name) "; "))
  161.          ;; Now form the sable command from the global variables
  162.          (setq sable-command (format 
  163.                   "%s unedget g=%s mr=%s dir=%s srf=%s prompt=n"
  164.                   sable-command sable-generic sable-mr sable-dir
  165.                   sable-file))
  166.          (sable-process-command)
  167.          (if (eq sable-process-status 1) 
  168.          (progn
  169.            ;; making sure that the file is gotten properly
  170.            (while (eq (file-writable-p buffer-file-name) nil) (sleep-for 1))
  171.            ;; make the file read-only. Sable does not do it but I think it 
  172.            ;; should have!
  173.            (set-file-modes buffer-file-name 292)
  174.            (revert-buffer nil t)
  175.            (message "Done!"))))
  176.     (error "There is no file associated with buffer %s" (buffer-name))))
  177.  
  178.  
  179.  
  180. (defun sable-edput-(&optional long)
  181.   "short edput without a parameter, long edput with one"
  182.   (if (buffer-file-name) 
  183.       (progn 
  184.     ;;give the user a chance to save the file if he has unsaved edits
  185.     (if (and (buffer-modified-p)
  186.          (y-or-n-p (format "%s has been modified. Write it out?" (buffer-name))))
  187.         (save-buffer))
  188.     (setq sable-file (file-name-nondirectory buffer-file-name))
  189.     (if (or (eq sable-mr nil) long)
  190.         (setq sable-mr (read-string "MR Number: " sable-mr)))
  191.     (if (or (eq sable-dir nil) long)
  192.         (setq sable-dir (read-string "Directory: " sable-dir)))
  193.     (if (or (eq sable-autodependency nil) long)
  194.         (setq sable-autodependency (read-string "Autodependency: " "line-level"))) 
  195.     ;; Change the directory to the buffer's one before composing the command
  196.     (setq sable-command (concat "cd " (file-name-directory buffer-file-name) "; "))
  197.     ;; Now form the sable command from the global variables
  198.     (setq sable-command (format 
  199.                  "%s edput g=%s mr=%s rm=n dir=%s adep=%s srf=%s prompt=n"
  200.                  sable-command sable-generic sable-mr sable-dir
  201.                  sable-autodependency sable-file))
  202.     (sable-process-command)
  203.     (if (eq sable-process-status 1) 
  204.         (progn
  205.           ;; making sure that the file is put properly
  206.           (while (eq (file-writable-p buffer-file-name) t) (sleep-for 1))           
  207.           (message "Loading file in buffer")
  208.           (revert-buffer nil t)
  209.           (message "Done!"))))
  210.     (error "There is no file associated with buffer %s" (buffer-name))))
  211.  
  212.  
  213. (defun sable-query-(&optional long)
  214.   "forced parameter prompt with long queries"
  215.   (if (or (eq sable-mr nil) long)
  216.       (setq sable-mr (read-string "MR Number: " sable-mr)))
  217.   (if (or (eq sable-query-relation nil) long)
  218.       (setq sable-query-relation (read-string "Relation: " "MD"))) 
  219.   (setq sable-command (format
  220.                "query mr=%s relation=%s prompt=n"
  221.                sable-mr sable-query-relation))
  222.   (sable-process-command)
  223.   (if (eq sable-process-status 1)
  224.       (save-excursion
  225.     (display-buffer (process-buffer sable-ksh-process))
  226.     (message "Done!"))))
  227.     
  228.  
  229.  
  230.  
  231. (defun sable-reset()
  232.   "Reset all the sable temporary variables"
  233.   (setq sable-generic nil)
  234.   (setq sable-mr nil)
  235.   (setq sable-dir nil)
  236.   (setq sable-file nil)
  237.   (setq sable-command nil)
  238.   (setq sable-process-status nil)
  239.   (setq sable-query-relation nil)
  240.   (setq sable-autodependency nil))
  241.  
  242.  
  243. (defun sable-key-bind()
  244.   (define-key (current-global-map) "\C-c?" 'sable-status)
  245.   (define-key (current-global-map) "\C-ci" 'sable)
  246.   (define-key (current-global-map) "\C-cr" 'sable-report)
  247.   (define-key (current-global-map) "\C-cg" 'sable-edget)
  248.   (define-key (current-global-map) "\C-cp" 'sable-edput)
  249.   (define-key (current-global-map) "\C-cn" 'sable-next-short)
  250.   (define-key (current-global-map) "\C-cN" 'sable-next-long)
  251.   (define-key (current-global-map) "\C-cu" 'sable-unedget-short)
  252.   (define-key (current-global-map) "\C-cU" 'sable-unedget-long)
  253.   (define-key (current-global-map) "\C-cq" 'sable-query-short)
  254.   (define-key (current-global-map) "\C-cQ" 'sable-query-long)
  255.   (define-key (current-global-map) "\C-c\C-g" 'sable-getversion)
  256.   (define-key (current-global-map) "\C-c\C-s" 'sable-submit)
  257.   (define-key (current-global-map) "\C-ch" 'sable-help))
  258.  
  259. ;;;
  260. ;;; Minibuffer commands
  261. ;;;
  262.  
  263.  
  264. (defun sable(generic)
  265.   "Initialize the sable generic and calls korn shell"
  266.   (interactive "sGeneric: ")
  267.   (sable-reset)
  268.   (sable-key-bind)
  269.   (setq sable-generic generic)
  270.   (sable-start-ksh))
  271.  
  272. (defun sable-next-short()
  273.   "Invoke the logical form of next short sable edit command"
  274.   (interactive)
  275.   (if (eq sable-generic nil) (error "Sable not Initialized")
  276.     (if buffer-read-only (sable-edget-)
  277.       (sable-edput-))))
  278.  
  279. (defun sable-next-long()
  280.   "Invoke the logical form of next long sable edit command"
  281.   (interactive)
  282.   (if (eq sable-generic nil) (error "Sable not Initialized")
  283.     (if buffer-read-only (sable-edget- 1)
  284.       (sable-edput- 1))))
  285.  
  286. (defun sable-edget()
  287.   "Invoke the short form of sable edget"
  288.   (interactive)
  289.   (if (eq sable-generic nil) (error "Sable not Initialized")
  290.     (sable-edget-)))
  291.  
  292. (defun sable-edput()
  293.   "Invoke the short form of sable edput"
  294.   (interactive)
  295.   (if (eq sable-generic nil) (error "Sable not Initialized")
  296.     (sable-edput-)))
  297.  
  298.  
  299. (defun sable-query-short()
  300.   "Invoke short query"
  301.   (interactive)
  302.   (if (eq sable-generic nil) (error "Sable not Initialized")
  303.     (sable-query-)))
  304.  
  305. (defun sable-query-long()
  306.   "Invoke query with parameter prompting"
  307.   (interactive)
  308.   (if (eq sable-generic nil) (error "Sable not Initialized")
  309.     (sable-query- 1)))
  310.  
  311. (defun sable-unedget-short()
  312.   "Invoke short unedget"
  313.   (interactive)
  314.   (if (eq sable-generic nil) (error "Sable not Initialized")
  315.     (sable-unedget-)))
  316.  
  317. (defun sable-unedget-long()
  318.   "Invoke unedget with parameter prompting"
  319.   (interactive)
  320.   (if (eq sable-generic nil) (error "Sable not Initialized")
  321.     (sable-unedget- 1)))
  322.  
  323. (defun sable-report()
  324.   "Produce a short report of all MRs"
  325.   (interactive)
  326.   (if (eq sable-generic nil) (error "Sable not Initialized")
  327.     (progn 
  328.       (setq sable-command (format
  329.                "report prompt=n"))
  330.       (sable-process-command)
  331.       (if (eq sable-process-status 1)
  332.       (save-excursion
  333.         (display-buffer (process-buffer sable-ksh-process))
  334.         (message "Done!"))))))
  335.  
  336.  
  337. (defun sable-getversion()
  338.   "Do a getversion on the generic"
  339.   (interactive)
  340.   (if (eq sable-generic nil) (error "Sable not Initialized")
  341.     (progn
  342.       (setq sable-command (concat
  343.                "getversion br="
  344.                (read-string "Branch <mr/ofc>: " "mr")))
  345.       (let* ((sable-tmp-mrs 
  346.           (read-string "MRs for file selection: "))
  347.          (sable-tmp-umrs 
  348.           (read-string "MRs for additional changes: ")))
  349.     (if (string= sable-tmp-mrs "")nil
  350.       (setq sable-command (concat
  351.                    sable-command " mrs=" sable-tmp-mrs)))
  352.     (if (string= sable-tmp-umrs "")nil
  353.       (setq sable-command (concat
  354.                    sable-command " umrs=" sable-tmp-umrs))))
  355.       (if (string= (read-string "List of files only <y/n>: ") "n")
  356.       (setq sable-command (concat
  357.                    sable-command 
  358.                    " list=n"
  359.                    " node=" (read-string "Target-node: ")
  360.                    " rm=" (read-string "Remove files: ")))
  361.     (setq sable-command (concat
  362.                  sable-command
  363.                  " list=y")))
  364.       (setq sable-command (concat
  365.                sable-command
  366.                " prompt=n"))
  367.       (sable-process-command)
  368.       (if (eq sable-process-status 1)
  369.       (save-excursion
  370.         (display-buffer (process-buffer sable-ksh-process))
  371.         (message "Done!"))))))
  372.  
  373.  
  374. (defun sable-submit()
  375.   "a simple sable submit mechanism"
  376.   (interactive)
  377.   (if (eq sable-generic nil) (error "Sable not Initialized")
  378.     (progn
  379.       (setq sable-command (concat
  380.                "getversion mr="
  381.                (read-string "MR Number: ")
  382.                " copyto="
  383.                (read-string "Resolution File[Mandatory]: ")
  384.                " prompt=n"))
  385.       (if (y-or-n-p "Will submit the MR. Are you sure?")
  386.       (progn
  387.         (sable-process-command)
  388.         (if (eq sable-process-status 1)
  389.         (save-excursion
  390.           (display-buffer (process-buffer sable-ksh-process))
  391.           (message "Done!"))))))))             
  392.       
  393.  
  394.       
  395.  
  396. (defun sable-status()
  397.   "Show the internal states and the default variables"
  398.   (interactive)
  399.   (if (eq sable-generic nil) (error "Sable not Initialized")
  400.   (save-excursion
  401.     (set-buffer (process-buffer sable-ksh-process))
  402.     (goto-char 1)
  403.     (insert "---------> Internal State of the Sable Mode <---------\n\n")
  404.     (insert "Background Korn Shell process: " sable-ksh-program "\n")
  405.     (insert "Sable Generic: ")
  406.     (if (and sable-generic (not (string= sable-generic "")))
  407.     (insert sable-generic "\n") 
  408.     (insert "*Not Set*\n"))
  409.     (insert "Sable Directory: ") 
  410.     (if sable-dir (insert sable-dir "\n") (insert "*Not Set*\n")) 
  411.     (insert "Sable File: ") 
  412.     (if sable-file (insert sable-file "\n") (insert "*Not Set*\n")) 
  413.     (insert "MR: ") 
  414.     (if sable-mr (insert sable-mr "\n") (insert "*Not Set*\n")) 
  415.     (insert "Sable Autodependency: ")
  416.     (if sable-autodependency (insert sable-autodependency "\n") 
  417.       (insert "*Not Set*\n")) 
  418.     (insert "Sable Query Relation: ")
  419.     (if sable-query-relation (insert sable-query-relation "\n") 
  420.       (insert "*Not Set*\n")) 
  421.     (insert "Last Sable Command: ")
  422.     (if sable-command (insert sable-command "\n") (insert "*Not Set*\n")) 
  423.     (insert "\n------------------------------------------------------\n\n")
  424.     (insert "Buffer History: \n\n")
  425.     (display-buffer (process-buffer sable-ksh-process)))))
  426.  
  427.  
  428. (defun sable-help()
  429.   "Print an explanation of keyboard macros in the sable environment"
  430.   (interactive)
  431.   (if (eq sable-generic nil) (error "Sable not Initialized")
  432.   ;; there should be a better way to do this
  433.     (save-excursion
  434.       (set-buffer (process-buffer sable-ksh-process))
  435.       (erase-buffer)
  436.       (insert
  437.        "\nThe Following Keyboard sequence is activated globally after the first\n"
  438.        "time sable is called\n"
  439.        "\n"
  440.        "   Key     Command              Description\n"
  441.        "   ---     -------              -----------\n"
  442.        "\n"
  443.        "  \\C\-c?  sable-status         Show the internal variables of emacs sable.\n"
  444.        "\n"
  445.        "  \\C\-ci  sable                Initialize the sable environment for a \n"
  446.        "                                new modification request. This command is\n"
  447.        "                                required before executing any other sable\n"
  448.        "                                commands.\n"
  449.        "\n"
  450.        "  \\C\-cr  sable-report         Generate a short sable report\n"
  451.        "\n"
  452.        "  \\C\-cn  sable-next-short     Initiate the next logical sable operation.\n"
  453.        "                                This will execute edget or edput.\n"
  454.        "\n"
  455.        "  \\C\-cN  sable-next-long      Long version of the initiate the next request.\n"
  456.        "\n"
  457.        "  \\C\-cg  sable-edget          Initiate the short edget operation.\n"
  458.        "\n"
  459.        "  \\C\-cp  sable-edput          Initiate the short edput operation.\n"
  460.        "\n"
  461.        "  \\C\-cu  sable-unedget-short  Initiate the short unedget operation.\n"
  462.        "\n"
  463.        "  \\C\-cU  sable-unedget-long   Long version of the unedget\n"
  464.        "\n"
  465.        "  \\C\-ch  sable-help           Print this help message\n"
  466.        "\n"
  467.        "  \\C\-cq  sable-query-short    Initiate the sable query.\n"
  468.        "\n"
  469.        "  \\C\-cQ  sable-query-long     Initiate the query with parameter prompting.\n"
  470.        "\n"
  471.        "  \\C\-c\\C-g  sable-getversion  \n"
  472.        "\n"
  473.        "  \\C\-c\\C-s  sable-submit  \n"
  474.        )
  475.       (display-buffer (process-buffer sable-ksh-process)))))
  476.  
  477.  
  478.  
  479.  
  480.  
  481. ;;; Wish List
  482. ;;; ---------
  483. ;;; have a new sable mode
  484. ;;; have a dired show up with getversion
  485. ;;; deal with the resolution file of the submit command correctly
  486. ;;; add some more commands with some more user abstractions
  487.  
  488. ;;; Bugs
  489. ;;; ----
  490. ;;; reports get screwed up if the cursor is in the *sable* window when the report
  491. ;;; command is executed. Looks like the buffer is not erasing properly - 10312250
  492. ;;; Fixed - 11011430
  493.