;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; filexec.el
;;;
;;; Purpose:
;;;  Emacs macros for building files, that contain
;;;  exectutable parts - in order to make file update easy
;;; 
;;; Convention:
;;;  The command filexec-run in some buffer jumps to the start
;;;  and repeats the following steps:
;;;    1. search for *filexec-start-pattern*
;;;    2. search for *filexec-end-pattern*
;;;    3. delare everything in between as function 
;;;       *filexec-temporary-function-name*
;;;    4. go to line following the *filexec-end-pattern*, first position
;;;    5. execute *filexec-temporary-function-name*
;;;
;;; Caveats:
;;;    a. if the code inside the braces includes a change of position,
;;;       some code might be skipped, some might execute more than once or
;;;       even loop --- better set   *filexec-max-calls* non-nil
;;;    b. is the code switches buffers, anything might happen
;;;    c. the code might contains system-calls; handle third-party
;;;       files with great care
;;;
;;; Suggested usage:
;;;  Use the following provided functions for updates:
;;;      exectute-abort-unless                   : at the very beginning
;;;      filexec-remove-until-line-with-string   : to eliminate text
;;;      filexec-remove-until-line-with-regexp   : to eliminate text
;;;      filexec-replace-until-line-with-string  : limited text replace
;;;      filexec-replace-until-line-with-regexp  : limited text replace
;;;      filexec-insert-newest-file-with-pattern : read from file
;;;      filexec-call-command                    : call shell command (!)
;;;      filexec-call-command-capture-output     : call shell command (!)
;;;
;;; Synopsis:
;;;  Making the (emacs) world a better place to live in.
;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; @TABLE OF CONTENTS:			[TOCD: 11:03 10 Dec 2001]
;;;
;;;  [1] Constants
;;;  [2] Variable Settings
;;;      [2.1] Safety Guards
;;;  [3] Functions
;;;      [3.1] Symbolic evaluation
;;;      [3.2] Auxilliary
;;;          [3.2.1] String Management
;;;      [3.3] Helful Editing Functions
;;;  [4] Insert (parts of) files
;;;  [5] system function execution
;;;      [5.1] shell calls
;;;  [6] Main
;;;      [6.1] Partial: Only one execution
;;;  [7] Key Definitions
;;; /////////////////////////////////////////////////////////
;;; @FILE:    filexec.el
;;; @PLACE:   Gaia Homestation
;;; @FORMAT:  Emacs lisp
;;; @AUTHOR:  M. Oliver M'o'ller     <omoeller@verify-it.de>
;;; @BEGUN:   Tue Sep 18 19:08:54 2001
;;; @VERSION: V 0.91                     Fri May 30 23:02:11 2003
;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 

;;; //////////////////////////////////////////////////////////////////////
;;; [1] Constants
;;; //////////////////////////////////////////////////////////////////////
	
;;; //////////////////////////////////////////////////////////////////////
;;; [2] Variable Settings
;;; //////////////////////////////////////////////////////////////////////

(defvar *filexec-start-pattern* "<!-- [*][*][*]FILEXEC[*][*][*]"
  "*Regular expression that demarks the beginning of an execution sequence.")

(defvar *filexec-end-pattern* "[*][*][*]FILEXEC[*][*][*] -->"
  "*Regular expression that demarks the end of an execution sequence.")

(make-variable-buffer-local '*filexec-start-pattern*)
(make-variable-buffer-local '*filexec-end-pattern*)


(defvar *filexec-temporary-function-name* 'filexec_very_ugly_underscored_2821_name_for_temporary_function
  "Used by filexec-define-function.")

(defvar *filexec-shell-output-buffer* "*Messages*"
  "*Buffer that output of non-captured shell calls is spammed into.")


;;; //////////////////////////////////////////////
;;; [2.1] Safety Guards
;;; //////////////////////////////////////////////

(defvar *filexec-max-calls* 30
  "*Maximal number of function calls when calling filexec-run.
If set to nil, the number is unlimited.")

;;; //////////////////////////////////////////////////////////////////////
;;; [3] Functions
;;; //////////////////////////////////////////////////////////////////////


;;; //////////////////////////////////////////////
;;; [3.1] Symbolic evaluation
;;; //////////////////////////////////////////////

(defun filexec-define-function (string)
  "Regards string as a function definition, puts it into the
 buffer *scratch* and defines it as *filexec-temporary-function-name*."
  (let ((buf (buffer-name))
	(pos nil))
    (set-buffer "*scratch*")
    (goto-char (point-max))
    (setq pos (point-marker))
    (insert (format "\n(defun %s () %s )" *filexec-temporary-function-name* string))
    (backward-char 1)
    (eval-region pos (point-max))
    (delete-region pos (point-max))
    (set-buffer buf)))


;;; //////////////////////////////////////////////
;;; [3.2] Auxilliary
;;; //////////////////////////////////////////////

(defun filexec-conc-list-with-spaces (list)
  "Concatenate a list of strings, adding a space character in between
every two parts."
  (let ((res ""))
    (while list
      (setq res (format "%s%s%s" 
			res 
			(if (>  (length res) 0) " " "")
			(car list)))
      (setq list (cdr list)))
    res))


;;; ////////////////////////////////////
;;; [3.2.1] String Management
;;; ////////////////////////////////////

(defun filexec-substring (string from to)
  "Get substring, starting at position 'from' and ending before position 'to'.
Couting positions starts at 0."
  (let ((res "")
	(pos from))
    (while (< pos to)
      (setq res (format "%s%c" res (aref string pos)))
      (setq pos (+ pos 1)))
    res))

(defun filexec-substring-until-last (char string)
  "Returns prefix of string, until the last occurence of char (inclusive).
does return null, if no such character is found."
  (let ((pos (- (length string) 1)))
    (while (and (>= pos 0)
		(not (equal (aref string pos) char)))
      (setq pos (- pos 1)))
    (if (>= pos 0)
	(filexec-substring string 0 (+ pos 1))
	 nil)))

(defun filexec-substring-after-last (char string)
  "Returns suffix of string, after the last occurence of char.
does return the comple string, if no such character is found."
  (let ((pos (- (length string) 1)))
    (while (and (>= pos 0)
		(not (equal (aref string pos) char)))
      (setq pos (- pos 1)))
    (if (>= pos 0)
	(filexec-substring string (+ pos 1) (length string))
	 string)))


;;; //////////////////////////////////////////////
;;; [3.3] Helful Editing Functions
;;; //////////////////////////////////////////////

(defun filexec-query-approval (&rest r)
  (interactive)
  (let* ((string (if r (car r) "Continue"))
	 (approval (read-input (format "%s [yN]? " string))))
    (if (or (equal approval "Y")
	    (equal approval "y")
	    (equal approval "yes"))
	t
	nil)))

(defun filexec-query-approval-assume-yes (&rest r)
  (interactive)
  (let* ((string (if r (car r) "Continue"))
	 (approval (read-input (format "%s [Y]? " string))))
    (if (or (equal approval "")
	    (equal approval " ")
	    (equal approval "Y")
	    (equal approval "y")
	    (equal approval "yes"))
	t
	nil)))


(defun filexec-abort-unless (arg &rest reason)
  (if arg
      nil
      (if (null reason)
	  (error "** FILE-EXEC ABORTED.")
	  (error (car reason)))))
      
;; --------------------------------------------------------------
     
(defun filexec-remove-until-line-with-string (string)
  "Remove from point to beginning of line containing the string.
Does nothing, if string is not found."
  (interactive)
  (let ((pos (point-marker)))
    (if (search-forward string (point-max) t)
	(progn
	  (beginning-of-line)
	  (kill-region pos (point-marker))))))

(defun filexec-remove-until-line-with-regexp (regexp)
  "Remove from point to beginning of line containing the regexp.
Does nothing, if regexp is not found."
  (interactive)
  (let ((pos (point-marker)))
    (if (search-forward-regexp regexp (point-max) t)
	(progn
	  (beginning-of-line)
	  (kill-region pos (point-marker))))))


(defun filexec-replace-until-line-with-string (old new string)
  "Replace in the text from point until beginning of line containing the string.
Does nothing, if string is not found."
  (interactive)
  (let ((pos (point-marker))
	(end nil))
    (if (search-forward string (point-max) t)
	(progn
	  (beginning-of-line)
	  (setq end (point-marker))
	  (goto-char pos)
	  (message (format "** replacing  >>%s<< by >>%s<<..." old new))
	  (while (search-forward old end t)
	    (replace-match new)))
	;; --------------------------------------------
	(message (format "** no terminator string >>%s<< found." string)))
    ;; ---------------------------------------------------------------------
    (goto-char pos)))

(defun filexec-replace-until-line-with-regexp (old new regexp)
  "Replace in the text from point until beginning of line containing the regexp.
Does nothing, if regexp is not found."
  (interactive)
  (let ((pos (point-marker))
	(end nil))
    (if (search-forward-regexp regexp (point-max) t)
	(progn
	  (beginning-of-line)
	  (setq end (point-marker))
	  (goto-char pos)
	  (message (format "** replacing  >>%s<< by >>%s<<..." old new))
	  (while (search-forward old end t)
	    (replace-match new)))
	;; --------------------------------------------
	(message (format "** no terminator regexp >>%s<< found." regexp)))
    ;; ---------------------------------------------------------------------
    (goto-char pos)))


;;; //////////////////////////////////////////////////////////////////
;;; [4] Insert (parts of) files
;;; //////////////////////////////////////////////////////////////////

(defun filexec-insert-newest-file-with-pattern (regexp)
  "Checks, whether a file according to a given regexp exists,
starting from local directory;
  if so, insert the contents at point."
  (interactive)
  (let ((directory (or (filexec-substring-until-last (aref "/" 0) regexp)
		       "./"))
	(name-pattern (filexec-substring-after-last (aref "/" 0) regexp))
	(full-file-name nil)
	(tmp nil)
	(buf (buffer-name)))
    (list-directory directory)
    (set-buffer "*Directory*")
    (message (format "** scanning for file: %s" name-pattern)) 
    (goto-char (point-max))
    (if (search-backward-regexp (format "^%s" name-pattern) (point-min) t)
	(progn
	  (beginning-of-line)
	  (setq tmp (point-marker))
	  (end-of-line)
	  (kill-ring-save tmp (point-marker))
	  (setq full-file-name (format "%s%s" directory (car kill-ring)))))
    ;; ----------------------------------------------------------

    (kill-buffer "*Directory*")
    (set-buffer buf)
    (if full-file-name
	(insert-file full-file-name)
	(message (format "** No file matching pattern >>%s<< found." regexp)))))

;;; //////////////////////////////////////////////////////////////////
;;; [5] system function execution
;;; //////////////////////////////////////////////////////////////////

(defun filexec-wait-for-process-termination (process-name)
  "Check in the *Process list*, until the name does not occur any more."
  (let ((buf (buffer-name)))
    (set-buffer "*Process List*")
    (while (progn (list-processes)
		  (goto-char (point-min))
		  (search-forward process-name (point-max) t)))
    (message (format "?? %s finished ??" process-name))
    (set-buffer buf)))


;;; //////////////////////////////////////////////
;;; [5.1] shell calls
;;; //////////////////////////////////////////////

(defun filexec-call-command-capture-output (&rest r)
  "Call a (system) command and return the output in a string.
!! DANGER !!			    
I hope you know what your are doing when calling this."
  (let ((buf (buffer-name))	    
	(pos nil)		    
	(process nil)		    
	(process-name (car r))	    
	(full-process (filexec-conc-list-with-spaces (append r '(";exit 99"))))
	);;(format "%s-2821-%d" (car r) (length r))))
    (set-buffer "*scratch*")	    
    (goto-char (point-max))	    
    (setq pos (point-marker))	    
    (insert "\n")		    
    (setq process 		    
	  (start-process-shell-command
	   process-name		    
	   "*scratch*"		    
	   full-process))	    
    (while (equal 0 (process-exit-status process))
      (message "** process running.")
      (filexec-abort-unless 	    
       (filexec-query-approval-assume-yes (format "Capture output of process %s" process-name))
       (format "** ABORT: refused to capture \"%s\"" process-name)))
    (message (format "** process %s terminated." process-name))
    ;;(filexec-wait-for-process-termination process-name)
;    (goto-char pos)		    
;    (error "end")		    
    (goto-char (point-max))	    
    (previous-line 2)		    
    (beginning-of-line)
    (kill-region (+ pos 1) (point-marker))
    (delete-region pos (point-max))
    (message (format "** captured output: %s" (car kill-ring)))
    (set-buffer buf)
    (car kill-ring)))

(defun filexec-call-command (&rest r)
  "Call a (system) command and spam output to buffer 
  *filexec-shell-output-buffer*
!! DANGER !!
I hope you know what your are doing when calling this."
  (let ((buf (buffer-name))
	(process-name (car r))
	(process nil)
	(full-process (filexec-conc-list-with-spaces (append r '(";exit 99"))))
	);;(format "%s-2821-%d" (car r) (length r))))
    (setq process 
	  (start-process-shell-command
	   process-name
	   *filexec-shell-output-buffer*
	   full-process))
    (while (equal 0 (process-exit-status process)))))



;;; //////////////////////////////////////////////////////////////////
;;; [6] Main
;;; //////////////////////////////////////////////////////////////////

(defun filexec-run ()
  (interactive)
  (save-excursion
    (let ((pos (point-marker))
	  (tmp nil)
	  (n-exectuted 0))
      (filexec-abort-unless 
       (filexec-query-approval "Execute all functions in this file (may cause damage!) "))
      (goto-char (point-min))
      (while (and (if *filexec-max-calls*
		      (< n-exectuted *filexec-max-calls*)
		      t)
		  (search-forward-regexp *filexec-start-pattern* (point-max) t))
	(setq n-exectuted (+ 1 n-exectuted))
	(setq tmp (point-marker))
	(search-forward-regexp *filexec-end-pattern*)
	(search-backward-regexp *filexec-end-pattern*)
	(kill-ring-save tmp (point-marker))
	(filexec-define-function (car kill-ring))
	(next-line 1)
	(beginning-of-line)
	(message (format "** executing: %s" (car kill-ring)))
	(funcall *filexec-temporary-function-name*))
      ;; --------------------------------------------------------
      (message (format "** EXECUTED %d function calls." n-exectuted))
      (message "** done.")
      (goto-char pos))))

;;; //////////////////////////////////////////////
;;; [6.1] Partial: Only one execution
;;; //////////////////////////////////////////////

(defun filexec-command-under-point ()
  "Execute the command under point.
Will not do anything, if point is not in between 
  *filexec-start-pattern* and  *filexec-end-pattern*."
  (interactive)
  (save-excursion
    (let ((pos (point-marker))
	  (aux nil)
	  (start nil))
      (filexec-abort-unless 
       (filexec-query-approval "Execute functions under point (may cause damage!) "))
      (search-backward-regexp *filexec-start-pattern*)
      (setq aux (point-marker))
      (search-forward-regexp *filexec-start-pattern*)
      (setq start (point-marker))
      (search-forward-regexp *filexec-end-pattern*)
      (if (and (< pos (point-marker))
	       (< aux pos))
	  (progn
	    (search-backward-regexp *filexec-end-pattern*)
	    (kill-ring-save start (point-marker))
	    (filexec-define-function (car kill-ring))
	    (next-line 1)
	    (beginning-of-line)
	    (message (format "** executing: %s" (car kill-ring)))
	    (funcall *filexec-temporary-function-name*)
	    (message "** EXECUTED filexec command under point."))
	  (error "** ERROR: no FILEXEC pattern under point"))
      (goto-char pos))))


;;; //////////////////////////////////////////////////////////////////////
;;; [7] Key Definitions
;;; //////////////////////////////////////////////////////////////////////

(global-set-key [f7] 'filexec-run)

;;; ------------------------------------------------------------------

(provide 'filexec)