;;; after-save-commands.el --- Run a shell command after saving a file

;; Copyright (C) 1997,98,99 by  Karl M. Hegbloom

;; $Id: after-save-commands.el,v 1.7 2000/10/16 02:15:51 karl Exp $
;; Author: Karl M. Hegbloom <karlheg@cathcart.sysc.pdx.edu>
;; Keywords: processes,unix

;; This file is part of XEmacs.

;;; This might be rolled into `files.el' at some point in the near
;;; future, pending bug fixes, functionality/feature froze, and the
;;; approval of the XEmacs development team (and perhaps RMS... who
;;; will need to find someone to port it some for GNU Emacs if he
;;; would like to.)


;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Commentary:

;;; Set up a list of file-name matching regular expressions associated
;;; with shell commands to run after saving the file.

;;; This is good for things like running `newaliases(1)' on
;;; "/etc/aliases", `xrdb(1)' on "~/.Xresources", installing a new
;;; "~/.crontab", as well as for sending signals to daemons whos
;;; configuration files you've just finished editing.
;;; 
;;; It is much safer and more powerful than using exec statements in
;;; "Local Variables" sections, and can safely be used by root for
;;; system administration tasks.  The shell command can run about
;;; anything you can think of.
;;;
;;; Who knows?  Maybe Homekey Symsun will use this feature, and it
;;; will allow per to quickly run a daemon HUP after reconfiguration
;;; of the nuclear plant control file, thus saving an entire duchy
;;; from immanent destruction!
;;;
;;; See: `After-save-alist' for more information.

;;; Devel Notes:
;;;
;;;  I would like to perhaps... pull out the ~/ and ~name/ expansion
;;;  from `expand-file-name', and make a `tilde-expand'
;;;  function... and also a `expand-environment-in-string' that
;;;  doesn't try to do any tilde expanditsomes.  The regexp ought to
;;;  be split (by my code in this file?) on \\|, etc., and in the
;;;  relevant locations, expansion should be done, so that the regexp
;;;  can contain ~'s, and have it do what I mean there, like to match
;;;  files in a user's home directory...  ? maybe.

;;; Code:
;;;-----------------------------------------------------
(require 'env)
(require 'advice)

(defmacro After-save--with-modeline-process-extent-ext (&rest body)
  `(and modeline-process
	(consp modeline-process)
	(let ((ext (car modeline-process)))
	  (and (extentp ext) 
	       ,@body))))

(defun After-save--set-help-flyover (str)
  (After-save--with-modeline-process-extent-ext
   (let ((state (After-save--ascmd-property)))
     (cond
      ((eq :on state)
       (setq str (concat "Run:" str)))
      ((eq :off state)
       (setq str (concat "DON'T run:" str)))))
   (set-extent-property ext 'help-echo str)))

(defun After-save--get-help-flyover ()
  (After-save--with-modeline-process-extent-ext
   (let ((str (extent-property ext 'help-echo)))
     (string-match "^[^:]+:\\(.*\\)\\'" str)
     (match-string 1 str))))

(defun After-save--ascmd-property ()
  "Return the 'ascmd property of our extent in `modeline-process' if it
exists."
  (After-save--with-modeline-process-extent-ext
   (extent-property ext 'ascmd)))


(defun After-save--entry-lookup (buf-fn)
  "Lookup BUF-FN in `After-save-alist', and return that record."
  (if buf-fn
      (catch 'return
	(mapc #'(lambda (elt)
		  (if (string-match (car elt) buf-fn)
		  (throw 'return elt)))
	      After-save-alist)
	(throw 'return nil))))

;; Q: Is `modeline-process' ok?  Or is there a more standard place for
;; this?  At some point I'll be able to answer my own question, but
;; now have lots else I ought to be doing. (like reading for
;; instance.)  Please advise.  Yeah or Nay?

;;;###autoload
(defun After-save--find-file-hook ()
  "Look up the name of this file in `After-save-alist', and if it has
an entry, turn on the modeline button and indicator."
  (let ((file->cmd-entry (After-save--entry-lookup (buffer-file-name))))
    ;;; (declarelike (special file->cmd-entry)) ; need dynamic scope,
    ;;; this time.  Put up with one byte compiler warning.
    (if file->cmd-entry
	(After-save--install-ascmd))))

;; `autoload' these just in case then get stuck on the hook before the
;; setting of `After-save-alist' brings this program in with its
;; :require.  I think that could happen if the `find-file-hooks' gets
;; saved in `options.el' after this has been installed on it.  That
;; variable might come before the `defcustom'ed variables at the top
;; of this program.  Of course, once this feature is rolled into
;; "files.el", there's no need for it to be in the hooks anymore;
;; it'll be more inline... right?

;;;###autoload
(defun After-save--after-save-hook ()
  "An `after-save-hook' to run a shell-command.
This gets hung on the `after-save-hook'.
See: `After-save-alist'."
  (let ((file->cmd-entry (After-save--entry-lookup (buffer-file-name))))
    (if (and file->cmd-entry
	     (eq :on (After-save--ascmd-property)))
	;; The `copy-sequence' is important, since `setenv' mutates
	;; `process-environment' in place. (uses `setcar'...)  We want
	;; a copy of `process-environment' to get bound here, so the
	;; more global one, outside of this `let*' block, doesn't get
	;; its elements modified like that.
	(let ((process-environment (copy-sequence process-environment))
	      (environ-alist     (second file->cmd-entry))
	      (confirm-exec-flag (third  file->cmd-entry))
	      (command	         (fourth file->cmd-entry)))
	  ;; Here, the bound `process-environment' is modified, not
	  ;; the more global one.  The current dynamic value of it
	  ;; will get passed to the command's shell.
	  (setenv "f" (buffer-file-name))
	  (setenv "d" (default-directory))
	  (if environ-alist
	      (mapc #'(lambda (env-pair)
			(setenv (car env-pair)
				(if (cdr env-pair)
				    ;; expand $vars
				    ;; does not expand tilde's...
				    ;; there is no `expand-environ-in-string'
				    ;; or `tilde-expand' AFAIK
				    (substitute-in-file-name (cdr env-pair))
				  nil)))
		    environ-alist))
	  (cond
	   (confirm-exec-flag
	    (if (y-or-n-p (format "Run:%S ? " command))
		(shell-command command)))
	   ((not confirm-exec-flag)
	    (shell-command command)))))))

;; I'd just use `minor-mode-alist', but I want the fly-over to show
;; the after save command rather than "button2 will...".
(defun After-save--install-ascmd ()
  "Install a modeline indicator."
  (let ((ext (make-extent nil nil))
	(km (make-sparse-keymap)))
    (set-extent-property ext 'ascmd :on)
    (set-extent-face ext 'modeline-mousable-minor-mode)
    ;;; ref to free var file->cmd-entry : rely on dynamic scope.
    (define-key km [(button2)] #'(lambda ()
				   (interactive)
				   (After-save--toggle-ascmd)))
    (set-extent-keymap ext km)
    (setq modeline-process (cons ext " AScmd"))
    (After-save--set-help-flyover (fourth file->cmd-entry))
    (redraw-modeline)))


(copy-face 'modeline-mousable-minor-mode 'After-save--strikethu-face)
;;; Wish: (set-face-strikethru-p 'After-save--strikethu-face t :strikethru-spaces nil)
(set-face-strikethru-p 'After-save--strikethu-face t)

(defun After-save--toggle-ascmd ()
  "Turn AScmd off if on, on if off, but not on if not installed in this
buffer yet."
  (interactive)
  (let* ((ext (and modeline-process
		   (consp modeline-process)
		   (car modeline-process)))
	 (state (After-save--ascmd-property)))
    (and (extentp ext)
	 (cond
	  ((eq state :off)
	   (set-extent-property ext 'ascmd :on)
	   (set-extent-face ext 'modeline-mousable-minor-mode))
	  ((eq state :on)
	   (set-extent-property ext 'ascmd :off)
	   (set-extent-face ext 'After-save--strikethu-face))))
    (After-save--set-help-flyover (After-save--get-help-flyover))
    (redraw-modeline)))

;; Will of course be unnecessary once this is part of "files.el"
;; someday when it grows up and is ready to join the core of
;; xemacs/lisp/*.el society as a full fledged member.
(defadvice write-file (before After-save activate)
  (if (After-save--ascmd-property)
      (setq modeline-process nil)))

 ;; At least in XEmacs-21.0 Pyrenean63, `write-file' calls
 ;; `set-visited-file-name' which uses `kill-local-variable' to clear
 ;; both `write-file-hooks' and `after-save-hook', amoung others...

(defadvice write-file (after After-save activate)
  (After-save--find-file-hook))

;; I shouldn't have to use `after-init-hook' like this...  Or should
;; I?  I think maybe I ought to be able to use just a straight out
;; `add-hook' here.  But when `find-file-hooks' has been customized,
;; it's value can get set to an arbitrary list after this `add-hook'
;; is run, thus wiping it out. So I have to install it on the
;; `after-init-hook' like this.  It might be nice if the hook type
;; would be initialized by custom with an add-hook... Then again,
;; maybe sticking an add-hook onto the `after-init-hook' like this is
;; really just the standard way of getting a function onto the list?
;; Perhaps by makeing `custom-set-variables' set the hook to an
;; absolute value, we make it possible to know for certain what it's
;; startup time value will be...  minus additions by packages like
;; this one.  YTMAWBK OTOH, perhaps `custom-set-variables' ought to
;; use `add-hook', so that whenif things like this are installed
;; earlier than when the options.el file is run, they won't get wiped
;; out.
(add-hook 'after-init-hook
	  #'(lambda ()
	      (add-hook 'find-file-hooks 'After-save--find-file-hook)
	      (add-hook 'after-save-hook 'After-save--after-save-hook)))

;; And once for when we load this, in case that's sometime after the
;; `after-init-hook' has already been run, like the first time a new
;; user customizes `After-save-alist'.  `add-hook' will ensure it's
;; only in there once.
(add-hook 'find-file-hooks 'After-save--find-file-hook)
(add-hook 'after-save-hook 'After-save--after-save-hook)

;;; "... or should I just put ;;;###autoload cookies in front of those
;;; add-hook's?"  No, again, I'm afraid that somebody might customize
;;; the hooks and they'll overwrite what the `autoload' brings in. And
;;; besides, there's a :require statement in the `defcustom' for
;;; `After-save-alist', which is easily accessed from the [ Options |
;;; Customize | Emacs | Files ] menu.

(defcustom After-save-alist
  '(("/etc/X11/Xresources/\\|/\\.Xresources" nil t "xrdb $f")
    ("/\\.crontab\\'" nil t "crontab $f")
    ("/etc/inetd.conf" nil t "echo /etc/init.d/netbase reload")
    ("#  __JUST_FOR_EXAMPLE__  #"
     (("Set_ME" . "to some value")
      ("UN_Set_ME"))
     nil "echo 'rm -rf / && Bwahahahha!'"))
  "*This option is for associating file name patterns to shell commands.

These are shell commands you would like XEmacs to run for you after a
file with a name that matches a regexp has been edited and saved.

You may also specify whether you want to be asked for confirmation
each time you save the file, prior to running that command, on a per-
command basis.

While you are visiting a file that has an `after-save-command'
associated with it, the modeline will display \"AScmd\" in the minor
mode list, and moving the mouse over that indicator will cause the
buffer's associated shell command to be displayed in the
minibuffer. Clicking button 2 there will toggle whether the command
will be run or not.

This facility can be very handy for doing things like running
`newaliases\(1)' after you've edited the `sendmail\(8)' daemon's
\"/etc/aliases\" file, running `xrdb\(1)' after you've hand tweaked
your \".Xresource\" settings, installing a \".crontab\", or sending a
signal to a system daemon whos configuration file you've just
modified.

You may create or change these settings while you are visiting a file,
since it works by installing a function in the global
`after-save-hook', and a lookup in `After-save-alist' for your command
spec happens then.  You may also change the settings for a file that's
already got an after-save entry, prior to saving it.

The command you specify will be run in a subshell, out of the
`after-save-hook', using the lisp function `shell-command'.  You can
cause it to background by suffixing the command with the usual \"&\".
It will inherit the `process-environment' of your XEmacs session,
along with the specified environment modifications, as well as the
following automatically defined variables:

   $f -- The full path and filename of the file, `buffer-file-name'
   $d -- The directory, with a trailing \"/\" where the file was saved.

The `Var=\"Value\" pair' environment variables will be defined in the
context the shell command will be run in.  You may reference
previously defined environment variables within the `Value' fields,
since they are expanded sequentially, from top to bottom, using
`substitute-in-file-name', just before the command is run.  $f and $d
are set first, and so may be used for expansion within your
environment specifications, as well as in the commandline.

Note that no shell processing will be done until the commandline is
fed to your shell.  That is, globbing or brace expansions and things
don't happen until the command is run.

If you use `write-file' (`C-x C-w') to write the visited buffer to a
different filename, the `after-save-command' will not be run, and the
after save command property will be removed from the buffer, unless
the new file name matches one of your `After-save-alist'
specifications,"

  :require 'after-save-commands
  :set #'(lambda (var val)
	   (set-default var val)
	   (mapc #'(lambda (b)
		     (with-current-buffer b
		       (if (After-save--ascmd-property)
			   (setq modeline-process nil))
		       (After-save--find-file-hook)))
		 (buffer-list))
	   (redraw-modeline t))
  :type '(repeat
	  (list :tag
		"------------------------------------------------------------"
		:indent 2
		(regexp :tag "File name regexp " "")
		(repeat :tag "Environment"
			:indent 1
			(cons :tag "Var=\"Value\" pair "
			      (string :tag "Variable " "")
			      (choice (string :tag "Value " "")
				      (const :tag "unset" nil))))
		(boolean :tag "Confirm before execution? " t)
		(string :tag "Shell Command line " "")))
  :group 'files)

(provide 'after-save-commands)
;;; after-save-commands.el ends here
