From f4f8133607572b862998fcecf5efb9dba5402eb6 Mon Sep 17 00:00:00 2001 From: Axel Naumann Date: Wed, 20 Sep 2023 14:16:55 +0200 Subject: [PATCH] [config] Remove config/root-help.el.in: it is GPLed and thus incompatible. --- cmake/modules/RootConfiguration.cmake | 1 - config/root-help.el.in | 1340 ------------------------- 2 files changed, 1341 deletions(-) delete mode 100644 config/root-help.el.in diff --git a/cmake/modules/RootConfiguration.cmake b/cmake/modules/RootConfiguration.cmake index ed99dac3be001..5555325bc9bf3 100644 --- a/cmake/modules/RootConfiguration.cmake +++ b/cmake/modules/RootConfiguration.cmake @@ -854,7 +854,6 @@ configure_file(${CMAKE_SOURCE_DIR}/config/setxrd.csh ${CMAKE_RUNTIME_OUTPUT_DIRE configure_file(${CMAKE_SOURCE_DIR}/config/setxrd.sh ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/setxrd.sh COPYONLY) configure_file(${CMAKE_SOURCE_DIR}/config/proofserv.in ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/proofserv @ONLY NEWLINE_STYLE UNIX) configure_file(${CMAKE_SOURCE_DIR}/config/roots.in ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/roots @ONLY NEWLINE_STYLE UNIX) -configure_file(${CMAKE_SOURCE_DIR}/config/root-help.el.in root-help.el @ONLY NEWLINE_STYLE UNIX) configure_file(${CMAKE_SOURCE_DIR}/config/rootssh ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/rootssh @ONLY NEWLINE_STYLE UNIX) if(xproofd AND xrootd AND ssl AND XROOTD_NOMAIN) configure_file(${CMAKE_SOURCE_DIR}/config/xproofd.in ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}/xproofd @ONLY NEWLINE_STYLE UNIX) diff --git a/config/root-help.el.in b/config/root-help.el.in deleted file mode 100644 index 905fb93978dcc..0000000000000 --- a/config/root-help.el.in +++ /dev/null @@ -1,1340 +0,0 @@ -;;; root-help.el --- Helper functions for ROOT -;; -*- mode: emacs-lisp -*- -;; -;; $Id: root-help.el.in,v 1.1 2002/07/31 20:44:26 rdm Exp $ -;; -;; Emacs lisp functions to help write ROOT based projects -;; Copyright (C) 2002, 2003 Christian Holm Christensen -;; -;; This program 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 of the -;; License, or (at your option) any later version. -;; -;; This program 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 this program; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -;; 02110-1301, USA -;; -;; Author: Christian Holm Christensen -;; Maintainer: Christian Holm Christensen -;; Created: 20:34:51 Thursday 05/09/02 CEST -;; Version: 1.2 -;; Keywords: oop programming -;; -;;; Commentary: -;; -;; The Emacs Lisp library `root-help.el' provides a number of -;; function to ease the development of ROOT based classes and -;; projects. -;; -;; I'll bet you, that after using this for a while, you'll never -;; want to go back to using a normal terminal for running ROOT - -;; unless you're a Vi-lover of course :-). -;; -;; Installation -;; -;; To use the Emacs Lisp library, download `root-help.el' and put -;; it somewhere Emacs looks for Lisp libraries. For people who -;; have system operator privileges, the following directories are -;; good candidates: -;; -;; /usr/share/emacs/site-lisp -;; /usr/share/emacs//site-lisp -;; /usr/local/share/emacs/site-lisp -;; /usr/local/share/emacs//site-lisp -;; /usr/lib/emacs/site-lisp -;; /usr/lib/emacs//site-lisp -;; /usr/local/lib/emacs/site-lisp -;; /usr/local/lib/emacs//site-lisp -;; -;; where `' is the version number of the Emacs you're -;; using. -;; -;; For normal users, one should create the directory -;; -;; ${HOME}/share/emacs/site-lisp -;; -;; And add the line below to `~/.emacs': -;; -;; (setq load-path (cons "~/share/emacs/site-lisp" load-path)) -;; -;; In any case, users that want to use the ROOT Emacs Lisp helper -;; functions should add the line below to their `~/.emacs': -;; -;; (require 'root-help) -;; -;; System operators may have some way of providing the library -;; system wide. For example on Debian systems, one can add the -;; file `/etc/emacs/site-start.d/50root-help.el' with the contents -;; -;; (require 'root-help) -;; -;; and the library functions will be available system wide. See -;; also your Emacs manual for more information. -;; -;; Functions -;; -;; All the functions in the library are invoked by typing -;; -;; M-x -;; -;; where `M-x' means "Meta key down and then `x'", where the Meta -;; key is usually defined to `Alt' and `Esc', and `' is -;; the function to be invoked. -;; -;; No key-bindings have been setup per default, but this is easily -;; done using the customisation support of Emacs. Alternatively -;; one can define key-bindings in ones `~/.emacs' file. For -;; example, one could bind the functions in C++ mode like this: -;; -;; (defun root-c++-mode-hook () -;; "Hook for C++ mode - binding ROOT functions" -;; (define-key c++-mode-map "\C-crc" 'root-class) -;; (define-key c++-mode-map "\C-crh" 'root-header-skel) -;; (define-key c++-mode-map "\C-crs" 'root-source-skel) -;; (define-key c++-mode-map "\C-cri" 'root-include-header) -;; (define-key c++-mode-map "\C-crm" 'root-main) -;; (define-key c++-mode-map "\C-crl" 'root-insert-linkdef) -;; (define-key c++-mode-map "\C-crp" 'root-insert-pragma) -;; (define-key c++-mode-map "\C-crx" 'root-shell) -;; (define-key c++-mode-map "\C-crg" 'root-send-line-to-root) -;; (define-key c++-mode-map "\C-crr" 'root-send-region-to-root) -;; (define-key c++-mode-map "\C-crb" 'root-send-buffer-to-root) -;; (define-key c++-mode-map "\C-crf" 'root-execute-file)) -;; (add-hook 'c++-mode-hook 'root-c++-mode-hook) -;; -;; root-class [NAME SCOPE INCDIR SRCDIR] -;; Make two new files for a ROOT based class. All arguments are -;; optional, and if not provided, the user will be prompted for -;; them. `NAME' is the name of the class. This can not be left -;; blank. `SCOPE' the preprocessor scope for header guards, or -;; `ROOT' if left blank. `INCDIR' is where the declaration file -;; will live, defaults to current directory. `SRCDIR' is where -;; the definition file will live, defaults to current directory. -;; -;; root-header-skel [SCOPE BASE DSCR] -;; Insert a skeleton for a ROOT based class The class name is -;; derived from the current buffers file name, if possible, -;; otherwise the user is prompted for it. All arguments are -;; optional. If not specified, the user will be prompted for it. -;; -;; `SCOPE' is the preprocessor scope for header guards, and -;; `BASE' is the possible base class, and `DSCR' a short doc -;; string -;; -;; root-source-skel [SCOPE DSCR] -;; Insert a skeleton for a ROOT based class The class name is -;; derived from the current buffers file name, if possible, -;; otherwise the user is prompted for it. All arguments are -;; optional. If not specified, the user will be prompted for it. -;; -;; `SCOPE' is the preprocessor scope for header guards, and DSCR -;; a short description -;; -;; root-include-header [HEADER SCOPE] -;; Insert an `#include' statement with guards for a ROOT class -;; -;; `HEADER' is the name of the class to include a header for, and -;; `SCOPE' is the optional scope, which defaults to `ROOT'. If -;; not given, `HEADER' is read from the minibuffer with -;; completion. The completion is based on the file names found in -;; `root-include-directory'. -;; -;; root-main -;; Insert a skeleton for a ROOT based program Two function will -;; be created - one which has the name of the current buffer with -;; out extensions, and which the user is to fill in, and a `main' -;; function that calls this function. Like this, we can use the -;; file for both interactive input, due to use of guards, and as -;; a program. -;; -;; The user will be prompted for whether graphics is needed or -;; not. If yes, then a `TApplication' object is created in the -;; `main' function. -;; -;; root-insert-linkdef -;; Insert lines appropriate for a linkdef file into current -;; buffer -;; -;; The user will be prompted for classes to add to the linkdef -;; file. An empty string ends the input. -;; -;; root-insert-pragma [NAME NEED-PLUS] -;; Insert a pragma linkdef line for a class All arguments are -;; optional. If not given, the user will be prompted for them. -;; `NAME' is the name of class, and if `NEED-PLUS' is non-nil, an -;; `+' will be appended to the class name line. -;; -;; root-shell [SCRIPT] -;; Start an interactive ROOT session in a buffer The executable -;; stored in `root-executable' is executed with the arguments -;; `root-executable-args'. If Emacs is running in a non-graphics -;; terminal (like a VT100) `root-executable-args-nographics' is -;; passed to the executable. -;; -;; If the optional [SCRIPT] argument is given, it should be a -;; file name that will be inserted into the session on startup. -;; -;; root-send-line-to-root -;; Sends the current line to an interactive ROOT session. If no -;; session currently exists, one will be created. The point is -;; moved down one line, and left in the current window (buffer). -;; You can use this to step throught a script. -;; -;; root-send-region-to-root [START END] -;; Sends the contents of the current region to an interactive -;; ROOT session. If no session exists, then one will be -;; created. The point is left in the current window. -;; -;; root-send-buffer-to-root -;; Sends the current buffer to an interactive ROOT session. -;; If no session exists, then one will be created. The point is -;; left in the current window. If the buffer has an associated -;; file, and it has been modified since the last save, then the -;; user will be prompted for whether she wants to save the buffer -;; or not. -;; -;; Customisation -;; -;; The library depends on a number of variables that the user may -;; customise using Emacs' regular customisation support. All the -;; customisation is in the sub-group `Root' of the group -;; `Programming - Tools' -;; -;; root-include-directory -;; Where the ROOT headers reside. If the `ROOTSYS' environment -;; variable is set, this defaults to `${ROOTSYS}/include', -;; otherwise to `/usr/include/root' -;; -;; root-executable -;; Full path to the ROOT interactive executable. If the `ROOTSYS' -;; environment variable is set, this defaults to -;; `${ROOTSYS}/bin/root', otherwise to `/usr/bin/root' -;; -;; root-executable-args -;; Arguments to pass to `root-executable'. Per default this is -;; empty. -;; -;; root-executable-args-nographics -;; Arguments to pass to `root-executable' in case Emacs is -;; running in a non-graphics environment, like a VT100 terminal -;; or similar. Per default this is set to `"-l -b"' -;; -;; root-execute-file -;; Execute the current buffer in an interactive ROOT session. -;; -;; If no session exists, then one will be created. With a prefix -;; argument, the user is asked to provide a file name. -;; -;;____________________________________________________________________ -;; -;;; Code: - -;;____________________________________________________________________ -(require 'term) - -;;____________________________________________________________________ -(defgroup root nil - "ROOT's Object Oriented Technologies helper functions" - :group 'programming - :group 'tools) - -;;____________________________________________________________________ -(defcustom root-include-directory - (if (getenv "ROOTSYS") - (concat (getenv "ROOTSYS") "/include") - "@incdir@") - "Where the ROOT headers reside" - :group 'root) - -;;____________________________________________________________________ -(defcustom root-executable - (if (getenv "ROOTSYS") - (concat (getenv "ROOTSYS") "/bin/root.exe") - "@bindir@/root.exe") - "Full path to the ROOT interactive executable" - :group 'root) - -;;____________________________________________________________________ -(defcustom root-executable-args "" - "Arguments passed to the \\[root-executable]" - :group 'root) - -;;____________________________________________________________________ -(defcustom root-executable-args-nographics "-l -b" - "Arguments passed to the \\[root-executable] in non-graphics environment" - :group 'root) - -;;____________________________________________________________________ -(defface root-shell-startup-face nil - "Face to use for the startup text in the root shell" - :group 'root) -(copy-face 'default 'root-shell-startup-face) -(setq root-shell-startup-face 'root-shell-startup-face) - -;;____________________________________________________________________ -(defface root-shell-prompt-face nil - "Face to use for the prompt in the root shell" - :group 'root) -(copy-face 'underline 'root-shell-prompt-face) -(setq root-shell-prompt-face 'root-shell-prompt-face) - -;;____________________________________________________________________ -(defface root-shell-keyword-face nil - "Face to for keywords in the root shell" - :group 'root) -(copy-face 'font-lock-keyword-face 'root-shell-keyword-face) -(setq root-shell-keyword-face 'root-shell-keyword-face) - -;;____________________________________________________________________ -(defface root-shell-warning-face nil - "Face to for warnings and errors in the root shell" - :group 'root) -(copy-face 'font-lock-warning-face 'root-shell-warning-face) -(setq root-shell-warning-face 'root-shell-warning-face) - -;;____________________________________________________________________ -(defface root-shell-string-face nil - "Face to for strings in the root shell" - :group 'root) -(copy-face 'font-lock-string-face 'root-shell-string-face) -(setq root-shell-string-face 'root-shell-string-face) - -;;____________________________________________________________________ -(defface root-shell-constant-face nil - "Face to for constants in the root shell" - :group 'root) -(if (string-match "XEmacs\\|Lucid" emacs-version) - (copy-face 'default 'root-shell-constant-face) - (copy-face 'font-lock-constant-face 'root-shell-constant-face)) -(setq root-shell-constant-face 'root-shell-constant-face) - -;;____________________________________________________________________ -(defface root-shell-variable-face nil - "Face to for variables in the root shell" - :group 'root) -(copy-face 'font-lock-variable-name-face 'root-shell-variable-face) -(setq root-shell-variable-face 'root-shell-variable-face) - -;;____________________________________________________________________ -(defface root-shell-function-face nil - "Face to for functions in the root shell" - :group 'root) -(copy-face 'font-lock-function-name-face 'root-shell-function-face) -(setq root-shell-function-face 'root-shell-function-face) - -;;____________________________________________________________________ -(defface root-shell-builtin-face nil - "Face to for builtins in the root shell" - :group 'root) -(if (string-match "XEmacs\\|Lucid" emacs-version) - (copy-face 'font-lock-keyword-face 'root-shell-builtin-face) - (copy-face 'font-lock-builtin-face 'root-shell-builtin-face)) -(setq root-shell-builtin-face 'root-shell-builtin-face) - - -;;____________________________________________________________________ -(defface root-shell-type-face nil - "Face to for types in the root shell" - :group 'root) -(copy-face 'font-lock-type-face 'root-shell-type-face) -(setq root-shell-type-face 'root-shell-type-face) - -;;____________________________________________________________________ -(defun root-class (&optional name scope incdir srcdir dscr) - "Make two new files for a ROOT based class. - -All arguments are optional, and if not provided, the user will be -prompted for them. - -NAME is the name of the class. This can not be left blank. SCOPE the -preprocessor scope for header guards, or 'ROOT' if left blank. INCDIR -is where the declaration file will live, defaults to current -directory. SRCDIR is where the definition file will live, defaults -to current directory. DSCR is the short description. - -Uses \\[root-header-skel] and \\[root-source-skel]" - (interactive) - ;; Read the class name from the minibuffer is the user didn't supply - ;; one - (while (or (not name) (string= name "")) - ;; If that's not possible prompt user for it - (setq name (read-string "Class name: "))) - ;; Get the preprocessor scope if not passed by user - (if (not scope) (setq scope (read-string "Scope: "))) - ;; Figure out where to put the declaration file - (if (not incdir) - (setq incdir (read-string "Declaration directory (.): "))) - ;; Set default if user types C-j - (if (eq (length incdir) 0) (setq incdir ".")) - ;; Figure out where to put the declaration file - (if (not srcdir) - (setq srcdir (read-string "Implementation directory (.): "))) - ;; Set default if user types C-j - (if (eq (length srcdir) 0) (setq srcdir ".")) - ;; Make file names - (let ((header-name) (source-name)) - (setq header-name (if (string= "." incdir) (concat name ".h") - (concat incdir "/" name ".h"))) - (setq source-name (if (string= "." srcdir) (concat name ".cxx") - (concat srcdir "/" name ".cxx"))) - ;; Check that files doesn't exist - (if (file-exists-p header-name) - (error "Header file '%s' already exists - will not overwrite" - header-name)) - (if (file-exists-p source-name) - (error "Source file '%s' already exists - will not overwrite" - source-name)) - ;; Check files are writable - (if (not (file-writable-p header-name)) - (error "Cannot write header file '%s'" header-name)) - (if (not (file-writable-p source-name)) - (error "Cannot write source file '%s'" source-name)) - ;; Open the header file and make that current buffer - (find-file header-name) - (c++-mode) - ;; Write the header skeleton - (root-header-skel scope) - ;; Save the file - (save-buffer) - ;; Open the source file and make that current buffer - (if (not (string= incdir ".")) - (find-file-other-window (concat "../" source-name)) - (find-file-other-window source-name)) - ;; Write the source skeleton - (root-source-skel scope) - ;; Save the file - (save-buffer) - ;; Write a message to user - (message "Class is in '%s' and '%s'" header-name source-name))) - -;;____________________________________________________________________ -(defun root-header-skel (&optional scope base dscr) - "Insert a skeleton for a ROOT based class - -The class name is derived from the current buffers file name, if -possible, otherwise the user is prompted for it. All arguments are -optional. If not specified, the user will be prompted for it. - -SCOPE is the preprocessor scope for header guards, BASE is the -possible base class, and DSCR is a short description of the class" - (interactive) - (let (name) - ;; Get the class name form the filename of the buffer - (setq name (file-name-sans-extension (buffer-name))) - ;; If that failed, prompt the user for it - (while (or (not name) (string= name "")) - ;; If that's not possible prompt user for it - (setq name (read-string "Class name: "))) - ;; If the scope isn't set, - (if (or (not scope) (string= "" scope)) (setq scope "ROOT")) - ;; If the base file isn't set, prompt the user for it. - (if (or (not base) (string= "" base)) - (setq base (root-read-class "Base class: " "TObject"))) - ;; Get a description string - (if (or (not dscr) (string= dscr "")) - (setq dscr (read-string "Documentation: " "DOCUMENT ME"))) - ;; Go to the top of the file - (goto-char (point-min)) - (insert "// -*- mode: c++ -*- \n") - (root-insert-header-info) - (insert "#ifndef " scope "_" name "\n#define " scope "_" name "\n") - (if (and base (not (string= base ""))) (root-include-header base)) - (insert "\nclass " name) - (if (and base (not (string= base ""))) (insert " : public " base)) - (insert " -{ -private: -public: - " name "(); - virtual ~" name "() {} - - ClassDef(" name ",0) //" dscr " -}; - -#endif -") - (root-insert-bottom-info) - (goto-char (point-min)))) - -;;____________________________________________________________________ -(defun root-source-skel (&optional scope dscr) - "Insert a skeleton for a ROOT based class - -The class name is derived from the current buffers file name, if -possible, otherwise the user is prompted for it. All arguments are -optional. If not specified, the user will be prompted for it. - -SCOPE is the preprocessor scope for header guards, and DSCR is a -description string." - (interactive) - (let (name) - ;; Get the class name form the filename of the buffer - (setq name (file-name-sans-extension (buffer-name))) - ;; If that failed, prompt the user for it - (while (or (not name) (string= name "")) - ;; If that's not possible prompt user for it - (setq name (read-string "Class name: "))) - ;; If the scope isn't set, - (if (or (not scope) (string= "" scope)) (setq scope "ROOT")) - ;; Get a description string - (if (or (not dscr) (string= dscr "")) - (setq dscr (read-string "Long description: " "DOCUMENT ME"))) - (goto-char (point-min)) - ;; Insert a skeleton for the class description - (insert - "//____________________________________________________________________ -// -// " dscr " -// - -") - ;; Insert author, date, copyright information - (root-insert-header-info) - ;; Include the class declaration - (root-include-header name scope) - ;; Insert a dummy CTOR and class implementation macro - (insert " -//____________________________________________________________________ -ClassImp(" name "); - -//____________________________________________________________________ -" name "::" name "() -{ - // Default constructor -} - -") - (root-insert-bottom-info) - (goto-char (point-min)))) - -;;____________________________________________________________________ -(defun root-insert-header-info () - "Inserts some lines for a header, including CVS Id, author, date copyright" - (insert -"//____________________________________________________________________ -// -// $Id" "$ -// Author: " (user-full-name) " <" user-mail-address "> -// Update: " (format-time-string "%Y-%m-%d %T%z") " -// Copyright: " (format-time-string "%Y") " (C) " (user-full-name) " -// -")) - -;;____________________________________________________________________ -(defun root-insert-bottom-info () - "Inserts some lines for a footer" - (insert -"//____________________________________________________________________ -// -// EOF -// -")) - -;;____________________________________________________________________ -(defun root-include-header (&optional header scope) - "Insert an #include statement with guards for a ROOT class - -HEADER is the name of the class to include a header for, and SCOPE is -the optional scope, which defauls to 'ROOT'. If not given, HEADER is -read from the minibuffer _with_ completion. The completion is based on -the file names found in \\[root-include-directory]" - (interactive) - ;; Read the class name (with completion) from user if it isn't given - ;; already - (if (not header) (setq header (root-read-class "Class name: " nil))) - ;; If the scope ins't set, set it to ROOT - (if (or (not scope) (string= "" scope)) (setq scope "ROOT")) - ;; Insert the lines we need - (insert "#ifndef " scope "_" header - "\n#include \"" header ".h\"\n#endif\n")) - -;;____________________________________________________________________ -(defun root-main () - "Insert a skeleton for a ROOT based program - -Two function will be created - one which has the name of the current -buffer with out extensions, and which the user is to fill in, and a -'main' function that calls this function. Like this, we can use the -file for both interactive input, due to use of guards, and as a -program. - -The user will be prompted for wether graphics is needed or not. If -yes, then a TApplication object is created in the main function." - (interactive) - ;; - (let (name) - (setq name (file-name-sans-extension (buffer-name))) - (setq need-application (y-or-n-p "Do you need graphics ")) - (goto-char (point-min)) - (root-insert-header-info) - (insert "//\n#ifndef __CINT__\n") - (if need-application (root-include-header "TApplication")) - (insert "// PUT HEADERS HERE -#endif - -int " name "() -{ - // DEFINE YOUR MAIN FUNCTION HERE - - return 0; -} - -#ifndef __CINT__ -int main(int argc, char** argv) -{ - ") - (if need-application - ;; If we need an application, then we insert, that, store the - ;; return value of the function, run the application, and - ;; return the stored return value. - (insert "TApplication " name "App(\"" name "App\", &argc, argv); - int retVal = " name "(); - " name "App.Run(); - return retVal;") - ;; Otherwise we just insert the call - (insert "return " name "();")) - ;; Closing brace - (insert "\n}\n#endif\n\n") - ;; Bottom of the file - (root-insert-bottom-info) - (goto-char (point-min)))) - -;;____________________________________________________________________ -(defun root-insert-linkdef () - "Insert lines appropriate for a linkdef file into current buffer - -The user will be prompted for classes to add to the linkdef file. An -empty string ends the input." - (interactive) - (insert "// -*- mode: c++ -*-\n") - (root-insert-header-info) - (insert " -#ifndef __CINT__ -#error Not for compilation -#endif - -#pragma link off all functions; -#pragma link off all globals; -#pragma link off all classes; - -") - ;; Let the user add classes right away - (while - (progn (setq name (read-string "Add a class: ")) - (> (length name) 0)) - (root-insert-pragma name)) - ;; insert a new line and the end stuff - (insert "\n") - (root-insert-bottom-info) - (goto-char (point-min))) - -;;____________________________________________________________________ -(defun root-insert-pragma (&optional name need-plus) - "Insert a pramga linkdef line for a class - -All arguments are optional. If not given, the user will be prompted -for them. NAME is the name of class, and if NEED-PLUS is non-nil, an -'+' will be appended to the class name line." - (interactive) - ;; Read the class name - (while (or (not name) (string= name "")) - ;; If that's not possible prompt user for it - (setq name (read-string "Class name: "))) - ;; Check if we need a plus or not. - (if (not need-plus) - (setq need-plus (y-or-n-p "Do you schema evolution "))) - ;; Insert the actual line - (insert "#pragma link C++ class " name) - ;; insert the plus if we need it. - (if need-plus (insert "+")) - ;; and a final newline - (insert ";\n")) - -;;____________________________________________________________________ -(defun root-complete-class (name filter flag) - "Completition function for root-read-class. - -It looks up the passed name in the ROOT header directory set by -\\[root-include-directory], and does the matching on files there." - (if flag - ;; Return a list of all possible completions - (let (files) - (setq files - (file-name-all-completions name root-include-directory)) - (if (not files) (error "no matches on '%s'" name)) - (mapcar 'file-name-sans-extension files)) - ;; Returns: - ;; t if an exact match is found, - ;; nil if no possible match is found, - ;; completion if unique - ;; Longest possible completion if not - (let (first) - (setq first (file-name-completion name root-include-directory)) - (if (and (stringp first) (string= first (concat name ".h"))) - t - (progn - (if (stringp first) - (file-name-sans-extension first))))))) - -;;____________________________________________________________________ -(defun root-read-class (prompt default) - "Interactively read the name of a ROOT class. - -Completion is done based on the file names found in -\\[root-include-directory]" - (completing-read prompt 'root-complete-class nil nil default)) - -;;____________________________________________________________________ -(defun sys-include-header (&optional header) - "Insert an #include for a system header" - (interactive) - (if (not header) - (setq header (read-string "Header name: "))) - (insert "#ifndef __" (upcase header) "__\n" - "#include <" (symbol-value 'header) ">\n" - "#endif\n")) - -;;____________________________________________________________________ -(defvar root-shell-font-lock-keywords - '(("^ \\*+$" . root-shell-startup-face) - ("^ \\*.*\\*$" . root-shell-startup-face) - ("^Compiled for.*$" . root-shell-startup-face) - ("^CINT/ROOT C/C\\+\\+ .*$" . root-shell-startup-face) - ("^Type \\? for help\\. Commands must be .*$" . root-shell-startup-face) - ("^Enclose multiple statements.*$" . root-shell-startup-face) - ("^FreeType Engine .* used to render.*$" . root-shell-startup-face) - ("root \\[[0-9]+\\]" . root-shell-prompt-face) - ("Root *>" . root-shell-prompt-face) - ("end with '.'[^>]*>" . root-shell-prompt-face) - ("^ *\\*+ Interpreter error recovered \\*+$" . root-shell-warning-face) - ("^ *\\*+ Break \\*+ " . root-shell-warning-face) - ("^\\(Sys\\)?Error" . root-shell-warning-face) - ("^Warning" . root-shell-warning-face) - ("^Fatal" . root-shell-warning-face) - ("\"[^\"]*\"" . root-shell-string-face) - ("0[xX][0-9A-Fa-f]+" . root-shell-constant-face) - ("[+-]?[0-9]+\\.?[0-9]*[eE][+-]?[0-9]+[lL]?" . root-shell-constant-face) - ("[+-]?[0-9]*\\.[0-9]+[eE][+-]?[0-9]+[lL]?" . root-shell-constant-face) - ("\\b[+-]?[0-9]+\\.?[0-9]*[uUlL]?\\b" . root-shell-constant-face) - ("\\b[+-]?[0-9]*\\.[0-9][uUlL]?\\b" . root-shell-constant-face) - ("\\(//.*\\|/\\*.*\\*/\\)" . root-shell-comment-face) - ("\(\\sw+\\s-*\)(" . root-shell-function-face) - ("\\b\\sw+_t\\b" . root-shell-type-face) - ("\\(T[A-Z]\\sw+\\|E[A-Z]\\sw+\\)" . root-shell-type-face) - ("\\b\\(const_\\)?iterator\\b" . root-shell-type-face) - ("\\b\\([io]+\\|[io]?[f]\\)stream\\b" . root-shell-type-face) - ("\\b[io]?strstream\\b" . root-shell-type-face) - ("\\b\\(if\\|else\\|for\\|while\\|do\\)\\b" . root-shell-keyword-face) - ("\\b\\(case\\|switch\\)\\b" . root-shell-keyword-face) - ("\\b\\(typedef\\|typename\\|typeid\\)\\b" . root-shell-keyword-face) - ("\\b\\(class\\|struct\\)\\b" . root-shell-keyword-face) - ("\\b\\(new\\|delete\\|sizeof\\)\\b" . root-shell-keyword-face) - ("\\b\\(register\\|static\\|mutable\\)\\b" . root-shell-keyword-face) - ("\\b\\(volatile\\|const\\)\\b" . root-shell-keyword-face) - ("\\b\\(private\\|protected\\|public\\)\\b" . root-shell-keyword-face) - ("\\b\\(cout\\|cerr\\|cin\\|endl\\)\\b" . root-shell-variable-face) - ("\\b\\(flush\\|setw\\|setprecision\\)\\b" . root-shell-variable-face) - ("\\b\\(gROOT\\|gStyle\\)\\b" . root-shell-variable-face) - ("\\b\\(gApplication\\|gPad\\)\\b" . root-shell-variable-face) - ("\\b\\(int\\|short\\|long\\|unsigned\\)\\b" . root-shell-type-face) - ("\\b\\(float\\|double\\|char\\)\\b" . root-shell-type-face) - ("\\b\\(map\\|vector\\|list\\|multimap\\)\\b" . root-shell-type-face) - ("\\b\\(string\\|complex\\|streambuf\\)\\b" . root-shell-type-face) - ("\\b\\(exception\\|runtime_error\\)\\b" . root-shell-type-face) - ("\\.\\S-+" . root-shell-builtin-face) - ) - "Additional expressions to highlight in ROOT intaractive mode.") -;;____________________________________________________________________ -(defconst root-name "ROOT" - "The name of ROOT") - -;;____________________________________________________________________ -(defconst root-shell-buffer (concat "*" root-name "*") - "The name of the root-shell buffer") - -;;____________________________________________________________________ -(defun root-shell-histo (dimension type) - "Make a histogram in the interactive shell" - (interactive (list - (let ((d 0)) - (while (<= d 0) - (setq d (string-to-int (read-string "Dimension: ")))) d) - (read-char "Type: "))) - (let ((type (format "TH%d%c" dimension (upcase type))) - (name "h") - (command nil)) - (while (progn - (setq name (read-string "Name: " name)) - (string= name ""))) - (setq command (concat type "* " name " = new " type "(\"" name "\",\"")) - (setq command (concat command (read-string "Title: " ) "\",")) - (dotimes (i dimension) - (let ((bins "") (low "") (high "")) - (setq axis (cond ((= i 0) "X") ((= i 1) "Y") ((= i 2) "Z"))) - (while - (progn - (setq bins (read-string (concat "# of " axis " bins: "))) - (<= (string-to-int bins) 0))) - (setq command (concat command bins ",")) - (setq low (read-string (concat axis " minimum: "))) - (setq command (concat command low ",")) - (while - (progn - (setq high (read-string (concat axis " maximum: "))) - (> (string-to-int low) (string-to-int high)))) - (setq command (concat command high - (cond ((= (1+ i) dimension) ")") (t ",")))))) - (root-shell-paste (concat command ";\n") nil))) - -;;____________________________________________________________________ -(defun root-shell-histo-1c () "" (interactive) (root-shell-histo 1 ?C)) -(defun root-shell-histo-1s () "" (interactive) (root-shell-histo 1 ?S)) -(defun root-shell-histo-1f () "" (interactive) (root-shell-histo 1 ?F)) -(defun root-shell-histo-1d () "" (interactive) (root-shell-histo 1 ?D)) -(defun root-shell-histo-1k () "" (interactive) (root-shell-histo 1 ?K)) - -;;____________________________________________________________________ -(defun root-shell-histo-2c () "" (interactive) (root-shell-histo 2 ?C)) -(defun root-shell-histo-2s () "" (interactive) (root-shell-histo 2 ?S)) -(defun root-shell-histo-2f () "" (interactive) (root-shell-histo 2 ?F)) -(defun root-shell-histo-2d () "" (interactive) (root-shell-histo 2 ?D)) -(defun root-shell-histo-2k () "" (interactive) (root-shell-histo 2 ?K)) - -;;____________________________________________________________________ -(defun root-shell-histo-3c () "" (interactive) (root-shell-histo 3 ?C)) -(defun root-shell-histo-3s () "" (interactive) (root-shell-histo 3 ?S)) -(defun root-shell-histo-3f () "" (interactive) (root-shell-histo 3 ?F)) -(defun root-shell-histo-3d () "" (interactive) (root-shell-histo 3 ?D)) -(defun root-shell-histo-3k () "" (interactive) (root-shell-histo 3 ?K)) - -;;____________________________________________________________________ -(defun root-shell-browser () "" (interactive) - (root-shell-paste "TBrowser* b = new TBrowser(\"b\", \"Browser\");\n" nil)) - -;;____________________________________________________________________ -(defun root-shell-canvas () "" (interactive) - (root-shell-paste "TCanvas* c = new TCanvas(\"c\", \"Canvas\");\n" nil)) - -;;____________________________________________________________________ -(defun root-shell-file (&optional file mode) - "" - (interactive) - (if (or (not file) (string= "file")) - (progn - (setq file (read-file-name "File to open: ")) - (if (and file (not (file-directory-p file))) - (setq file (expand-file-name file)) - (error "No file to open")))) - (if (not (file-exists-p file)) (setq mode "RECREATE")) - (if (not mode) (setq mode (read-string "How to open the file: " "READ"))) - (root-shell-paste (concat "TFile* file = TFile::Open(\"" file - "\",\"" mode "\");\n") nil)) - - -;;____________________________________________________________________ -(defun root-shell-command (command &optional arg file yn) - "" - (let ((command (concat "." command))) - (if arg - (if file - (progn - (setq file (read-file-name arg)) - (if (and file (not (file-directory-p file))) - (setq file (expand-file-name file)) - (error "No file argument given to %s" command)) - (setq command (concat command " " file))) - (if yn - (if (y-or-n-p (concat "Turn on " arg " ")) - (setq command (concat command " 1")) - (setq command (concat command " 0")))) - (setq command (concat command " "(read-string arg))))) - (root-shell-paste (concat command "\n") nil))) -(defun root-shell-redirect-output () "" - (interactive) (root-shell-command ">" "Output file: " t)) -(defun root-shell-redirect-error () "" - (interactive) (root-shell-command "2>" "Error file: " t)) -(defun root-shell-redirect-both () "" - (interactive) (root-shell-command ">&" "File: " t)) -(defun root-shell-help () "" - (interactive) (root-shell-command "help")) -(defun root-shell-help-search () "" - (interactive) (root-shell-command "/" "Keyword: ")) -(defun root-shell-shell () "" - (interactive) (root-shell-command "!" "Shell command: ")) -(defun root-shell-view () "" - (interactive) (root-shell-command "v" "Line: ")) -(defun root-shell-view-stack () "" - (interactive) (root-shell-command "V" "Line: ")) -(defun root-shell-trace () "" - (interactive) (root-shell-command "t")) -(defun root-shell-debug-file () "" - (interactive) (root-shell-command "f" "File: " t)) -(defun root-shell-toggle-trace () "" - (interactive) (root-shell-command "T")) -(defun root-shell-toggle-auto () "" - (interactive) (root-shell-command "A" "automatic variables" nil t)) -(defun root-shell-trace-class () "" - (interactive) (root-shell-command "trace" "Class: ")) -(defun root-shell-untrace-class () "" - (interactive) (root-shell-command "deltrace" "Class: ")) -(defun root-shell-print-expr () "" - (interactive) (root-shell-command "p" "Expression: ")) -(defun root-shell-step-expr () "" - (interactive) (root-shell-command "s" "Expression: ")) -(defun root-shell-step-over-expr () "" - (interactive) (root-shell-command "S" "Expression: ")) -(defun root-shell-exec-file () "" - (interactive) (root-shell-command "x" "File: " t)) -(defun root-shell-exec-filefunc () "" - (interactive) (root-shell-command "X" "File: " t)) -(defun root-shell-edit () "" - (interactive) (root-shell-command "E" "File (optional): " t)) -(defun root-shell-load () "" - (interactive) (root-shell-command "L" "File: " t)) -(defun root-shell-reload () "" - (interactive) (root-shell-command "La" "File: " t)) -(defun root-shell-unload () "" - (interactive) (root-shell-command "U" "File: " t)) -(defun root-shell-toggle-copy () "" - (interactive) (root-shell-command "C" "copy to temporary directory" nil t)) -(defun root-shell-undo () "" - (interactive) (root-shell-command "undo")) -(defun root-shell-lang () "" - (interactive) (root-shell-command "lang")) -(defun root-shell-global () "" - (interactive) (root-shell-command "g" "Global variable (empty for all): ")) -(defun root-shell-local () "" - (interactive) (root-shell-command "l" "Local Variable (empty for all): ")) -(defun root-shell-class () "" - (interactive) (root-shell-command "class" "Class (empty for all): ")) -(defun root-shell-class-all () "" - (interactive) (root-shell-command "Class" "Class (empty for all): ")) -(defun root-shell-typedef () "" - (interactive) (root-shell-command "typedef" "Type (empty for all): ")) -(defun root-shell-function () "" - (interactive) (root-shell-command "function")) -(defun root-shell-macro () "" - (interactive) (root-shell-command "macro")) -(defun root-shell-template () "" - (interactive) (root-shell-command "template")) -(defun root-shell-include () "" - (interactive) (root-shell-command "include")) -(defun root-shell-files () "" - (interactive) (root-shell-command "file")) -(defun root-shell-where () "" - (interactive) (root-shell-command "where")) -(defun root-shell-security () "" - (interactive) (root-shell-command "security")) -(defun root-shell-refcount () "" - (interactive) (root-shell-command "refcount")) -(defun root-shell-garbage () "" - (interactive) (root-shell-command "garbage")) -(defun root-shell-do-garbage () "" - (interactive) (root-shell-command "Garbage")) -(defun root-shell-cover () "" - (interactive) (root-shell-command "cover" "File: " t)) -(defun root-shell-return () "" - (interactive) (root-shell-command "return" "Value: ")) -(defun root-shell-ignore () "" - (interactive) (root-shell-command "i")) -(defun root-shell-continue () "" - (interactive) (root-shell-command "c" "Line (optional): ")) -(defun root-shell-step-out () "" - (interactive) (root-shell-command "e")) -(defun root-shell-break () "" - (interactive) (root-shell-command "break" "Line: ")) -(defun root-shell-del-break () "" - (interactive) (root-shell-command "db" "Line: ")) -(defun root-shell-assert () "" - (interactive) (root-shell-command "a" "Expression (blank to turn off): ")) -(defun root-shell-optimization () "" - (interactive) (root-shell-command "O" "Level [0-4]: ")) -(defun root-shell-toggle-debug () "" - (interactive) (root-shell-command "debug")) -(defun root-shell-toggle-disassembler () "" - (interactive) (root-shell-command "dasm")) -(defun root-shell-quit () "" - (interactive) (root-shell-command "q")) -(defun root-shell-force-quit () "" - (interactive) (root-shell-command "qqq")) -(defun root-shell-save () "" - (interactive) (root-shell-command "save")) - - -;;____________________________________________________________________ -(defvar root-shell-mode-map nil "Mode map for \\[root-shell-mode]") -(defun root-shell-mode-make-map () - "Defines the keymap. This _must_ be called after \\[term-char-mode], -otherwise, the parent mode \\[term-raw-map] is not defined yet, hence -this function" - (cond - ((not root-shell-mode-map) - (let (map menumap menumap-top) - ;; Top-level keymap - (if (string-match "XEmacs\\|Lucid" emacs-version) - (progn - (set-keymap-parents map (list term-raw-map)) - (set-keymap-name map 'root-shell-mode-map)) - (setq map (nconc (make-sparse-keymap) term-raw-map))) - - (define-key map "\C-crh" 'root-shell-histo) - (define-key map "\C-crb" 'root-shell-browser) - (define-key map "\C-crc" 'root-shell-canvas) - (define-key map "\C-crx" 'root-shell-script) - (define-key map "\C-crf" 'root-shell-file) - - ;; ROOT menu map - (setq menumap-top (make-sparse-keymap "ROOT")) - - ;; Misc menu - (setq menumap (make-sparse-keymap "Miscellaneous")) - (define-key menumap [root-shell-save] - '("Emergency save" . root-shell-save)) - (define-key menumap [root-shell-force-quit] - '("Forced quit" . root-shell-force-quit)) - (define-key menumap [root-shell-quit] - '("Quit" . root-shell-quit)) - (define-key menumap [seperator2] '("--")) - (define-key menumap [root-shell-toggle-auto] - '("Toggle automatic variables" . root-shell-toggle-auto)) - (define-key menumap [root-shell-shell] - '("Shell command..." . root-shell-shell)) - (define-key menumap [seperator1] '("--")) - (define-key menumap [root-shell-help-search] - '("Help search..." . root-shell-help-search)) - (define-key menumap [root-shell-help] '("Help" . root-shell-help)) - (define-key menumap [seperator0] '("--")) - (define-key menumap [root-shell-undo] - '("Undo previous declarations" . root-shell-undo)) - (define-key menumap-top [misc] (cons "Miscellaneous" menumap)) - - ;; Redirection menu - (setq menumap (make-sparse-keymap "Redirections")) - (define-key menumap [root-shell-redirect-both] - '("Redirect output and error..." . root-shell-redirect-both)) - (define-key menumap [root-shell-redirect-error] - '("Redirect error..." . root-shell-redirect-error)) - (define-key menumap [root-shell-redirect-output] - '("Redirect output..." . root-shell-redirect-output)) - (define-key menumap-top [redirections] (cons "Redirections" menumap)) - - ;; Bytecode menu - (setq menumap (make-sparse-keymap "Byte code")) - (define-key menumap [root-shell-optimization] - '("Set optimization..." . root-shell-optimization)) - (define-key menumap [root-shell-toggle-debug] - '("Toggle bytecode display" . root-shell-toggle-debug)) - (define-key menumap [root-shell-toggle-disassembler] - '("Toggle disassembler" . root-shell-toggle-disassembler)) - (define-key menumap-top [garbage] (cons "Byte code" menumap)) - - ;; Garbage menu - (setq menumap (make-sparse-keymap "Garbage collection")) - (define-key menumap [root-shell-refcount] - '("Toggle reference counting" . root-shell-refcount)) - (define-key menumap [root-shell-do-garbage] - '("Do garbage collection" . root-shell-do-garbage)) - (define-key menumap [root-shell-garbage] - '("Show garbage" . root-shell-garbage)) - (define-key menumap-top [garbage] (cons "Garbage Collection" menumap)) - - ;; Inspect menu - (setq menumap (make-sparse-keymap "Inspect")) - (define-key menumap [root-shell-lang] - '("Show Language" . root-shell-lang)) - (define-key menumap [root-shell-security] - '("Show security level" . root-shell-security)) - (define-key menumap [root-shell-where] - '("Show file position" . root-shell-where)) - (define-key menumap [root-shell-file] - '("Show loaded files" . root-shell-files)) - (define-key menumap [root-shell-include] - '("Show include include path" . root-shell-include)) - (define-key menumap [root-shell-template] - '("Show templates" . root-shell-template)) - (define-key menumap [root-shell-macro] - '("Show macros" . root-shell-macro)) - (define-key menumap [root-shell-function] - '("Show functions" . root-shell-function)) - (define-key menumap [root-shell-typedef] - '("Show typedef..." . root-shell-typedef)) - (define-key menumap [root-shell-class-all] - '("Show Class (all-levels)..." . root-shell-class-all)) - (define-key menumap [root-shell-class] - '("Show Class..." . root-shell-class)) - (define-key menumap [root-shell-local] - '("Show local variable..." . root-shell-local)) - (define-key menumap [root-shell-global] - '("Show global variable..." . root-shell-global)) - (define-key menumap-top [inpect] (cons "Inspect" menumap)) - - ;; Stack menu - (setq menumap (make-sparse-keymap "Stack")) - (define-key menumap [root-shell-cover] - '("Save trace coverage..." . root-shell-cover)) - (define-key menumap [root-shell-untrace-class] - '("Don't Trace class..." . root-shell-untrace-class)) - (define-key menumap [root-shell-trace-class] - '("Trace class..." . root-shell-trace-class)) - (define-key menumap [root-shell-trace] - '("Trace function call stack" . root-shell-trace)) - (define-key menumap [root-shell-view-stack] - '("View stack around..." . root-shell-view-stack)) - (define-key menumap [root-shell-view] - '("View around..." . root-shell-view)) - (define-key menumap [root-shell-toggle-trace] - '("Toggle trace mode" . root-shell-toggle-trace)) - (define-key menumap-top [stack] (cons "Stack" menumap)) - - ;; Debug menu - (setq menumap (make-sparse-keymap "Debug")) - (define-key menumap [root-shell-assert] - '("Assert ..." . root-shell-assert)) - (define-key menumap [root-shell-del-break] - '("Delete breakpoint..." . root-shell-del-break)) - (define-key menumap [root-shell-break] - '("Set breakpoint..." . root-shell-break)) - (define-key menumap [root-shell-return] - '("Return..." . root-shell-return)) - (define-key menumap [root-shell-continue] - '("Continue to line..." . root-shell-continue)) - (define-key menumap [root-shell-ignore] - '("Ignore statement" . root-shell-ignore)) - (define-key menumap [root-shell-step-out] - '("Step out from function" . root-shell-step-out)) - (define-key menumap [root-shell-step-over-expr] - '("Step over expression..." . root-shell-step-over-expr)) - (define-key menumap [root-shell-step-expr] - '("Step into expression..." . root-shell-step-expr)) - (define-key menumap [root-shell-print-expr] - '("Print expression..." . root-shell-print-expr)) - (define-key menumap [root-shell-debug-file] - '("Set file to debug..." . root-shell-debug-file)) - (define-key menumap-top [debug] (cons "Debug" menumap)) - - ;; Load menu - (setq menumap (make-sparse-keymap "Files")) - (define-key menumap [root-shell-exec-file] - '("Execute statements in file..." . root-shell-exec-file)) - (define-key menumap [root-shell-exec-filefunc] - '("Execute function in file..." . root-shell-exec-filefunc)) - (define-key menumap [root-shell-edit] - '("Edit file..." . root-shell-edit)) - (define-key menumap [root-shell-load] - '("Load file..." . root-shell-load)) - (define-key menumap [root-shell-reload] - '("Reload all files after file..." . root-shell-reload)) - (define-key menumap [root-shell-unload] - '("Unload file..." . root-shell-unload)) - (define-key menumap [root-shell-toggle-copy] - '("Toggle copy to temporary" . root-shell-toggle-copy)) - (define-key menumap-top [files] (cons "Files" menumap)) - - - (define-key menumap-top [seperator1] '("--")) - - ;; Sub-menu 3D histograms - (setq menumap (make-sparse-keymap "3D histograms")) - (define-key menumap [root-shell-histo-3d] - '("TH3D..." . root-shell-histo-3d)) - (define-key menumap [root-shell-histo-3f] - '("TH3F..." . root-shell-histo-3f)) - (define-key menumap [root-shell-histo-3s] - '("TH3S..." . root-shell-histo-3s)) - (define-key menumap [root-shell-histo-3c] - '("TH3C..." . root-shell-histo-3c)) - (define-key menumap [root-shell-histo-3k] - '("TH3K..." . root-shell-histo-3k)) - (define-key menumap-top [h3] (cons "3D Histograms" menumap)) - - ;; Sub-menu 2D histograms - (setq menumap (make-sparse-keymap "2D histograms")) - (define-key menumap [root-shell-histo-2d] - '("TH2D..." . root-shell-histo-2d)) - (define-key menumap [root-shell-histo-2f] - '("TH2F..." . root-shell-histo-2f)) - (define-key menumap [root-shell-histo-2s] - '("TH2S..." . root-shell-histo-2s)) - (define-key menumap [root-shell-histo-2c] - '("TH2C..." . root-shell-histo-2c)) - (define-key menumap [root-shell-histo-2k] - '("TH2K..." . root-shell-histo-2k)) - (define-key menumap-top [h2] (cons "2D Histograms" menumap)) - - ;; Sub-menu 1D histograms - (setq menumap (make-sparse-keymap "1D histograms")) - (define-key menumap [root-shell-histo-1d] - '("TH1D..." . root-shell-histo-1d)) - (define-key menumap [root-shell-histo-1f] - '("TH1F..." . root-shell-histo-1f)) - (define-key menumap [root-shell-histo-1s] - '("TH1S..." . root-shell-histo-1s)) - (define-key menumap [root-shell-histo-1c] - '("TH1C..." . root-shell-histo-1c)) - (define-key menumap [root-shell-histo-1k] - '("TH1K..." . root-shell-histo-1k)) - (define-key menumap-top [h1] (cons "1D Histograms" menumap)) - - (define-key menumap-top [seperator0] '("--")) - - ;; Menu entries - (define-key menumap-top [root-shell-browser] - '("Browser" . root-shell-browser)) - (define-key menumap-top [root-shell-canvas] - '("Canvas" . root-shell-canvas)) - (define-key menumap-top [root-shell-file] - '("File..." . root-shell-file)) - (define-key menumap-top [root-shell-script] - '("Script..." . root-shell-script)) - - (define-key map [menu-bar root] (cons "ROOT" menumap-top)) - - (setq root-shell-mode-map map))))) - -;;___________________________________________________________________ -(defun root-shell-mode () - "Major mode for a ROOT interactive shell - -This uses the \\[term-mode] to do most stuff. Key bindings are as in -that mode. Extra syntax highlighting is performend." - (interactive) - (term-mode) - (term-char-mode) - (setq major-mode 'root-shell-mode) - (setq mode-name root-name) - (root-shell-mode-make-map) - (use-local-map root-shell-mode-map) - (force-mode-line-update) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(root-shell-font-lock-keywords))) - -;;____________________________________________________________________ -(defun root-shell-exec (&optional script switch switchback) - "Executes ROOT in a buffer if it doesn't exists. - -Always sets the current edit buffer to the *ROOT* buffer. The optional -SCRIPT argument should be a file name" - (if (term-check-proc root-shell-buffer) - (let ((proc (get-buffer-process root-shell-buffer))) - (set-buffer root-shell-buffer) - (cond (script - (goto-char (point-max)) - (insert-file-contents script) - (setq script (buffer-substring (point-min) (point-max))) - (delete-region (point-min) (point-max)) - (term-send-string proc script)))) - (let* ((args)) - (setq args (if (not window-system) - root-executable-args-nographics - root-executable-args)) - (set-buffer (make-term root-name root-executable script args)) - (root-shell-mode))) - (if switch - (let ((window (selected-window))) - (switch-to-buffer-other-window root-shell-buffer) - (if switchback - (select-window window))))) - - -;;____________________________________________________________________ -(defun root-shell-paste (&optional script switch) - "Make sure a ROOT process is running,and then paste string into process" - (root-shell-exec nil switch t) - (let ((proc (get-buffer-process root-shell-buffer))) - (set-buffer root-shell-buffer) - (cond (script - ;; (sleep-for 1) - (goto-char (point-max)) - (term-send-string proc script))))) - -;;____________________________________________________________________ -(defun root-shell (&optional script) - "Start an interactive ROOT session in a buffer - -The executable stored in \\[root-executable] is executed with the -arguments \\[root-executable-args]. If Emacs is running in a -non-graphics terminal (like a VT100) \\[root-executable-args-nographics] -is passed to the executable - -If the optional SCRIPT argument is given, it should be a file name -that will be inserted into the session on startup." - (interactive) - (if (term-check-proc root-shell-buffer) - (root-shell-paste script t) - (root-shell-exec script t nil))) - -;;____________________________________________________________________ -(defun root-send-buffer-to-root () - "Sends the current buffer to an interactive ROOT session. - -If no session exists, then one will be created. The point is -left in the current window. If the buffer has an associated -file, and it has been modified since the last save, then the -user will be prompted for whether she wants to save the buffer -or not. " - (interactive) - (let ((file (buffer-file-name)) - (tmp-file nil)) - (save-excursion - (if file - (if (buffer-modified-p) - (if (y-or-n-p "Save current buffer? ") (save-buffer)))) - (root-shell-paste (buffer-substring (point-min) (point-max)) t)))) - -;;____________________________________________________________________ -(defun root-send-region-to-root (&optional start end) - "Sends the contents of the current region to an interactive ROOT session. - -If no session exists, then one will be created. The point is left in -the current window." - (interactive "r") - (root-shell-paste (buffer-substring (region-beginning) (region-end)) t)) - -;;____________________________________________________________________ -(defun root-send-line-to-root () - "Sends the current line to an interactive ROOT session. - -If no session currently exists, one will be created. The point is -moved down one line, and left in the current window (buffer). -You can use this to step throught a script." - (interactive) - (let ((beg (point))) - (forward-line 1) (root-shell-paste (buffer-substring beg (point)) t))) - -;;____________________________________________________________________ -(defun root-shell-script (prefix) - "Execute the current buffer in an interactive ROOT session. - -If no session exists, then one will be created. With a prefix -argument, the user is asked to provide a file name." - (interactive "P") - (let ((file (buffer-file-name))) - (if (or (not file) prefix) - (setq file (expand-file-name - (read-file-name "File to execute: " nil nil t)))) - (if (and file (not (file-directory-p file))) - (setq file (expand-file-name file)) - (error "No file to execute")) - (if (and (buffer-file-name) - (string= file (expand-file-name (buffer-file-name))) - (buffer-modified-p)) - (if (y-or-n-p "Save current buffer? ") - (save-buffer))) - (root-shell-paste (concat ".x " file "\n")) t)) -(defun root-execute-file (prefix) "" (root-shell-script prefix)) - -;;____________________________________________________________________ -;; Identify this package -(provide 'root-help) - -;;____________________________________________________________________ -;; -;;; root-help.el ends here -;;