diff options
Diffstat (limited to 'elisp/erbot/contrib/shs.el')
| -rw-r--r-- | elisp/erbot/contrib/shs.el | 552 |
1 files changed, 552 insertions, 0 deletions
diff --git a/elisp/erbot/contrib/shs.el b/elisp/erbot/contrib/shs.el new file mode 100644 index 0000000..b2b3311 --- /dev/null +++ b/elisp/erbot/contrib/shs.el @@ -0,0 +1,552 @@ +;;; shs.el --- facilitate SHell Scripting through Emacs. +;; Time-stamp: <2006-05-08 00:00:17 deego> +;; Copyright (C) 2005 D. Goel +;; Emacs Lisp Archive entry +;; Filename: shs.el +;; Package: shs +;; Author: D. Goel <deego@gnufans.org> +;; Keywords: +;; Version: 0.0 +;; URL: http://gnufans.net/~deego +;; For latest version: + +(defconst shs-home-page + "http://gnufans.net/~deego/emacspub/lisp-mine/shs/") + +;; Copyright (C) 2005 D. Goel + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This 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 3, or (at your option) +;; any later version. + +;; This 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + + + +;; sh.el, posted here a few days ago has been renamed to shs.el since +;; there exists another sh.el -- shs stands for SHell-Script. + +;; SHS: Shs aims to facilitate free mixing of elisp with bash: free +;; calls to elisp code from bash shell scripts and calls to other bash +;; scripts from that elisp code, which may again call elisp code and +;; so on, all the while doing the right things as regards bash's error +;; codes, stderr, stdout, etc. + +;; Moreover, one shouldn't need to exit emacs just to pipe one emacs +;; script's call to another. + +;; Finally, elisp code should also be able to run independently of +;; bash in running emacsen. + +;; Provides basic setup for emacs scripting. To the beginning of all +;; emacs shell-scripts, don't forget to add (add-to-list 'load-path +;; directory) and (require 'shs). Use shs as a convenient way to call +;; shell-commands from the script. Provides a tutorial on elisp-based +;; shell-scripting. + + +(eval-when-compile (require 'cl)) + + +;; The most common functions to use are: shs-process (shsp), shs-shell +;; (shsh). + +;; Alt, using shell command: shsh. +;; Best way to show messages: shs-message. + +;; Your code should automatically run fine, both in shellscripts as +;; well as emacs: + + +;; The easiest way to pass messages would be to (message) or +;; (princ). However, that makes it somewhat meaningless in running +;; emacs, so prefer using (shs-message) instead. When using +;; shs-message in running Emacs, all these messages go to *SHS* +;; buffer, which you'll finally want to switch to and see. + + + +;; See also: + + +;; Quick start: +(defconst shs-quick-start + "Help..." +) + +(defun shs-quick-start () + "Provides electric help from variable `shs-quick-start'." + (interactive) + (with-electric-help + '(lambda () (insert shs-quick-start) nil) "*doc*")) + +;;; Introduction: +;; Stuff that gets posted to gnu.emacs.sources +;; as introduction +(defconst shs-introduction + " \(sh.el, posted here a few days ago has been renamed to shs.el +since there exists another sh.el). + +shs stands for SHell-Scripting. + +I am an utter novice at shell scripting, so suggestions and comments +are most welcome, and please forgive any mistakes in shs. shs aims to +facilitate free mixing of elisp with bash: free calls to elisp code +from bash shell scripts and calls to other bash scripts from that +elisp code, which may again call elisp code and so on, all the while +doing the right things as regards bash's error codes, stderr, stdout, +etc. + +Moreover, one shouldn't need to exit emacs just to pipe one emacs +script's call to another. + +Finally, ideally, that elisp code should also be able to run +independently of bash in running emacsen. All that's what shs hopes +to faciliatate. + + +INSTALLATION: Just add shs.el somewhere in your emacs' load-path. + + +For a shell scripting example, (you do need EmacsCVS) + + +Drop shs.el and the two attached files to a ~/location that is present +both in your emacs' loadpath as well as bash's PATH. Create a +~/.emacs.script with these contents: + + (add-to-list 'load-path \"~/location\") + +To be able to use your settings in running emacsen too, also add to +the end of ~/.emacs: (load \"~/.emacs.script\") + +Then, from bash, run shs-example, for a tutorial (I am still learning) +on shell-scripting through Emacs. + +Whenever you call shsp instead of shsh, COMMAND is no longer a +string. It is rather a list whose 1st value is the process, and the +rest of the values are the args. + +For script examples to work, you do need emacscvs installed in (or +linked to from) /usr/local/bin/emacscvs. + +" +) + +;;;###autoload +(defun shs-introduction () + "Provides electric help from variable `shs-introduction'." + (interactive) + (with-electric-help + '(lambda () (insert shs-introduction) nil) "*doc*")) + +;;; New features: +(defconst shs-new-features + "Help..." +) + +(defun shs-new-features () + "Provides electric help from variable `shs-new-features'." + (interactive) + (with-electric-help + '(lambda () (insert shs-new-features) nil) "*doc*")) + +(defconst shs-version "0.0") + +;; Real Code + + +;; Always make your function +(defmacro shs-exit-code-1 (&rest body) + "Normally, if the script errors somewhere, Emacs will immediately +exit with an error code of 255, which is the right thing to do. If +for some reason, you want a different error code, you can wrap this +macro around your lisp code." + (let ((err (gensym))) + `(condition-case ,err (progn ,@body) + (error + (shsm "Error: %S" (error-message-string ,err)) + (kill-emacs 1))))) + + + + +(defun shs-sanitize (str) + "Delete up to one trailing newline from the string. +Typically, shs.el feeds shell commands' output to this function, so +that the result does not have a trailing newline. Is like perl's chop, + except that this is applied automatically in shs" + + (replace-regexp-in-string + "\n\\'" "" (format "%s" str))) + +(defalias 'shs-chop 'shs-sanitize) + + + +(defalias 'shs-shell-exit 'shs-shell-command-with-exit) + +(defvar shs-shell-buffer "*SHS-SHELL*") +(defvar shs-process-buffer "*SHS-PROC*") +(get-buffer-create shs-shell-buffer) +(get-buffer-create shs-process-buffer) + +;;;###autoload +(defun shs-shell-command (command &rest args) + "Shell commands from a running script, exit on errors. + +NOT suitable for asynchronous shell commands. If everything ok, +then return the result of the shell-command as a string, else +exit emacs with the same exit code. + +COMMAND shou]d be a string. You can also give us the command in +the shsp format: a list. In that case, we shall try to guess the +command by converting it to a string by concatting the +shell-quote-argument for each argument. But note that shsp might +be safer. +" + (shsh--reset-buffer) + (setq command (shs-convert-command-list-to-string-maybe command)) + (let ((code (apply 'shell-command command shs-shell-buffer nil)) + (output + (with-current-buffer shs-shell-buffer + (shs-sanitize + (buffer-substring (point-min) (point-max)))))) + + (cond + ((equal code 0) + output) + ;; as you see, the string-to-number of this error code will + ;; always be the correct error code. + (t (error "%S -- error code when trying %S\n Output was: %S" code + command output))))) + +(defun shs-convert-command-list-to-string-maybe (c) + (if (stringp c) + c + (shs-convert-command-list-to-string c))) + +(defun shs-convert-command-list-to-string (c) + (mapconcat 'shell-quote-argument + c " ")) + + +(defun shs-convert-command-string-to-list-maybe (c) + (if (listp c) + c + (shs-convert-command-string-to-list c))) + +(defun shs-convert-command-string-to-list (c) + (split-string c)) + + +;;;###autoload +(defun shs-shell-command-and-code (command &rest args) + (shsh--reset-buffer) + (let ((code (apply 'shell-command command shs-shell-buffer nil))) + (list code + (with-current-buffer shs-shell-buffer + (shs-sanitize + (buffer-substring (point-min) (point-max))))))) + + + + +(defun shsp--reset-buffer () + (with-current-buffer shs-process-buffer + (delete-region (point-min) (point-max)))) + +(defun shsh--reset-buffer () + (with-current-buffer shs-shell-buffer + (delete-region (point-min) (point-max)))) + +;;;###autoload +(defun shs-process-and-code (command &optional infile) + (shsp--reset-buffer) + (let ((code (apply 'call-process (car command) infile shs-process-buffer + nil (cdr command)))) + (list code + (with-current-buffer shs-process-buffer + (shs-sanitize + (buffer-substring (point-min) (point-max))))))) + +;;;###autoload +(defun shs-process (command &optional infile instring outfile appendp) + "process from a running script, exit on errors. + +NOT suitable for asynchronous processes. If everything ok, +then return the result of the shell-command as a string, else +error with the same exit code. + +COMMAND shou]d be a list. You can also give us the command in +the shsh format: a string. In that case, we shall convert it to +a list by taking every word in that string. But note that list +might be safer. + +Both infile and instring can be nil, in which case, no stdin is passed +to the process. + +If INFILE is non-nil it is used. If INFILE is nil and INSTRING is +not, we put instring in a temporary file, and use that as the +stdin. This is kinda like bash's <. + +If outfile is non-nil, the output is also written to outfile. If +appendp is non-nil, the output is appended to any preceding output. +These were kinda like bash's > and >>. + +pseudo-Pipes can be accomplished via use of instring. See, for +example, `shsu-pipe'. +" + (let ((rmp (and (not infile) instring))) + (setq command (shs-convert-command-string-to-list-maybe command)) + (when rmp + ;; see also, for example, shsu-mktemp-d + (setq infile (shsp "mktemp")) + (with-temp-buffer + (insert instring) + (let ((require-final-newline nil)) + (write-file infile nil)))) + (let* ((codeoutput (shs-process-and-code command infile)) + (code (car codeoutput)) + (output (cadr codeoutput))) + (when rmp (delete-file infile)) + (cond + ((equal code 0) + (when outfile + (with-temp-buffer + (when (and appendp (file-exists-p outfile)) + (insert-file-contents outfile)) + (goto-char (point-max)) + (insert output) + (let ((require-final-newline nil)) + (write-file outfile nil)))) + output) + ;; as you see, the string-to-number of this error code will + ;; always be the correct error code. + (t (error "%S -- error code when call-process: %S\n Output was: %S" code command output)))))) + + + + + +(defmacro shs-ignore-errors-flag (&rest body) + "Copied from ignore-errrors-my. + +which: Like ignore-errors, but tells the error.. +Improved for me by Kalle on 7/3/01: + * used backquote: something i was too lazy to convert my macro to.. + * removed the progn: condition-case automatically has one.. + * made sure that the return is nil.. just as it is in ignore-errors. " + (let ((err (gensym))) + `(condition-case ,err (progn ,@body) + (error + (ding t) + (ding t) + (ding t) + (shsm "IGNORED ERROR: %s" (error-message-string ,err)) + (sit-for 1) + nil)))) + + + + + + + + +;;;###autoload +(defalias 'shs-shell 'shs-shell-command) + + +;;;###autoload +(defalias 'shsh 'shs-shell-command) + + +;;;###autoload +(defalias 'shsp 'shs-process) + +;;;###autoload +(defalias 'shs-call-procell 'shs-process) + +(defun shs-shell-command-with-error (&rest args) + "NOT USED ANY MORE. +Shell commands from a running script, exit on errors. + +NOT suitable for asynchronous shell commands. If everything ok, +then return the result of the shell-command as a string, else +exit emacs with the same exit code. +" + (let ((code (apply 'shell-command args))) + (cond + ((equal code 0) + (with-current-buffer shs-shell-buffer + ;;(buffer-substring-no-properties (point-min) (point-max)))) + (shs-sanitize + (buffer-substring (point-min) (point-max))))) + (t (error (format "Bash Error code: %S" code)))))) + + + +(defvar shs-buffer "*SHS*") +(get-buffer-create shs-buffer) + +(defvar shs-message-sit-for 0.1 + "We wait for this duration at critical points when using shs. +Matters only when called within emacs. ") + +(defun shs-message (&rest args) + (cond + (noninteractive + (apply 'message args)) + (t + (save-excursion + (set-buffer (get-buffer-create shs-buffer)) + (goto-char (point-max)) + (insert "\n") + (insert (apply 'format args)) + (message + "%s" + (apply 'format args) + + ;;"Note: This message is saved in the *SHS* and *messages* + ;;buffer." + ) + (sit-for shs-message-sit-for))))) + + + +(defalias 'shs-msg 'shs-message) +(defalias 'shsm 'shs-message) + + +;; OBSOLETE +(defalias 'shs-shell-error 'shs-shell-command-with-error) + + +(defun shs-display-buffer () + (display-buffer shs-buffer) + (let ((cur (current-buffer))) + (set-buffer shs-buffer) + (goto-char (point-max)) + (set-buffer cur))) + + +(defvar shs-bye-hook (list 'shs-display-buffer)) + +(defun shs-bye () + (interactive) + (run-hooks 'shs-bye-hook) + ) + +(defun shs-clear-buffer () + (interactive) + (save-excursion + (set-buffer (get-buffer-create shs-buffer)) + (erase-buffer))) + +(defvar shs-start-hook (list 'shs-clear-buffer)) +(defun shs-start () + "For use when using shs from eshell. " + (interactive) + (run-hooks 'shs-start-hook)) + +(defvar shs-within-p nil + "When non-nil, start and end-hooks are NOT executed.. May be useful +to set via the `shs-within' macro one \"top-level\" shs function is +calling another.. + +In the default setting, this matters only when shs functions are used +from within emacs") + +(defmacro shs-within (&rest args) + `(let ((shs-within-p t)) + (progn ,@args))) + + +(defun shs-help (g) + "Call this function with your function name." + (shsm "") + (shsm + "Running this script calls the Emacs function described below.") + (shsm + (let* ((def (symbol-function g))) + (ignore-errors + (if (equal 'autoload (car-safe def)) + (load (second def)))) + ;; this check does nothing now.. need ro + + (describe-function g)))) + + + +(defun shs-help-check (args) + (let + ((argstr + (mapconcat + (lambda (a) (format "%s" a)) + args + " "))) + (or + (string-match "\\b-h\\b" argstr) + (string-match "help" argstr)))) + + +(defun shs-shell-flag (command &rest args) + " +Added back, since used by some of my scripts. " + (let ((coderes (apply 'shs-shell-command-and-code command args))) + (when (not (equal (first coderes) 0)) + (shsm "IGNORED: ERROR CODE: %S WHEN TRYING %S " (first coderes) + command)) + (second coderes))) + + +;;;###autoload +(defun shs-expand-file-name (file dired) + "Copied from utils-expand-file-name. + +Suggested by Paul Jarc on g.e.d. in 2005-07 when I raised this +issue: + +Emacs' default expand-file-name is slightly borked, the bork can be +seen if there is a file or a directory literally named ~. The bork +comes from the emacs-tilde-feature: anywhere emacs sees a ~ in a +path, it drops the entire preceding path and starts from /home/$USER +afresh. + +viz. Create a file ~/tmp/~. Then + \(expand-file-name (file-name-nondirectory \"~/tmp/~\") + \(file-name-directory \"~/tmp/~\")) +is incorrect + +The version below avoids that problem, but of course, it lacks +the emacs-tilde-feature. It is also portable across platforms, +including VMS. + +However, note that this function is not necc. conformant with expand-file-name +as far as argument structure and all function features are concerned. +" + (concat (file-name-as-directory dired) + (file-name-nondirectory file))) + + + + + + +(provide 'shs) + + |