From: Steve Youngs Date: Sun, 12 Jun 2016 10:19:57 +0000 (+1000) Subject: Remove old and crusty Sun pkg X-Git-Tag: auctex_2.00~18^2~4 X-Git-Url: http://cgit.sxemacs.org/?p=packages;a=commitdiff_plain;h=b40387f66f440ceae9237a9d3e89771105e06a9d;ds=sidebyside Remove old and crusty Sun pkg Signed-off-by: Steve Youngs --- diff --git a/package-compile.el b/package-compile.el index a72ff224..3e3dce4c 100644 --- a/package-compile.el +++ b/package-compile.el @@ -93,7 +93,6 @@ (defconst package-directory-map '( ;; xemacs-packages - ("Sun" . "xemacs-packages") ("ada" . "xemacs-packages") ("apel" . "xemacs-packages") ("auctex" . "xemacs-packages") diff --git a/xemacs-packages/Makefile b/xemacs-packages/Makefile index 8f894ec0..3fe5647f 100644 --- a/xemacs-packages/Makefile +++ b/xemacs-packages/Makefile @@ -45,7 +45,7 @@ PACKAGES := xemacs-base fsf-compat mail-lib \ \ cedet-common speedbar eieio ede semantic cogre \ \ - Sun ada auctex bbdb c-support calc calendar \ + ada auctex bbdb c-support calc calendar \ cookie crisp dictionary docbookide easypg ecb ediff edt emerge \ erc escreen eshell eudc footnote forms fortran-modes \ frame-icon games general-docs gnats gnus guided-tour haskell-mode \ diff --git a/xemacs-packages/Sun/ChangeLog b/xemacs-packages/Sun/ChangeLog deleted file mode 100644 index 2181c3b5..00000000 --- a/xemacs-packages/Sun/ChangeLog +++ /dev/null @@ -1,86 +0,0 @@ -2014-05-15 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.19 released. - -2014-05-15 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.18 released. - -2014-05-13 Jerry James - - * .cvsignore: Remove. - * .hgignore: New file. - -2012-01-10 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.17 released. - -2011-12-30 Aidan Kehoe - - * sunpro-sparcworks.el: - No longer require cl-19, Quiroz's CL compatibility package is long - gone, (require 'cl) is good enough. - -2004-09-06 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.16 released. - -2004-08-24 Jerry James - - * sun-eos-debugger-extra.el (get-buffer-window-list): Removed. - -2003-10-31 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.15 released. - -2003-09-15 Norbert Koch - - * Makefile (VERSION): XEmacs package 1.14 released. - -2003-03-30 Steve Youngs - - * Makefile (EARLY_GENERATED_LISP): Revert previous change. - -2003-03-22 Steve Youngs - - * Makefile (EARLY_GENERATED_LISP): Explicitly set so we don't try - to build custom-loads, this package doesn't have any. - -2003-03-09 Ben Wing - - * Makefile: - Delete explicit compile:: and binkit: rules. - -2002-11-29 Ben Wing - - * .cvsignore: Remove files now handled automatically by CVS. - * Makefile: Use `compile' instead of hard-coded `all'. - -2002-10-15 Ville Skyttä - - * Makefile (srckit): Remove. - -1998-07-25 SL Baur - - * dumped-lisp.el: removed. - -1998-07-18 SL Baur - - * dumped-lisp.el: Elimination of Lisp read-time macros. - -1998-03-06 SL Baur - - * dumped-lisp.el: Don't dump cc-mode, it's broken for dumping. - -1998-01-24 SL Baur - - * Makefile (PACKAGE): Update to package standard 1.0. - -1998-01-04 SL Baur - - * dumped-lisp.el: New file from standard dumped-lisp.el. - -1997-12-24 SL Baur - - * Makefile: Created. - diff --git a/xemacs-packages/Sun/Makefile b/xemacs-packages/Sun/Makefile deleted file mode 100644 index 16dcb710..00000000 --- a/xemacs-packages/Sun/Makefile +++ /dev/null @@ -1,35 +0,0 @@ -# Makefile for Sun specific lisp code - -# This file is part of XEmacs. - -# 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. - -VERSION = 1.19 -AUTHOR_VERSION = -MAINTAINER = XEmacs Development Team -PACKAGE = Sun -PKG_TYPE = regular -REQUIRES = cc-mode xemacs-base -CATEGORY = standard - -ELCS = eos.elc sccs.elc sun-eos-browser.elc sun-eos-common.elc \ - sun-eos-debugger-extra.elc sun-eos-debugger.elc \ - sun-eos-editor.elc sun-eos-init.elc sun-eos-load.elc \ - sun-eos-menubar.elc sun-eos-toolbar.elc sun-eos.elc \ - sunpro-init.elc sunpro-keys.elc sunpro-menubar.elc \ - sunpro-sparcworks.elc - -include ../../XEmacs.rules diff --git a/xemacs-packages/Sun/Makefile.epl b/xemacs-packages/Sun/Makefile.epl deleted file mode 100644 index 1badfc80..00000000 --- a/xemacs-packages/Sun/Makefile.epl +++ /dev/null @@ -1,80 +0,0 @@ -### Makefile --- The makefile to build EOS - -## Copyright (C) 1995 Sun Microsystems, Inc. - -## Maintainer: Eduardo Pelegri-Llopart -## Author: Eduardo Pelegri-Llopart - -## Keywords: SPARCworks EOS Era on SPARCworks make makefile - -### Commentary: - -## Please send feedback to eduardo.pelegri-llopart@eng.sun.com - -### Code: - -# what emacs is called on your system -EMACS = ../../src/xemacs - -# compile with noninteractive and relatively clean environment -BATCHFLAGS = -batch -vanilla -eval "(push \"$$(pwd)\" load-path)" - -# files that contain variables and macros that everything else depends on -CORE = sun-eos-common.el - -OBJECTS = \ - sun-eos-browser.elc sun-eos-common.elc sun-eos-debugger-extra.elc \ - sun-eos-debugger.elc sun-eos-editor.elc sun-eos-init.elc \ - sun-eos-menubar.elc sun-eos-toolbar.elc sun-eos-load.elc - -SOURCES = \ - sun-eos-browser.el sun-eos-common.el sun-eos-debugger-extra.el \ - sun-eos-debugger.el sun-eos-editor.el sun-eos-init.el \ - sun-eos-menubar.el sun-eos-toolbar.el sun-eos-load.el - -EXTRA = custom-load.elc - -all: $(OBJECTS) - -clean: - rm -f $(OBJECTS) - -custom-load.elc: auto-autoloads.el - ${EMACS} ${BATCHFLAGS} -f batch-byte-compile custom-load.el - -sun-eos-browser.elc: sun-eos-browser.el $(CORE) - ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-browser.el - -sun-eos-debugger.elc: sun-eos-debugger.el $(CORE) - ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-debugger.el - -sun-eos-debugger-extra.elc: sun-eos-debugger-extra.el $(CORE) - ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-debugger-extra.el - -sun-eos-editor.elc: sun-eos-editor.el $(CORE) - ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-editor.el - -sun-eos-toolbar.elc: sun-eos-toolbar.el $(CORE) - ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-toolbar.el - -sun-eos-menubar.elc: sun-eos-menubar.el $(CORE) - ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-menubar.el - -sun-eos-common.elc: sun-eos-common.el - ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-common.el - -sun-eos-init.elc: sun-eos-init.el - ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-init.el - -sun-eos-load.elc: sun-eos-load.el - ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-load.el - -autoloads: custom-load.el - -custom-load.el: $(SOURCES) - $(EMACS) -batch -q -no-site-file \ - -eval '(setq autoload-target-directory "'`pwd`'/")' \ - -l autoload \ - -f batch-update-autoloads $? - -### Makefile ends here diff --git a/xemacs-packages/Sun/eos.el b/xemacs-packages/Sun/eos.el deleted file mode 100644 index 5a08a1d0..00000000 --- a/xemacs-packages/Sun/eos.el +++ /dev/null @@ -1,21 +0,0 @@ -;;; eos.el --- Intereactively loads the XEmacs/SPARCworks interface -;;; this file is an alias for sun-eos.el - -;; Copyright (C) 1995 Sun Microsystems, Inc. - -;; Maintainer: Eduardo Pelegri-Llopart -;; Author: Eduardo Pelegri-Llopart - -;; Keywords: SPARCworks EOS Era on SPARCworks load - -;;; Commentary: - -;; If manual loading is desired... -;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com - -;;; Code: - -(load "sun-eos-load.el") -(eos::start) - -;;; sun-eos-eos.el ends here diff --git a/xemacs-packages/Sun/package-info.in b/xemacs-packages/Sun/package-info.in deleted file mode 100644 index 62d3e04f..00000000 --- a/xemacs-packages/Sun/package-info.in +++ /dev/null @@ -1,19 +0,0 @@ -(Sun - (standards-version 1.1 - version VERSION - author-version AUTHOR_VERSION - date DATE - build-date BUILD_DATE - maintainer MAINTAINER - distribution xemacs - priority low - category CATEGORY - dump nil - description "Support for Sparcworks." - filename FILENAME - md5sum MD5SUM - size SIZE - provides (sccs eos-browser eos-common eos-debugger eos-debugger eos-editor eos-init eos-load eos-menubar eos-toolbar sunpro) - requires (REQUIRES) - type regular -)) diff --git a/xemacs-packages/Sun/sccs.el b/xemacs-packages/Sun/sccs.el deleted file mode 100644 index c13308dc..00000000 --- a/xemacs-packages/Sun/sccs.el +++ /dev/null @@ -1,913 +0,0 @@ -;; sccs.el -- easy-to-use SCCS control from within Emacs -;; @(#)sccs.el 3.5 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY. No author or distributor -;; accepts responsibility to anyone for the consequences of using it -;; or for whether it serves any particular purpose or works at all, -;; unless he says so in writing. Refer to the GNU Emacs General Public -;; License for full details. - -;; Everyone is granted permission to copy, modify and redistribute -;; GNU Emacs, but only under the conditions described in the -;; GNU Emacs General Public License. A copy of this license is -;; supposed to have been given to you along with GNU Emacs so you -;; can know your rights and responsibilities. It should be in a -;; file named COPYING. Among other things, the copyright notice -;; and this notice must be preserved on all copies. -;;; -;;; Synched up with: Not in FSF. -;;; #### Chuck -- I say remove this piece of crap! Use VC instead. - -;;; Author: Eric S. Raymond (eric@snark.thyrsus.com). -;;; -;;; It is distantly derived from an rcs mode written by Ed Simpson -;;; ({decvax, seismo}!mcnc!duke!dukecdu!evs) in years gone by -;;; and revised at MIT's Project Athena. -;;; -;;; Modified: Made to work for Lucid Emacs by persons who don't know SCCS. -;;; Modified: Ben Wing (Ben.Wing@eng.sun.com) -- fixed up and redid menus -;;; - -;; User options - -(defvar sccs-bin-directory nil - "*Directory that holds the SCCS executables. -Initialized automatically the first time you execute an SCCS command, -if not already set.") - -(defvar sccs-max-log-size 510 - "*Maximum allowable size of an SCCS log message.") -(defvar sccs-diff-command '("diff" "-c") - "*The command/flags list to be used in constructing SCCS diff commands.") -(defvar sccs-headers-wanted '("\%\W\%") - "*SCCS header keywords to be inserted when sccs-insert-header is executed.") -(defvar sccs-insert-static t - "*Insert a static character string when inserting SCCS headers in C mode.") -(defvar sccs-mode-expert nil - "*Treat user as expert; suppress yes-no prompts on some things.") - -;; Vars the user doesn't need to know about. - -(defvar sccs-log-entry-mode nil) -(defvar sccs-current-major-version nil) - -;; Some helper functions - -(defun sccs-name (file &optional letter) - "Return the sccs-file name corresponding to a given file." - (format "%sSCCS/%s.%s" - (concat (file-name-directory (expand-file-name file))) - (or letter "s") - (concat (file-name-nondirectory (expand-file-name file))))) - -(defun sccs-lock-info (file index) - "Return the nth token in a file's SCCS-lock information." - (let - ((pfile (sccs-name file "p"))) - (and (file-exists-p pfile) - (save-excursion - (find-file pfile) - (auto-save-mode nil) - (goto-char (point-min)) - (replace-string " " "\n") - (goto-char (point-min)) - (forward-line index) - (prog1 - (buffer-substring (point) (progn (end-of-line) (point))) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))) - ) - ) - ) - ) - -(defun sccs-locking-user (file) - "Return the name of the person currently holding a lock on FILE. -Return nil if there is no such person." - (sccs-lock-info file 2) - ) - -(defun sccs-locked-revision (file) - "Return the revision number currently locked for FILE, nil if none such." - (sccs-lock-info file 1) - ) - -(defmacro error-occurred (&rest body) - (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t))) - -;; There has *got* to be a better way to do this... -(defmacro chmod (perms file) - (list 'call-process "chmod" nil nil nil perms file)) - -(defun sccs-save-vars (sid) - (save-excursion - (find-file "SCCS/emacs-vars.el") - (erase-buffer) - (insert "(setq sccs-current-major-version \"" sid "\")") - (basic-save-buffer) - ) - ) - -(defun sccs-load-vars () - (if (error-occurred (load-file "SCCS/emacs-vars.el")) - (setq sccs-current-major-version "1")) -) - -(defun sccs-init-bin-directory () - (setq sccs-bin-directory - (cond ((file-executable-p "/usr/sccs/unget") "/usr/sccs") - ((file-executable-p "/usr/bin/unget") "/usr/bin") - ((file-directory-p "/usr/sccs") "/usr/sccs") - ((file-directory-p "/usr/bin/sccs") "/usr/bin/sccs") - (t "/usr/bin")))) - -;; The following functions do most of the real work - -(defun sccs-get-version (file sid) - "For the given FILE, retrieve a copy of the version with given SID. -The text is retrieved into a tempfile. Return the tempfile name, or nil -if no such version exists." - (let (oldversion vbuf) - (setq oldversion (sccs-name file (or sid "new"))) - (setq vbuf (create-file-buffer oldversion)) - (prog1 - (if (not (error-occurred - (sccs-do-command vbuf "get" file - (and sid (concat "-r" sid)) - "-p" "-s"))) - (save-excursion - (set-buffer vbuf) - (write-region (point-min) (point-max) oldversion t 0) - oldversion) - ) - (kill-buffer vbuf) - ) - ) - ) - -(defun sccs-mode-line (file) - "Set the mode line for an SCCS buffer. -FILE is the file being visited to put in the modeline." - (setq mode-line-process - (if (file-exists-p (sccs-name file "p")) - (format " " (sccs-locked-revision file)) - "")) - - ; force update of frame - (save-excursion (set-buffer (other-buffer))) - (sit-for 0) - ) - -(defun sccs-do-command (buffer command file &rest flags) - " Execute an SCCS command, notifying the user and checking for errors." - (setq file (expand-file-name file)) - (message "Running %s on %s..." command file) - (or sccs-bin-directory (sccs-init-bin-directory)) - (let ((status - (save-window-excursion - (set-buffer (get-buffer-create buffer)) - (erase-buffer) - (while (and flags (not (car flags))) - (setq flags (cdr flags))) - (setq flags (append flags (and file (list (sccs-name file))))) - (let ((default-directory (file-name-directory (or file "./"))) - (exec-path (cons sccs-bin-directory exec-path))) - (apply 'call-process command nil t nil flags) - ) - (goto-char (point-max)) - (previous-line 1) - (if (looking-at "ERROR") - (progn - (previous-line 1) - (print (cons command flags)) - (next-line 1) - nil) - t)))) - (if status - (message "Running %s...OK" command) - (pop-to-buffer buffer) - (error "Running %s...FAILED" command))) - (if file (sccs-mode-line file))) - -(defun sccs-shell-command (command) - "Like shell-command except that the *Shell Command Output*buffer -is created even if the command does not output anything" - (shell-command command) - (get-buffer-create "*Shell Command Output*")) - -(defun sccs-tree-walk (func &rest optargs) - "Apply FUNC to each SCCS file under the default directory. -If present, OPTARGS are also passed." - (sccs-shell-command (concat "/bin/ls -1 " default-directory "SCCS/s.*")) - (set-buffer "*Shell Command Output*") - (goto-char (point-min)) - (replace-string "SCCS/s." "") - (goto-char (point-min)) - (if (eobp) - (error "No SCCS files under %s" default-directory)) - (while (not (eobp)) - (let ((file (buffer-substring (point) (progn (end-of-line) (point))))) - (apply func file optargs) - ) - (forward-line 1) - ) - ) - -(defun sccs-init () - (or (current-local-map) (use-local-map (make-sparse-keymap))) - (condition-case nil - ;; If C-c s is already defined by another mode, then we - ;; will get an error. In that case, just don't do anything. - (progn - (define-key (current-local-map) "\C-cs?" 'describe-mode) - (define-key (current-local-map) "\C-csn" 'sccs) - (define-key (current-local-map) "\C-csm" 'sccs-register-file) - (define-key (current-local-map) "\C-csh" 'sccs-insert-headers) - (define-key (current-local-map) "\C-csd" 'sccs-revert-diff) - (define-key (current-local-map) "\C-csp" 'sccs-prs) - (define-key (current-local-map) "\C-csr" 'sccs-revert-buffer) - (define-key (current-local-map) "\C-cs\C-d" 'sccs-version-diff) - (define-key (current-local-map) "\C-cs\C-p" 'sccs-pending) - (define-key (current-local-map) "\C-cs\C-r" 'sccs-registered) - ) - (error nil))) - -;; Here's the major entry point - -(defun sccs (verbose) - "*Do the next logical SCCS operation on the file in the current buffer. -You must have an SCCS subdirectory in the same directory as the file being -operated on. - If the file is not already registered with SCCS, this does an admin -i -followed by a get -e. - If the file is registered and not locked by anyone, this does a get -e. - If the file is registered and locked by the calling user, this pops up a -buffer for creation of a log message, then does a delta -n on the file. -A read-only copy of the changed file is left in place afterwards. - If the file is registered and locked by someone else, an error message is -returned indicating who has locked it." - (interactive "P") - (sccs-init) - (if (buffer-file-name) - (let - (do-update revision owner - (file (buffer-file-name)) - (sccs-file (sccs-name (buffer-file-name))) - (sccs-log-buf (get-buffer-create "*SCCS-Log*")) - (err-msg nil)) - - ;; if there is no SCCS file corresponding, create one - (if (not (file-exists-p sccs-file)) - (progn - (sccs-load-vars) - (sccs-admin - file - (cond - (verbose (read-string "Initial SID: ")) - ((error-occurred (load-file "SCCS/emacs-vars.el")) "1") - (t sccs-current-major-version)) - ) - ) - ) - - (cond - - ;; if there is no lock on the file, assert one and get it - ((not (file-exists-p (sccs-name file "p"))) - (progn - (sccs-get file t) - (revert-buffer nil t) - (sccs-mode-line file) - )) - - ;; a checked-out version exists, but the user may not own the lock - ((not (string-equal - (setq owner (sccs-locking-user file)) (user-login-name))) - (error "Sorry, %s has that file checked out" owner)) - - ;; OK, user owns the lock on the file - (t (progn - - ;; if so, give luser a chance to save before delta-ing. - (if (and (buffer-modified-p) - (or - sccs-mode-expert - (y-or-n-p (format "%s has been modified. Write it out? " - (buffer-name))))) - (save-buffer)) - - (setq revision (sccs-locked-revision file)) - - ;; user may want to set nonstandard parameters - (if verbose - (if (or sccs-mode-expert (y-or-n-p - (format "SID: %s Change revision level? " revision))) - (setq revision (read-string "New revision level: ")))) - - ;; OK, let's do the delta - (if - ;; this excursion returns t if the new version was saved OK - (save-window-excursion - (pop-to-buffer (get-buffer-create "*SCCS*")) - (erase-buffer) - (set-buffer-modified-p nil) - (sccs-mode) - (message - "Enter log message. Type C-c C-c when done, C-c ? for help.") - (prog1 - (and (not (error-occurred (recursive-edit))) - (not (error-occurred (sccs-delta file revision)))) - (setq buffer-file-name nil) - (bury-buffer "*SCCS*"))) - - ;; if the save went OK do some post-checking - (if (buffer-modified-p) - (error - "Delta-ed version of file does not match buffer!") - (progn - ;; sccs-delta already turned off write-privileges on the - ;; file, let's not re-fetch it unless there's something - ;; in it that get would expand - ;; - ;; fooey on this. You always need to refetch the - ;; file; otherwise weirdness will ensue when you're - ;; trying to do a make. --bpw - ; (if (sccs-check-headers) - (sccs-get file nil) - (revert-buffer nil t) - (sccs-mode-line file) - (run-hooks 'sccs-delta-ok) - ) - )))))) - (error "There is no file associated with buffer %s" (buffer-name)))) - -(defun sccs-insert-last-log () - "*Insert the log message of the last SCCS check in at point." - (interactive) - (insert-buffer sccs-log-buf)) - -;;; These functions help the sccs entry point - -(defun sccs-get (file writeable) - "Retrieve a copy of the latest delta of the given file." - (sccs-do-command "*SCCS*" "get" file (if writeable "-e"))) - -(defun sccs-admin (file sid) - "Checks a file into sccs. -FILE is the unmodified name of the file. SID should be the base-level sid to -check it in under." - ; give a change to save the file if it's modified - (if (and (buffer-modified-p) - (y-or-n-p (format "%s has been modified. Write it out? " - (buffer-name)))) - (save-buffer)) - (sccs-do-command "*SCCS*" "admin" file - (concat "-i" file) (concat "-r" sid)) - (chmod "-w" file) - (if (sccs-check-headers) - (sccs-get file nil)) ;; expand SCCS headers - (revert-buffer nil t) - (sccs-mode-line file) -) - -(defun sccs-delta (file &optional rev comment) - "Delta the file specified by FILE. -The optional argument REV may be a string specifying the new revision level -\(if nil increment the current level). The file is retained with write -permissions zeroed. COMMENT is a comment string; if omitted, the contents of -the current buffer up to point becomes the comment for this delta." - (if (not comment) - (progn - (goto-char (point-max)) - (if (not (bolp)) (newline)) - (newline) - (setq comment (buffer-substring (point-min) (1- (point))))) - ) - (sccs-do-command "*SCCS*" "delta" file "-n" - (if rev (format "-r%s" rev)) - (format "-y%s" comment)) - (chmod "-w" file)) - -(defun sccs-delta-abort () - "Abort an SCCS delta command." - (interactive) - (if (or sccs-mode-expert (y-or-n-p "Abort the delta? ")) - (progn - (delete-window) - (error "Delta aborted"))) - ) - -(defun sccs-log-exit () - "Leave the recursive edit of an SCCS log message." - (interactive) - (if (< (buffer-size) sccs-max-log-size) - (progn - (copy-to-buffer sccs-log-buf (point-min) (point-max)) - (exit-recursive-edit) - (delete-window)) - (progn - (goto-char sccs-max-log-size) - (error - "Log must be less than %d characters. Point is now at char %d." - sccs-max-log-size sccs-max-log-size))) -) - -;; Additional entry points for examining version histories - -(defun sccs-revert-diff (&rest flags) - "*Compare the version being edited with the last checked-in revision. -Or, if given a prefix argument, with another specified revision." - (interactive) - (let (old file) - (if - (setq old (sccs-get-version (buffer-file-name) - (and - current-prefix-arg - (read-string "Revision to compare against: ")) - )) - (progn - (if (and (buffer-modified-p) - (or - sccs-mode-expert - (y-or-n-p (format "%s has been modified. Write it out? " - (buffer-name))))) - (save-buffer)) - - (setq file (buffer-file-name)) - (set-buffer (get-buffer-create "*SCCS*")) - (erase-buffer) - (apply 'call-process (car sccs-diff-command) nil t nil - (append (cdr sccs-diff-command) flags (list old) (list file))) - (set-buffer-modified-p nil) - (goto-char (point-min)) - (delete-file old) - (if (equal (point-min) (point-max)) - (message "No changes to %s since last get." file) - (pop-to-buffer "*SCCS*") - ) - ) - ) - ) - ) - -(defun sccs-prs () - "*List the SCCS log of the current buffer in an emacs window." - (interactive) - (if (and buffer-file-name (file-exists-p (sccs-name buffer-file-name "s"))) - (progn - (sccs-do-command "*SCCS*" "prs" buffer-file-name) - (pop-to-buffer (get-buffer-create "*SCCS*")) - ) - (error "There is no SCCS file associated with this buffer") - ) - ) - -(defun sccs-version-diff (file rel1 rel2) - "*For FILE, report diffs between two stored deltas REL1 and REL2 of it." - (interactive "fFile: \nsOlder version: \nsNewer version: ") - (if (string-equal rel1 "") (setq rel1 nil)) - (if (string-equal rel2 "") (setq rel2 nil)) - (set-buffer (get-buffer-create "*SCCS*")) - (erase-buffer) - (sccs-vdiff file rel1 rel2) - (set-buffer-modified-p nil) - (goto-char (point-min)) - (if (equal (point-min) (point-max)) - (message "No changes to %s between %s and %s." file rel1 rel2) - (pop-to-buffer "*SCCS*") - ) - ) - -(defun sccs-vdiff (file rel1 rel2 &optional flags) - "Compare two deltas into the current buffer." - (let (vers1 vers2) - (and - (setq vers1 (sccs-get-version file rel1)) - (setq vers2 (if rel2 (sccs-get-version file rel2) file)) -; (prog1 -; (save-excursion -; (not (error-occurred -; (call-process "prs" nil t t -; (sccs-name file)))) -; ) -; ) - (unwind-protect - (apply 'call-process (car sccs-diff-command) nil t t - (append (cdr sccs-diff-command) flags (list vers1) (list vers2))) - (condition-case () (delete-file vers1) (error nil)) - (if rel2 - (condition-case () (delete-file vers2) (error nil))) - ) - ) - ) - ) - -;; SCCS header insertion code - -(defun sccs-insert-headers () - "*Insert headers for use with the Source Code Control System. -Headers desired are inserted at the start of the buffer, and are pulled from -the variable sccs-headers-wanted" - (interactive) - (save-excursion - (save-restriction - (widen) - (if (or (not (sccs-check-headers)) - (y-or-n-p "SCCS headers already exist. Insert another set?")) - (progn - (goto-char (point-min)) - (run-hooks 'sccs-insert-headers-hook) - (cond ((eq major-mode 'c-mode) (sccs-insert-c-header)) - ((eq major-mode 'lisp-mode) (sccs-insert-lisp-header)) - ((eq major-mode 'emacs-lisp-mode) (sccs-insert-lisp-header)) - ((eq major-mode 'scheme-mode) (sccs-insert-lisp-header)) - ((eq major-mode 'nroff-mode) (sccs-insert-nroff-header)) - ((eq major-mode 'plain-tex-mode) (sccs-insert-tex-header)) - ((eq major-mode 'texinfo-mode) (sccs-insert-texinfo-header)) - (t (sccs-insert-generic-header)))))))) - -(defun sccs-insert-c-header () - (let (st en) - (insert "/*\n") - (mapcar '(lambda (s) - (insert " *\t" s "\n")) - sccs-headers-wanted) - (insert " */\n\n") - (if (and sccs-insert-static - (not (string-match "\\.h$" (buffer-file-name)))) - (progn - (insert "#ifndef lint\n" - "static char *sccsid") -;; (setq st (point)) -;; (insert (file-name-nondirectory (buffer-file-name))) -;; (setq en (point)) -;; (subst-char-in-region st en ?. ?_) - (insert " = \"\%\W\%\";\n" - "#endif /* lint */\n\n"))) - (run-hooks 'sccs-insert-c-header-hook))) - -(defun sccs-insert-lisp-header () - (mapcar '(lambda (s) - (insert ";;;\t" s "\n")) - sccs-headers-wanted) - (insert "\n") - (run-hooks 'sccs-insert-lisp-header-hook)) - -(defun sccs-insert-nroff-header () - (mapcar '(lambda (s) - (insert ".\\\"\t" s "\n")) - sccs-headers-wanted) - (insert "\n") - (run-hooks 'sccs-insert-nroff-header-hook)) - -(defun sccs-insert-tex-header () - (mapcar '(lambda (s) - (insert "%%\t" s "\n")) - sccs-headers-wanted) - (insert "\n") - (run-hooks 'sccs-insert-tex-header-hook)) - -(defun sccs-insert-texinfo-header () - (mapcar '(lambda (s) - (insert "@comment\t" s "\n")) - sccs-headers-wanted) - (insert "\n") - (run-hooks 'sccs-insert-texinfo-header-hook)) - -(defun sccs-insert-generic-header () - (let* ((comment-start-sccs (or comment-start "#")) - (comment-end-sccs (or comment-end "")) - (dont-insert-nl-p (string-match "\n" comment-end-sccs))) - (mapcar '(lambda (s) - (insert comment-start-sccs "\t" s "" - comment-end-sccs (if dont-insert-nl-p "" "\n"))) - sccs-headers-wanted) - (insert comment-start-sccs comment-end-sccs (if dont-insert-nl-p "" "\n")))) - -(defun sccs-check-headers () - "Check if the current file has any SCCS headers in it." - (interactive) - (save-excursion - (goto-char (point-min)) - (re-search-forward "%[MIRLBSDHTEGUYFPQCZWA]%" (point-max) t))) - -;; Status-checking functions - -(defun sccs-status (prefix legend) - "List all files underneath the current directory matching a prefix type." - (sccs-shell-command - (concat "/bin/ls -1 SCCS/" prefix ".*")) - (if - (save-excursion - (set-buffer "*Shell Command Output*") - (if (= (point-max) (point-min)) - (not (message - "No files are currently %s under %s" - legend default-directory)) - (progn - (goto-char (point-min)) - (insert - "The following files are currently " legend - " under " default-directory ":\n") - (replace-string (format "SCCS/%s." prefix) "") - ) - ) - ) - (pop-to-buffer "*Shell Command Output*") - ) - ) - -(defun sccs-pending () - "*List all files currently SCCS locked." - (interactive) - (sccs-status "p" "locked")) - -(defun sccs-registered () - "*List all files currently SCCS registered." - (interactive) - (sccs-status "s" "registered")) - -(defun sccs-register-file (override) - "*Register the file visited by the current buffer into SCCS." - (interactive "P") - (if (file-exists-p (sccs-name (buffer-file-name))) - (error "This file is already registered into SCCS.") - (progn - (if (and (buffer-modified-p) - (or - sccs-mode-expert - (y-or-n-p (format "%s has been modified. Write it out? " - (buffer-name))))) - (save-buffer)) - (sccs-load-vars) - (sccs-admin - (buffer-file-name) - (cond - (override (read-string "Initial SID: ")) - ((error-occurred (load-file "SCCS/emacs-vars.el")) "1") - (t sccs-current-major-version)) - ) - ) - ) - ) - -;; Major functions for release-tracking and generation. - -(defun sccs-release-diff (rel1 rel2) - "*Diff all files below default-directory between versions REL1 and REL2. -The report goes to a shell output buffer which is popped to. If REL2 is -omitted or nil, the comparison is done against the most recent version." - (interactive "sOlder version: \nsNewer version: ") - (if (string-equal rel1 "") (setq rel1 nil)) - (if (string-equal rel2 "") (setq rel2 nil)) - (sccs-shell-command (concat - "/bin/ls -1 " default-directory "SCCS/s.*" - )) - (set-buffer "*Shell Command Output*") - (goto-char (point-min)) - (replace-string "SCCS/s." "") - (goto-char (point-min)) - (if (eobp) - (error "No SCCS files under %s" default-directory)) - (let - ((sccsbuf (get-buffer-create "*SCCS*"))) - (save-excursion - (set-buffer sccsbuf) - (erase-buffer) - (insert (format "Diffs from %s to %s.\n\n" - (or rel1 "current") (or rel2 "current")))) - (while (not (eobp)) - (let ((file (buffer-substring (point) (progn (end-of-line) (point))))) - (save-excursion - (set-buffer sccsbuf) - (set-buffer-modified-p nil) - - (sccs-vdiff file rel1 rel2) - (if (buffer-modified-p) - (insert "\n")) - ) - (forward-line 1) - ) - ) - (kill-buffer "*Shell Command Output*") - (pop-to-buffer sccsbuf) - (insert "\nEnd of diffs.\n") - (goto-char (point-min)) - (replace-string (format "/SCCS/%s." rel1) "/") - (goto-char (point-min)) - (replace-string (format "/SCCS/%s." rel2) "/new/") - (goto-char (point-min)) - (replace-string "/SCCS/new." "/new/") - (goto-char (point-min)) - (replace-regexp (concat "^*** " default-directory) "*** ") - (goto-char (point-min)) - (replace-regexp (concat "^--- " default-directory) "--- ") - (goto-char (point-min)) - (set-buffer-modified-p nil) - ) - ) - -(defun sccs-dummy-delta (file sid) - "Make a dummy delta to the given FILE with the given SID." - (interactive "sFile: \nsRelease ID: ") - (if (not (sccs-locked-revision file)) - (sccs-get file t)) - ;; Grottiness alert -- to get around SCCS's obsessive second-guessing we - ;; have to mung the p-file - (save-excursion - (let ((pfile (sccs-name file "p"))) - (chmod "u+w" pfile) - (find-file pfile) - (auto-save-mode nil) - (replace-regexp "^\\([0-9.]+\\) \\([0-9.]+\\)" (concat "\\1 " sid) t) - (write-region (point-min) (point-max) pfile t 0) - (chmod "u-w" pfile) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer)) - ) - ) - (sccs-delta file sid (concat "Release " sid)) - (sccs-get file nil) - (sccs-save-vars sid) - ) - -(defun sccs-delta-release (sid) - "*Delta everything underneath the current directory to mark it as a release." - (interactive "sRelease: ") - (sccs-tree-walk 'sccs-dummy-delta sid) - (kill-buffer "*SCCS*") - ) - -;; Miscellaneous other entry points - -(defun sccs-revert-buffer () - "*Revert the current buffer's file back to the last saved version." - (interactive) - (let ((file (buffer-file-name))) - (if (y-or-n-p (format "Revert file %s to last SCCS revision?" file)) - (progn - (delete-file file) - (delete-file (sccs-name file "p")) - (rename-file (sccs-get-version file nil) file) - (chmod "-w" file) - (revert-buffer nil t) - (sccs-mode-line file))))) - -(defun sccs-rename-file (old new) - "*Rename a file, taking its SCCS files with it." - (interactive "fOld name: \nFNew name: ") - (let ((owner (sccs-locking-user old))) - (if (and owner (not (string-equal owner (user-login-name)))) - (error "Sorry, %s has that file checked out" owner)) - ) - (rename-file old new) - (if (file-exists-p (sccs-name old "p")) - (rename-file (sccs-name old "p") (sccs-name new "p"))) - (if (file-exists-p (sccs-name old "s")) - (rename-file (sccs-name old "s") (sccs-name new "s"))) - ) - -;; Set up key bindings for SCCS use, e.g. while editing log messages - -(defun sccs-mode () - "Minor mode for driving the SCCS tools. - -These bindings are added to the global keymap when you enter this mode: -\\[sccs] perform next logical SCCS operation (`sccs') on current file -\\[sccs-register-file] register current file into SCCS -\\[sccs-insert-headers] insert SCCS headers in current file -\\[sccs-prs] display change history of current file -\\[sccs-revert-buffer] revert buffer to last saved version -\\[sccs-revert-diff] show difference between buffer and last saved delta -\\[sccs-pending] show all files currently locked by any user in or below . -\\[sccs-registered] show all files registered into SCCS in or below . -\\[sccs-version-diff] show diffs between saved versions for all files in or below . - -When you generate headers into a buffer using C-c h, the value of -sccs-insert-headers-hook is called before insertion. If the file is -recognized a C or Lisp source, sccs-insert-c-header-hook or -sccs-insert-lisp-header-hook is called after insertion respectively. - -While you are entering a change log message for a delta, the following -additional bindings will be in effect. - -\\[sccs-log-exit] proceed with check in, ending log message entry -\\[sccs-insert-last-log] insert log message from last check-in -\\[sccs-delta-abort] abort this delta check-in - -Entry to the change-log submode calls the value of text-mode-hook, then -the value sccs-mode-hook. - -Global user options: - sccs-mode-expert suppresses some conformation prompts, - notably for delta aborts and file saves. - sccs-max-log-size specifies the maximum allowable size - of a log message plus one. - sccs-diff-command A list consisting of the command and flags - to be used for generating context diffs. - sccs-headers-wanted which %-keywords to insert when adding - SCCS headers with C-c h - sccs-insert-static if non-nil, SCCS keywords inserted in C files - get stuffed in a static string area so that - what(1) can see them in the compiled object - code. -" - (interactive) - (set-syntax-table text-mode-syntax-table) - (use-local-map sccs-log-entry-mode) - (setq local-abbrev-table text-mode-abbrev-table) - (setq major-mode 'sccs-mode) - (setq mode-name "SCCS Change Log Entry") - (run-hooks 'text-mode-hook 'sccs-mode-hook) -) - -;; Initialization code, to be done just once at load-time -(if sccs-log-entry-mode - nil - (setq sccs-log-entry-mode (make-sparse-keymap)) - (define-key sccs-log-entry-mode "\C-ci" 'sccs-insert-last-log) - (define-key sccs-log-entry-mode "\C-c\C-i" 'sccs-insert-last-log) - (define-key sccs-log-entry-mode "\C-ca" 'sccs-delta-abort) - (define-key sccs-log-entry-mode "\C-c\C-a" 'sccs-delta-abort) - (define-key sccs-log-entry-mode "\C-c\C-c" 'sccs-log-exit) - (define-key sccs-log-entry-mode "\C-x\C-s" 'sccs-log-exit) - ) - - -;;; Lucid Emacs support - -(defconst sccs-menu - '("SCCS Commands" - - ["SCCS" sccs t nil] ; C-c s n - ["Insert Headers" sccs-insert-headers t] ; C-c s h - ["Archive History:" sccs-prs t nil] ; C-c s p - ["Diffs from Archive:" sccs-revert-diff t nil] ; C-c s d - ["Revert to Archive:" sccs-revert-buffer t nil] ; C-c s r - "----" - ["Check In..." sccs-dummy-delta t] - ["Create Archive..." sccs-register-file t] ; C-c s h - ["Rename Archive..." sccs-rename-file t] - "----" - ["List Checked-Out Files" sccs-pending t] ; C-c s C-p - ["List Registered Files" sccs-registered t] ; C-c s C-r - ["Diff Directory" sccs-release-diff t] - ["Delta Directory" sccs-delta-release t] - )) - -(progn - (delete-menu-item '("SCCS")) - (add-menu '() "SCCS" (cdr sccs-menu))) - -(defun sccs-sensitize-menu () - (let* ((rest (cdr (car (find-menu-item current-menubar '("SCCS"))))) - (case-fold-search t) - (file (if buffer-file-name - (file-name-nondirectory buffer-file-name) - (buffer-name))) - (dir (file-name-directory - (if buffer-file-name buffer-file-name default-directory))) - (sccs-file (and buffer-file-name (sccs-name buffer-file-name))) - (known-p (and sccs-file (file-exists-p sccs-file))) - (checked-out-p (and known-p - (file-exists-p (sccs-name buffer-file-name "p")))) - command - item) - (while rest - (setq item (car rest)) - (if (not (vectorp item)) - nil - (setq command (aref item 1)) - (if (eq 'sccs command) - (aset item 0 - (cond ((or (null sccs-file) (not known-p)) - "Create Archive:") - ((not checked-out-p) - "Check Out") - (t - "Check In")))) - (cond - ((and (> (length item) 3) - (string-match "directory" (aref item 0))) - (aset item 3 dir)) - ((> (length item) 3) - (aset item 3 file)) - (t nil)) - (aset item 2 - (cond - ((memq command '(sccs-prs)) - known-p) - ((memq command '(sccs-revert-diff sccs-revert-buffer)) - checked-out-p) - (t)))) - (setq rest (cdr rest)))) - nil) - -(add-hook 'activate-menubar-hook 'sccs-sensitize-menu) - -(provide 'sccs) - -;; sccs.el ends here diff --git a/xemacs-packages/Sun/sun-eos-browser.el b/xemacs-packages/Sun/sun-eos-browser.el deleted file mode 100644 index 70e04504..00000000 --- a/xemacs-packages/Sun/sun-eos-browser.el +++ /dev/null @@ -1,162 +0,0 @@ -;;; sun-eos-browser.el --- Implements the XEmacs/SPARCworks SourceBrowser interface - -;; Copyright (C) 1995 Sun Microsystems, Inc. - -;; Maintainer: Eduardo Pelegri-Llopart -;; Author: Eduardo Pelegri-Llopart - -;; Keywords: SPARCworks EOS Era on SPARCworks SBrowser Source Browser - -;;; Commentary: -;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com - -;;; Code: - -(require 'eos-common "sun-eos-common") - -;; ================ -;; Browser Protocol -;; ================ -;; -;; three notifications -;; -;; SPRO_SBENG_START -;; SPRO_SBENG_CURRENT_ELEMENT CONTEXT_UID filename lineno center==0 -;; SPRO_SBENG_QUIT - -(defvar eos::currentMatch-inst "/* XPM */ -static char * file[] = { -\"14 11 5 1\", -\" s background c #FFFFFFFFFFFF\", -\". c #000000000000\", -\"X c #0000FFFF0000\", -\"o c #000077770000\", -\"O c #000044440000\", -\" \", -\" oo \", -\" oXOo \", -\" oXXXOo \", -\" oXXXXXOo \", -\" oXXXXXXXo. \", -\" oXXXXXOo \", -\" oXXXOo \", -\" oXOo \", -\" oo \", -\" \"};") - -(defvar eos::currentMatch-inst-alt "/* XPM */ -static char * file[] = { -\"14 11 5 1\", -\" s background c #FFFFFFFFFFFF\", -\". c #000000000000\", -\"X c #0000FFFF0000\", -\"o c #000077770000\", -\"O c #000044440000\", -\" \", -\" oo \", -\" oXOo \", -\" oXXXOo \", -\" oXXXXXOo \", -\" oXXXXXXXo. \", -\" oXXXXXOo \", -\" oXXXOo \", -\" oXOo \", -\" oo .. \", -\" .. \"};") - -(defvar sbrowser-pattern-list nil) - - -(defun eos::browser-startup () - ;; Actions to do at startup for eos-browser.el - (make-face 'sbrowse-arrow-face) - - (set-face-foreground 'sbrowse-arrow-face - eos::sbrowse-arrow-color) - (set-face-background 'sbrowse-arrow-face - (face-background (get-face 'default))) - - (setq sbrowser-pattern-list ; list of browser TT patterns - (eos::create-sbrowser-patterns)) - - ;; now register glyphs and faces... - - (eos::annotation-set-inst 'sbrowser 'x eos::currentMatch-inst [nothing]) - (eos::annotation-set-inst 'sbrowser 'tty "|>" [nothing]) - (eos::annotation-set-face 'sbrowser 'x - (get-face 'sbrowse-arrow-face) - (get-face 'sbrowse-arrow-face)) - (eos::annotation-set-face 'sbrowser 'tty - (get-face 'highlight) - (get-face 'highlight)) -) - -(defvar eos::current-match nil) - -(defun eos::spro_sbeng_current_element (msg pat) - ;; SPRO_SBENG_CURRENT_ELEMENT CONTEXT_UID filename lineno center==0 - (let* ((filename - (get-tooltalk-message-attribute msg 'arg_val 1)) - (lineno - (read (get-tooltalk-message-attribute msg 'arg_ival 2))) - ) - (setq eos::current-match - (eos::make-annotation-visible eos::current-match - filename - lineno - 'sbrowser)) - (return-tooltalk-message msg) - )) - -(defun eos::spro_sbeng_start (msg pat) - (eos::make-annotation-invisible eos::current-match) - (return-tooltalk-message msg) - ) - -(defun eos::spro_sbeng_quit (msg pat) - (eos::make-annotation-invisible eos::current-match) - (return-tooltalk-message msg) - ) - -(defun eos::create-sbrowser-patterns () - ;; returns list of patterns - (list - (make-an-observer "SPRO_SBENG_CURRENT_ELEMENT" - 'eos::spro_sbeng_current_element) - (make-an-observer "SPRO_SBENG_START" - 'eos::spro_sbeng_start) - (make-an-observer "SPRO_SBENG_QUIT" - 'eos::spro_sbeng_quit) - )) - -(defun eos::register-sbrowser-patterns () - ;; register all sbrowser patterns - (mapcar 'register-tooltalk-pattern sbrowser-pattern-list)) - -(defun eos::unregister-sbrowser-patterns () - ;; unregister all sbrowser patterns - (mapcar 'unregister-tooltalk-pattern sbrowser-pattern-list)) - -;; Actions to start a sourcebrowser in the background. - -(defvar eos::sbrowser-process nil - "sbrowser process for the background. Only one per XEmacs") - -(defun eos::start-sbrowser () - ;; Start an "sbrowser -editor" in the background. Will ask for confirmation if - ;; XEmacs somehow believes there is already one running - (interactive) - (if (or (not (processp eos::sbrowser-process)) - (not (eq (process-status eos::sbrowser-process) 'run)) - (yes-or-no-p - "Warning! XEmacs believes there already is a sbrowser -editor, proceed?")) - (progn - (setq eos::sbrowser-process - (start-process "*eos sbrowser*" nil "sbrowser" "-editor")) - (message "Starting SBrowser subprocess") - (eos::select-sbrowser-frame (selected-frame)) - ))) - -(provide 'eos-browser) - -;;; sun-eos-browser.el ends here diff --git a/xemacs-packages/Sun/sun-eos-common.el b/xemacs-packages/Sun/sun-eos-common.el deleted file mode 100644 index 5e796b65..00000000 --- a/xemacs-packages/Sun/sun-eos-common.el +++ /dev/null @@ -1,533 +0,0 @@ -;; Copyright (C) 1995, Sun Microsystems -;; -;; Light Weight Editor Integration for Sparcworks. -;; "Era on Sparcworks" (EOS) -;; -;; Author: Eduardo Pelegri-Llopart -;; -;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com - -;; Common routines for EOS - -(defvar eos::version "1.5.2" - "Version of Eos") - -(defvar eos::left-margin-width 5 - "size of left margin") - -(defvar eos::stop-color "red" - "foreground color for stop signs") -(defvar eos::solid-arrow-color "purple" - "foreground color for solid arrow") -(defvar eos::hollow-arrow-color "purple" - "foreground color for hollow arrow") -(defvar eos::sbrowse-arrow-color "blue" - "foreground color for browser glyphs") - -(defun eos::recompute-presentation () - (set-face-foreground 'stop-face eos::stop-color) - (set-face-foreground 'solid-arrow-face eos::solid-arrow-color) - (set-face-foreground 'hollow-arrow-face eos::hollow-arrow-color) - (set-face-foreground 'sbrowse-arrow-face eos::sbrowse-arrow-color) - ) - -;; - -(defvar eos::displayed-initial-message nil - "Whether we have shown the initial display message") - -(defconst eos::startup-message-lines - '("Please send feedback to eos-comments@cs.uiuc.edu." - "The latest Eos news are under SPARCworks->News" - "See Options->SPARCworks for configuration and Help->SPARCworks for help" - )) - -;; copied from vm - -(defun eos::display-initial-message () - ;; Display initial Eos message - REMOVED - ) - -(defun eos-old::display-initial-message () - ;; Display initial Eos message - (if (not eos::displayed-initial-message) - (let ((lines eos::startup-message-lines)) - (message "Eos %s, Copyright (C) 1995 Sun MicroSystems" - eos::version) - (setq eos::displayed-initial-message t) - (while (and (sit-for 3) lines) - (message (car lines)) - (setq lines (cdr lines)))) - (message ""))) - -;; misc - -(defun eos::line-at (pos) - ;; At what line is POS - (save-restriction - (widen) - (save-excursion - (goto-char pos) - (beginning-of-line) - (1+ (count-lines 1 (point)))))) - -;; frame-specific enabling -;; -;; will maintain at most one frame to debugger, one to sbrowser -;; annotations have a type, either -;; -;; sbrowser -;; debugger-solid-arrow -;; debugger-holow-arrow -;; debugger-stop -;; debugger-visit -;; -;; adding an annotation of type sbrowser will be only on frame sbrowser -;; adding an annotation of type debugger will be only on frame debugger -;; -;; turn off patterns when there is no frame. - - -;;; -;;; Common ToolTalk function -;;; - -(defun make-an-observer (op callback) - (let ((pattern-desc - (list - 'category 'TT_OBSERVE - 'scope 'TT_SESSION - 'class 'TT_NOTICE - 'op op - 'callback callback))) - (make-tooltalk-pattern pattern-desc) - )) - -;;; -;;; Frame management -;;; - -(defun eos::log (msg) - (if (fboundp 'ut-log-text) - (ut-log-text "eos version: %s; %s" eos::version msg))) - -(defvar eos::sbrowser-frame nil) -(defvar eos::debugger-frame nil) - -(defun eos::update-specifiers (type old-frame new-frame) - ;; Change the database for annotations of TYPE, so that OLD-FRAME is - ;; now using the alternate specifier, while NEW-FRAME uses the main one - (let* ((device-type (device-type (selected-device))) - (g (eos::annotation-get-glyph type device-type)) - (im (and (glyphp g) (glyph-image g))) - (new-instantiator (eos::annotation-get-inst type device-type)) - (alt-instantiator (eos::annotation-get-inst-alt type device-type)) - ) - (if (eq device-type 'x) - (progn - (if (frame-live-p old-frame) - (progn - (remove-specifier im old-frame) - (add-spec-to-specifier im alt-instantiator old-frame))) - (if new-frame - (progn - (add-spec-to-specifier im new-instantiator new-frame) - )))))) - - -(defun eos::select-sbrowser-frame (frame) - (require 'eos-toolbar "sun-eos-toolbar") - (let ((toolbar (eos::toolbar-position))) - (eos::display-initial-message) - ;; logging - (if frame - (eos::log "selected frame for sbrowser") - (eos::log "unselected frame for sbrowser")) - ;; TT patterns - (cond - ((and (null eos::sbrowser-frame) frame) - (eos::register-sbrowser-patterns)) - ((and (null frame) eos::sbrowser-frame) - (eos::unregister-sbrowser-patterns))) - ;; adjust toolbars - (if (frame-live-p eos::sbrowser-frame) - (remove-specifier toolbar eos::sbrowser-frame)) - (if (frame-live-p eos::debugger-frame) - (remove-specifier toolbar eos::debugger-frame)) - ;; then add - (cond - ((and (frame-live-p eos::debugger-frame) (frame-live-p frame) - (equal eos::debugger-frame frame)) - (add-spec-to-specifier toolbar eos::debugger-sbrowser-toolbar frame)) - ((and (frame-live-p eos::debugger-frame) (frame-live-p frame)) - (add-spec-to-specifier toolbar eos::sbrowser-toolbar frame) - (add-spec-to-specifier toolbar eos::debugger-toolbar eos::debugger-frame)) - ((frame-live-p frame) - (add-spec-to-specifier toolbar eos::sbrowser-toolbar frame)) - ((frame-live-p eos::debugger-frame) - (add-spec-to-specifier toolbar eos::debugger-toolbar eos::debugger-frame)) - ) - ;; adjust specifiers for glyphs - (eos::update-specifiers 'sbrowser eos::sbrowser-frame frame) - (if (frame-live-p eos::sbrowser-frame) - (progn - (remove-specifier use-left-overflow eos::sbrowser-frame) - (remove-specifier left-margin-width eos::sbrowser-frame))) - (if (frame-live-p frame) - (progn - (add-spec-to-specifier use-left-overflow t frame) - (add-spec-to-specifier left-margin-width eos::left-margin-width frame) - (add-spec-to-specifier left-margin-width 0 (minibuffer-window)))) - (if (frame-live-p eos::debugger-frame) - (progn - (add-spec-to-specifier use-left-overflow t eos::debugger-frame) - (add-spec-to-specifier left-margin-width eos::left-margin-width eos::debugger-frame) - (add-spec-to-specifier left-margin-width 0 (minibuffer-window)))) - ;; - (setq eos::sbrowser-frame frame) - (set-menubar-dirty-flag) - )) - -(defun eos::select-debugger-frame (frame) - (require 'eos-toolbar "sun-eos-toolbar") - (let ((toolbar (eos::toolbar-position))) - (eos::display-initial-message) - (save-excursion - (eos::ensure-debugger-buffer) - (bury-buffer)) - ;; logging - (if frame - (eos::log "selected frame for debugger") - (eos::log "unselected frame for debugger")) - ;; TT patterns - (cond - ((and (null eos::debugger-frame) frame) - (eos::register-debugger-patterns) - (eos::register-visit-file-pattern)) - ((and (null frame) eos::debugger-frame) - (eos::unregister-debugger-patterns) - (eos::unregister-visit-file-pattern))) - ;; adjust toolbars, remove - (if (frame-live-p eos::sbrowser-frame) - (remove-specifier toolbar eos::sbrowser-frame)) - (if (frame-live-p eos::debugger-frame) - (remove-specifier toolbar eos::debugger-frame)) - ;; then add - (cond - ((and (frame-live-p eos::sbrowser-frame) (frame-live-p frame) - (equal eos::sbrowser-frame frame)) - (add-spec-to-specifier toolbar eos::debugger-sbrowser-toolbar frame)) - ((and (frame-live-p eos::sbrowser-frame) (frame-live-p frame)) - (add-spec-to-specifier toolbar eos::debugger-toolbar frame) - (add-spec-to-specifier toolbar eos::sbrowser-toolbar eos::sbrowser-frame)) - ((frame-live-p frame) - (add-spec-to-specifier toolbar eos::debugger-toolbar frame)) - ((frame-live-p eos::sbrowser-frame) - (add-spec-to-specifier toolbar eos::sbrowser-toolbar eos::sbrowser-frame)) - ) - ;; update glyph specifiers - (eos::update-specifiers 'debugger-solid-arrow eos::debugger-frame frame) - (eos::update-specifiers 'debugger-hollow-arrow eos::debugger-frame frame) - (eos::update-specifiers 'debugger-stop eos::debugger-frame frame) - (if (frame-live-p eos::debugger-frame) - (progn - (remove-specifier use-left-overflow eos::debugger-frame) - (remove-specifier left-margin-width eos::debugger-frame))) - (if (frame-live-p frame) - (progn - (add-spec-to-specifier use-left-overflow t frame) - (add-spec-to-specifier left-margin-width eos::left-margin-width frame) - (add-spec-to-specifier left-margin-width 0 (minibuffer-window)))) - (if (frame-live-p eos::sbrowser-frame) - (progn - (add-spec-to-specifier use-left-overflow t eos::sbrowser-frame) - (add-spec-to-specifier left-margin-width eos::left-margin-width eos::sbrowser-frame) - (add-spec-to-specifier left-margin-width 0 (minibuffer-window)))) - ;; - (setq eos::debugger-frame frame) - (set-menubar-dirty-flag) - )) - -;; HERE use file-truename - -(defun eos::select-frame (type) - ;; Select a frame; return nil if should skip - (cond ((eq type 'sbrowser) - (if (frame-live-p eos::sbrowser-frame) - eos::sbrowser-frame - (message "selecting destroyed frame; will ignore") - (eos::select-sbrowser-frame nil) - nil)) - ((or (eq type 'debugger-solid-arrow) - (eq type 'debugger-hollow-arrow) - (eq type 'debugger-stop) - (eq type 'debugger-visit)) - (if (frame-live-p eos::debugger-frame) - eos::debugger-frame - (message "selecting destroyed frame; will ignore") - (eos::select-debugger-frame nil) - nil)) - (t (selected-frame)))) - -(defun eos::select-window (win) - ;; Will select a window if it is not showing neither of eos::debugger-buffer or - ;; eos::toolbar-buffer" - (let ((name (buffer-name (window-buffer win)))) - (if (and (>= (length name) 4) - (equal (substring name 0 4) "*Eos")) - nil - (select-window win) - (throw 'found t) - ))) - -(defun eos::find-line (file line type) - ;; Show FILE at LINE; returns frame or nil if inappropriate - ;; if type is nil - (if (eos::null-file file) - (selected-frame) - (let ((sc (eos::select-frame type)) - (win (selected-window))) - (if (null sc) - nil - (select-frame sc) - (if (catch 'found - (eos::select-window (selected-window)) - (walk-windows 'eos::select-window) - nil) - nil ; do nothing, already there - (select-window win) - (split-window-vertically) - (other-window 1) - ) - (switch-to-buffer (find-file-noselect file t)) ;; no warn! - (if (eq (device-type) 'x) (x-disown-selection)) - (goto-line line) - sc - )))) - -(defun eos::null-file (file) - ;; returns t if FILE is nil or the empty string - (or (null file) (equal file ""))) - -;;; -;;; Annotation handling -;;; - -(defun eos::valid-annotation (annotation) - ;; returns t if ANNOTATION is an annotation and its buffer exists - (and (annotationp annotation) - (bufferp (extent-buffer annotation)) - (buffer-name (extent-buffer annotation))) - ) - -(defvar eos::annotation-list nil - "list of annotations set") - -(defun eos::add-to-annotation-list (ann type) - (if (not (eq type 'debugger-stop)) - (error "not implemented")) - (setq eos::annotation-list (cons ann - eos::annotation-list)) - ) - -(defun eos::remove-from-annotation-list (ann type) - (if (not (eq type 'debugger-stop)) - (error "not implemented")) - (setq eos::annotation-list (delq ann eos::annotation-list)) - ) - -(defun eos::remove-all-from-annotation-list (type) - (if (not (eq type 'debugger-stop)) - (error "not implemented")) - (mapcar (function (lambda (annot) - (if (extent-live-p annot) - (delete-annotation annot)))) - eos::annotation-list) - (setq eos::annotation-list nil)) - -(defun eos::add-annotation (type file line uid) - (let ((anot nil) - (fr (selected-frame)) - (win (selected-window)) - ) - (if (eos::null-file file) - (setq anot nil) - (if (null (eos::find-line file line type)) - (error "No frame to select")) - (let* ((device-type (device-type (selected-device))) - (graphics (eos::annotation-get-glyph type device-type)) - (face (eos::annotation-get-face type device-type)) - ) - (setq anot (make-annotation graphics (point) 'outside-margin)) - (set-annotation-data anot uid) - (set-extent-face anot face) - (eos::add-to-annotation-list anot type) - )) - (select-frame fr) - (select-window win) - anot - )) - -(defun eos::compare-uid (extent uid) - (and (annotationp extent) - (equal (annotation-data extent) uid) - extent)) - -(defun eos::delete-annotation (type file line uid) - ;; ignore file and line, they are here for backward compatibility - (let ((anot nil) - (alist eos::annotation-list) - ) - (if (not (eq type 'debugger-stop)) - (error "not implemented")) - (while (and alist - (not (equal (annotation-data (car alist)) uid))) - (setq alist (cdr alist))) - (if (null alist) - (error "Event UID not found; ignored") - (setq anot (car alist)) - (delete-annotation anot) - (eos::remove-from-annotation-list anot type)) - )) - -;; probably type should not be given here... (already stored in the annotation-data -;; field) but it is a bit more robust this way. - -(defun eos::make-annotation-visible (annotation file line type) - ;; returns nil or moves the ANNOTATION to FILE and LINE; annotation is of TYPE - (let ((back nil) - (fr (selected-frame)) - (win (selected-window)) - ) - ;; (save-window-excursion - (if (not (eos::null-file file)) - (progn - (if (eos::valid-annotation annotation) - (detach-extent annotation) ; should operate on annotations - ) - (if (null (eos::find-line file line type)) - (error "No frame to select")) - (let* ((device-type (device-type (selected-device))) - (graphics (eos::annotation-get-glyph type device-type)) - (face (eos::annotation-get-face type device-type)) - ) - (if (and (eos::valid-annotation annotation) - (extent-detached-p annotation)) - (progn - (setq back (insert-extent annotation (point) (point) t)) - (set-annotation-glyph back graphics 'whitespace) - ) - (setq back (make-annotation graphics (point) 'whitespace)) - ) - (set-annotation-data back type) - (set-extent-face back face) - ))) - ;; ) - (if (not (eq (selected-frame) fr)) - (select-frame fr)) - (select-window win) - back - )) - -(defun eos::make-annotation-invisible (annotation) - ;; make this ANNOTATION invisible - (if (eos::valid-annotation annotation) - (detach-extent annotation) ;; should operate on annotations - )) - - -;; mapping between annotation types and their screen representations. - -(defvar eos::alist-annotation-glyph nil) ; assoc list of annotation type - ; device type, and glyph -(defvar eos::alist-annotation-inst nil) ; assoc list of annotation type - ; device type, and instantiator -(defvar eos::alist-annotation-inst-alt nil) ; alternate assoc list of annotation type - ; device type, and instantiator - -(defvar eos::alist-annotation-face nil) ;; assoc list of annotation type, - ;; device type and face - -;; PUBLIC - -;; TBD! merge both instance lists. - -(defun eos::annotation-set-inst (annotation-type device-type inst inst-alt) - "define the instantiator for ANNOTATION-TYPE on DEVICE-TYPE to be -INST for the frame enabled for this type and INST-ALT for other frames" - (interactive) - (setq eos::alist-annotation-inst - (cons (cons (cons annotation-type device-type) inst) - eos::alist-annotation-inst)) - (setq eos::alist-annotation-inst-alt - (cons (cons (cons annotation-type device-type) inst-alt) - eos::alist-annotation-inst-alt)) ) - -(defun eos::annotation-set-face (annotation-type device-type face-1 face-2) - "define the face for ANNOTATION-TYPE on DEVICE-TYPE to be -FACE-1 for the frame enabled for this type and FACE-2 for other frames" - (interactive) - (setq eos::alist-annotation-face - (cons (cons (cons annotation-type device-type) face-1) - eos::alist-annotation-face)) - ) - -;; PRIVATE - -(defun eos::annotation-get-glyph (annotation-type device-type) - ;; Get the glyph for ANNOTATION-TYPE on DEVICE-TYPE - (interactive) - (let ((found (assoc (cons annotation-type device-type) - eos::alist-annotation-glyph))) - (if found - (cdr found) - (let ((inst (eos::annotation-get-inst annotation-type device-type)) - (alt-inst (eos::annotation-get-inst-alt annotation-type device-type)) - (glyph nil) - (frame (selected-frame))) - (if (null inst) - nil - (setq glyph (make-glyph `((global . (nil . ,alt-inst))))) - (add-spec-to-specifier (glyph-image glyph) inst frame) - (setq eos::alist-annotation-glyph - (cons (cons (cons annotation-type device-type) glyph) - eos::alist-annotation-glyph)) - glyph)) - ))) - -(defun eos::annotation-get-inst (annotation-type device-type) - ;; Get the primary instantiator for ANNOTATION-TYPE on DEVICE-TYPE - (interactive) - (let ((found (assoc (cons annotation-type device-type) - eos::alist-annotation-inst))) - (if found - (cdr found) - nil))) - -(defun eos::annotation-get-inst-alt (annotation-type device-type) - ;; Get the alternate instantiator for ANNOTATION-TYPE on DEVICE-TYPE - (interactive) - (let ((found (assoc (cons annotation-type device-type) - eos::alist-annotation-inst-alt))) - (if found - (cdr found) - nil))) - -(defun eos::annotation-get-face (annotation-type device-type) - ;; Get the face for ANNOTATION-TYPE on DEVICE-TYPE - (interactive) - (let ((found (assoc (cons annotation-type device-type) - eos::alist-annotation-face)) - ) - (if found - (cdr found) - nil - )) - ) - - -(defun eos::common-startup () ) -;; - - -(provide 'eos-common) diff --git a/xemacs-packages/Sun/sun-eos-debugger-extra.el b/xemacs-packages/Sun/sun-eos-debugger-extra.el deleted file mode 100644 index 0d214dfa..00000000 --- a/xemacs-packages/Sun/sun-eos-debugger-extra.el +++ /dev/null @@ -1,830 +0,0 @@ -;;; sun-eos-debugger.el --- Implements the XEmacs/SPARCworks Debugger interface - -;; Copyright (C) Sun Microsystems, Inc. - -;; Maintainer: Eduardo Pelegri-Llopart -;; Author: Eduardo Pelegri-Llopart - -;; Keywords: SPARCworks EOS Era on SPARCworks Debugger dbx - -;;; Commentary: -;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com - -;;; Code: - -;; debugger buffer - -(require 'eos-common "sun-eos-common") -(require 'eos-debugger "sun-eos-debugger") -(require 'eos-menubar "sun-eos-menubar") - -(defvar eos::debugger-buffer "*Eos Debugger Log*" - "name of buffer where to log debugger activity; see eos::use-debugger-buffer") -(defvar eos::dbx-buffer nil) -(defvar eos::key-mode 'none "Style of key mode interaction for Eos") - -(defun eos::ensure-debugger-buffer () - ;; will ensure a debugger buffer, with the proper major mode - (let ((buf (get-buffer eos::debugger-buffer))) - (if buf - (switch-to-buffer buf) - (setq buf (get-buffer-create eos::debugger-buffer)) - (set-buffer buf) - (eos::debugger-mode) - (toggle-read-only -1) ; writeable - (eos::insert-string-as-extent "[Debugger] " t (get-face 'bold)) - (toggle-read-only 1) ; read-only - ))) - -(defun eos::synchronize-debugger-buffer () - ;; ensure all views of this buffer are at the end - (eos::ensure-debugger-buffer) - (let ((x (point-max))) - (goto-char x) - (mapcar (function - (lambda (win) - (set-window-point win x))) - (get-buffer-window-list eos::debugger-buffer)) - )) - -(defvar eos::debugger-mode-map nil) - -(if eos::debugger-mode-map - nil - (progn - (setq eos::debugger-mode-map (make-keymap)) - (set-keymap-name eos::debugger-mode-map 'eos::debugger-mode-map) - (define-key eos::debugger-mode-map [(meta p)] 'eos::debugger-previous-cmd) - (define-key eos::debugger-mode-map [(meta n)] 'eos::debugger-next-cmd) - (define-key eos::debugger-mode-map [return] 'eos::debugger-send-cmd) - )) - -(defun eos::debugger-mode () - (interactive) - "local mode" - (kill-all-local-variables) - (setq major-mode 'eos::debugger-mode) - (setq mode-name "eos::debugger") - (setq truncate-lines t) - (set-syntax-table emacs-lisp-mode-syntax-table) - (use-local-map eos::debugger-mode-map)) - - -;; Handling of command lists - -(defvar eos::current-command nil "Current command navigated; as an extent") -(defvar eos::last-command nil "last command sent to debugger, as an extent") - -(defun eos::debugger-previous-cmd () - ;; present the previous command - (interactive) - (save-excursion - (let ((xt nil)) - (if (null eos::current-command) - (setq xt eos::last-command) - (setq xt (extent-property - eos::current-command - 'previous-command))) - (if xt - (progn - (eos::debugger-delete-last-cmd-line) - (goto-char (point-max)) - (insert (buffer-substring - (extent-start-position xt) - (1- (extent-end-position xt)) ; remove - )) - (setq eos::current-command xt)) - (error "no previous command") - )) - )) - -(defun eos::debugger-next-cmd () - ;; present the next command - (interactive) - (save-excursion - (let ((xt nil)) - (if (null eos::current-command) - (error "no next command") - (setq xt (extent-property - eos::current-command - 'next-command))) - (eos::debugger-delete-last-cmd-line) - (if xt - (progn - (goto-char (point-max)) - (insert (buffer-substring - (extent-start-position xt) - (1- (extent-end-position xt)) ; remove - )) - (setq eos::current-command xt)) - (setq eos::current-command nil) - )) - )) - -(defun eos::debugger-delete-last-cmd-line () - ;; delete the last command line, not yet inputed, returns that cmd line - (goto-char (point-max)) - (let ((e (point))) - (beginning-of-line) - (let* ((xt (extent-at (point))) - (p (extent-end-position xt)) - (str (buffer-substring p e)) - ) - (delete-region p e) - str - ))) - -(defun eos::debugger-send-cmd () - ;; send the message in the current line - (interactive) - (end-of-line) - (let ((e (point))) - (beginning-of-line) - (let* ((xt (extent-at (point))) - (p (extent-end-position xt)) - (str (buffer-substring p e)) - ) - (delete-region p e) - (eos::send-spider-current-do-msg (concat str "\n")) - (goto-char (point-max)) - (setq eos::current-command nil) - ))) - -;; client -;; - -(defun eos::dbx-process () - ;; Returns nil, or the corresponding process where to insert - (let ((pl (process-list)) - (found-proc nil) - ) - (while (and pl (null found-proc)) - (let* ((proc (car pl)) - (name (process-name proc)) - ) - (if (and (>= (length name) 3) - (equal (substring name 0 3) "Eos")) - (setq found-proc proc) - (setq pl (cdr pl)) - ) - )) - found-proc - )) - -(defun eos::insert-echo (process string) - (if (null process) - nil - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) -;; (let ((beg (point))) -;; (insert-before-markers string)) - (insert-before-markers string) - (if (process-mark process) - (set-marker (process-mark process) (point-max)))) - (if (eq (process-buffer process) - (current-buffer)) - (goto-char (point-max))) - )) - - -(defun eos::insert-on-debugger-buffer (msg rdonly face &optional previous-command) - ;; will insert MSG at end of debugger buffer with RDONLY property and with FACE. - ;; If PREVIOUS-COMMAND is given, the newly created extent will be doubly linked into this one - ;; using 'previous-command and 'next-command properties - (save-window-excursion - (let ((fr (selected-frame)) - (buf (current-buffer)) - (xt nil)) - (eos::ensure-debugger-buffer) - (toggle-read-only -1) ; not read-only - (eos::insert-echo (eos::dbx-process) msg) - (setq xt (eos::insert-string-as-extent msg rdonly face)) - (if previous-command - (progn - (set-extent-property xt 'previous-command previous-command) - (set-extent-property previous-command 'next-command xt) - )) - (toggle-read-only 1) ; now read-only - (switch-to-buffer buf) - (select-frame fr) - xt - )) - ) - -(defun eos::insert-string-as-extent (msg rdonly face) - ;; insert MSG as a extent with RDONLY and FACE. Returns the extent - (let ((here nil) - (xt nil)) - (goto-char (point-max)) - (setq here (point)) - (insert msg) - (setq xt (make-extent here (point) nil)) - (if rdonly - (progn - (set-extent-property xt 'read-only t) - (set-extent-property xt 'duplicable nil) - )) - (set-extent-face xt face) - (eos::synchronize-debugger-buffer) - xt - )) - - -;; (require 'comint) - -(defvar eos::dbx-program "dbx") -(defvar eos::dbx-switches (list "-editor")) - -(defun eos::expand-file-name (file) - ;; expand file name depending on first character - (cond - ((null file) - nil) - ((eq (elt file 0) ?~) - (expand-file-name file)) - ((eq (elt file 0) ?$) - (substitute-in-file-name file)) - (t file))) - -(defun eos::read-dbx-request (program switches) - ;; will prompt to the user with PROGRAM and SWITCHES, let her modify this - ;; and then will read the result and split it into program and switches. - (let* ((prompt - (concat program " " (mapconcat 'identity switches " "))) - (ret (read-from-minibuffer "Run dbx as: " prompt)) - (ret2 (split-string ret " "))) - ;; some testing - (cons (car ret2) (cdr ret2)) - )) - -(defun eos::dbx () -;; Run an inferior dbx -editor process, with I/O through buffer *Eos Dbx*. -;; If buffer exists but dbx process is not running, make new dbx. -;; If buffer exists and dbx process is running, -;; just switch to buffer `*Eos Dbx*'. - (let ((buffer "*Eos Dbx*") - (buffer-name "Eos Dbx") - (input nil)) - (cond ((not (comint-check-proc buffer)) - (setq input (eos::read-dbx-request eos::dbx-program - eos::dbx-switches)) - (setq eos::dbx-program (car input)) - (setq eos::dbx-switches (cdr input)) - (message "Starting Dbx subprocess") - (setq buffer - (set-buffer - (apply 'make-comint - buffer-name - (eos::expand-file-name eos::dbx-program) - nil - (mapcar 'eos::expand-file-name eos::dbx-switches)))) - (comint-mode) - (if (and (eq (device-type (frame-device (selected-frame))) 'tty) - (eq eos::key-mode 'none) - (yes-or-no-p - "Do you want the prefix map activated?")) - (eos::set-key-mode 'prefix)) - (setq eos::dbx-or-debugger 'dbx) - (setq eos::dbx-buffer (current-buffer)) - (make-local-variable 'kill-buffer-hook) - (setq kill-buffer-hook - (list (function (lambda () - (cond - ((null (eos::dbx-process)) t) - ((not (eq (process-status (eos::dbx-process)) 'run)) t) - ((yes-or-no-p - "Warning! Killing this buffer will kill a dbx process, proceed? ") - (eos::internal-clear-annotations t t t t)) - (t (error "kill-buffer aborted!"))) - )))) - ) - (t - (message "Reusing existing dbx buffer and dbx process"))) - (switch-to-buffer buffer) - )) - - -;; Actions to start a debugger in the background. - -(defvar eos::debugger-process nil - "Debugger process for the background. Only one per XEmacs") - -(defvar eos::dbx-or-debugger nil) - -(defun eos::start-debugger () - "Start an \"debugger -editor\" in the background. Will ask for confirmation if -XEmacs somehow believes there is already one running" - (interactive) - (if (and (or (not (processp eos::debugger-process)) - (not (eq (process-status eos::debugger-process) 'run)) - (yes-or-no-p - "Warning! XEmacs believes there already is a debugger -editor, proceed? ")) - (or (not (eos::dbx-process)) - (not (eq (process-status (eos::dbx-process)) 'run)) - (yes-or-no-p - "Warning! XEmacs believes there already is a dbx -editor, proceed? "))) - (progn - (setq eos::debugger-process - (start-process "*eos debugger*" nil "debugger" "-editor")) - (message "Starting Debugger subprocess") - (eos::select-debugger-frame (selected-frame)) - (setq eos::dbx-or-debugger 'debugger) - ))) - -;; Ditto for dbx. - -(defun eos::start-dbx () - "Start an \"dbx -editor\" as a subprocess. Will ask for confirmation if -XEmacs somehow believes there is already one running" - (interactive) - (if (and (or (not (processp eos::debugger-process)) - (not (eq (process-status eos::debugger-process) 'run)) - (yes-or-no-p - "Warning! XEmacs believes there already is a debugger -editor, proceed? ")) - (or (not (eos::dbx-process)) - (not (eq (process-status (eos::dbx-process)) 'run)) - (yes-or-no-p - "Warning! XEmacs believes there already is a dbx -editor, proceed? "))) - (progn - (eos::select-debugger-frame (selected-frame)) - (eos::dbx) - ))) - - -;; -;; Communication commands -;; - -(defun eos::spider-do-callback (msg pat) - ;; Callback after processing a spider_do request - (eos::insert-on-debugger-buffer - (format "%s" (get-tooltalk-message-attribute msg 'arg_val 2)) - t - (get-face 'bold)) - (destroy-tooltalk-message msg) - ) - -(defvar eos::last-command-was-print nil "(eos:: internal)") - -(defun eos::spro_spider_output (msg pat) - ;; For spider output - (let ((s (get-tooltalk-message-attribute msg 'arg_val 1)) - (err (get-tooltalk-message-attribute msg 'arg_val 2)) - ) - (message (format "%s" s)) - (eos::insert-on-debugger-buffer (format "%s" s) - t - (get-face 'default)) - (if (and err (not (string-equal err ""))) - (eos::insert-on-debugger-buffer - (insert (format "STDERR> %s" err)) - t - (get-face 'default)) - ) - (destroy-tooltalk-message msg))) - -(defun eos::spro_spider_output-common (msg pat) - ;; For spider output - (if eos::last-command-was-print - (eos::spro_spider_print_output msg pat) - (eos::spro_spider_output msg pat))) - -(defmacro eos::spider-tt-args (cmd spider-id clique-id) - (` (list - 'class TT_REQUEST - 'address TT_HANDLER - 'scope TT_SESSION - 'handler (, spider-id) - 'op "SPRO_SPIDER_DO" - 'callback 'eos::spider-do-callback - 'args (list - (list 'TT_IN (, clique-id) "Context_ID") - (list 'TT_IN (, cmd) "string") - (list 'TT_OUT)) - ))) - -(defun eos::send-spider-do-msg (cmd spider-id clique-id) - ;; Send CMD, a string, to SPIDER-ID, using CLIQUE-ID - (let ((msg (make-tooltalk-message - (eos::spider-tt-args cmd spider-id clique-id)))) - (setq eos::last-command - (eos::insert-on-debugger-buffer - cmd - t - (get-face 'italic) - eos::last-command)) - (setq eos::current-command eos::last-command) - (send-tooltalk-message msg) - (destroy-tooltalk-message msg) - )) - -(defvar eos::no-connection-box - '("XEmacs does not know the ID of a debugger to connect to. -You may need to reissue a debug or attach command from the debugger. -Consult the introduction to Eos (Help->SPARCworks...) for more details." - ["Dismiss" (message "Command aborted") t])) - -(defun eos::send-spider-current-do-msg (cmd) - ;; Send CMD to the current dbx engine using the current debugger clique; - ;;The cmd ends in a new-line. - (if (null eos::current-debugger-clique-id) - (popup-dialog-box eos::no-connection-box) - (eos::send-spider-do-msg cmd - eos::current-dbx-proc-id - eos::current-debugger-clique-id))) - -(defun eos::dbx-cmd (arg) - "Send CMD to the current dbx engine using the current debugger clique; -The cmd does not end in a new-line; a new-line will be added" - (interactive "sDbx cmd: ") - (eos::send-spider-current-do-msg (concat arg "\n"))) - - -;; -;; Extra patterns - -(defvar eos::dbx-extra-pattern-list nil) - -(defun eos::debugger-extra-startup () - ;; Actions to do at startup for eos-debugger-extra.el - (setq eos::dbx-extra-pattern-list ; list of extra TT patterns - (eos::create-debugger-extra-patterns)) - (eos::ensure-available-print-frame) - (eos::define-prefix-map) ; initialize keymap - ) - -(defun eos::create-debugger-extra-patterns () - ;; returns a list of patterns - (list - (make-an-observer "SPRO_SPIDER_OUTPUT" 'eos::spro_spider_output-common) - )) - -(defun eos::register-debugger-extra-patterns () - ;; register additional dbx patterns - (mapcar 'register-tooltalk-pattern eos::dbx-extra-pattern-list)) - -(defun eos::unregister-debugger-extra-patterns () - ;; unregister additional dbx patterns - (mapcar 'unregister-tooltalk-pattern eos::dbx-extra-pattern-list)) - -;; -;; Common commands -;; - - -(defun eos::type () (interactive) - (if (eq eos::dbx-or-debugger 'debugger) - (call-interactively 'eos::dbx-cmd) - (if (buffer-live-p eos::dbx-buffer) - (switch-to-buffer eos::dbx-buffer) - (message "no dbx subprocess buffer known")))) - -(defun eos::run () (interactive) (eos::dbx-cmd "run")) -(defun eos::fix () (interactive) (eos::dbx-cmd "fix")) -(defun eos::build () (interactive) (eos::dbx-cmd "make")) - -(defun eos::cont () (interactive) (eos::dbx-cmd "cont")) -(defun eos::cont-and-dismiss () (interactive) - (eos::dismiss-print-frame) (eos::cont)) -(defun eos::clear-all () (interactive) (eos::dbx-cmd "clear")) -(defun eos::next () (interactive) (eos::dbx-cmd "next")) -(defun eos::next-and-dismiss () (interactive) - (eos::dismiss-print-frame) (eos::next)) -(defun eos::step () (interactive) (eos::dbx-cmd "step")) -(defun eos::step-and-dismiss () (interactive) - (eos::dismiss-print-frame) (eos::step)) -(defun eos::step-up () (interactive) (eos::dbx-cmd "step up")) - -(defun eos::up () (interactive) (eos::dbx-cmd "up" )) -(defun eos::down () (interactive) (eos::dbx-cmd "down")) -(defun eos::pop () (interactive) (eos::dbx-cmd "pop")) - - -(defun eos::stop-at () - (interactive) - (let ((name (buffer-file-name))) - (if (null name) (error "Buffer has no associated file")) - (eos::dbx-cmd - (format "stop at \"%s\":%d" name (eos::line-at (point)))) - )) - -(defun eos::clear-at () - (interactive) - (let ((name (buffer-file-name))) - (if (null name) (error "Buffer has no associated file")) - (eos::dbx-cmd - (format "clear \"%s\":%d" name (eos::line-at (point)))) - )) - -(defun eos::stop-in () - (interactive) - (eos::dbx-cmd - (format "stop in %s" - (if (eq 'x (device-type (selected-device))) - (x-get-selection) - (buffer-substring (point) (mark))) - )) - (setq zmacs-region-stays t)) - -(defun eos::func () - (interactive) - (eos::dbx-cmd - (format "func %s" - (if (eq 'x (device-type (selected-device))) - (x-get-selection) - (buffer-substring (point) (mark))) - )) - (setq zmacs-region-stays t)) - -(defun eos::cont-to () - (interactive) - (let ((name (buffer-file-name))) - (if (null name) (error "Buffer has no associated file")) - (eos::dbx-cmd - (format "stop at \"%s\":%d -temp; cont" name (eos::line-at (point)))) - )) - -(defun eos::print-normal () - (interactive) - (eos::dbx-cmd - (format "print %s" - (if (eq 'x (device-type (selected-device))) - (x-get-selection) - (buffer-substring (point) (mark))) - )) - (setq zmacs-region-stays t)) - -(defun eos::print*-normal () - (interactive) - (eos::dbx-cmd - (format "print *(%s)" - (if (eq 'x (device-type (selected-device))) - (x-get-selection) - (buffer-substring (point) (mark))) - )) - (setq zmacs-region-stays t)) - -;; specialization for print commands - -(defun eos::send-spider-print-msg (expr) - ;; Print EXPR using separate frame - (setq eos::last-command-was-print t) - (eos::dbx-cmd (format "print %s" expr))) - -(defun eos::send-spider-print*-msg (expr) - ;; Send *EXPR using separate frame - (setq eos::last-command-was-print t) - (eos::dbx-cmd (format "print *(%s)" expr))) - -(defun eos::print () (interactive) - (eos::send-spider-print-msg - (if (eq 'x (device-type (selected-device))) - (x-get-selection) - (buffer-substring (point) (mark))) - ) - (setq zmacs-region-stays t)) - -(defun eos::print* () (interactive) - (eos::send-spider-print*-msg - (if (eq 'x (device-type (selected-device))) - (x-get-selection) - (buffer-substring (point) (mark))) - ) - (setq zmacs-region-stays t)) - - -;; -;; -;; Print on separate frame - - -(defun eos::buffer-line-size (buffer) - (interactive) - (or (bufferp buffer) - (setq buffer (current-buffer))) - (save-excursion - (switch-to-buffer buffer) - (eos::line-at (point-max)))) - -;; -;; Handling of a collection of print frames -;; (currently only one) - -(defvar eos::print-frame nil "Frame for prints") -(defvar eos::print-buffer " *Eos Print Output*" "Buffer for prints") - -(defun eos::new-available-print-frame() - ;; returns an available print frame - ;; currently just returns the one frame - (require 'eos-toolbar "sun-eos-toolbar") - (let ((scr (selected-frame)) - (buf (current-buffer))) - - ;; create frames - (if (and - (frame-live-p eos::print-frame) - (or (not (frame-live-p eos::debugger-frame)) - (not (eq eos::print-frame - eos::debugger-frame)))) - (progn - (make-frame-visible eos::print-frame) - eos::print-frame) - (setq eos::print-frame (make-frame)) - ;; no modeline visible... - (set-face-background 'modeline - (face-background (get-face 'default)) - eos::print-frame) - (set-face-foreground 'modeline - (face-background (get-face 'default)) - eos::print-frame) - ;; there is redundancy below. - (select-frame eos::print-frame) - (switch-to-buffer eos::print-buffer) - (set-buffer-menubar nil) - (add-spec-to-specifier (eos::toolbar-position) eos::print-toolbar (selected-frame)) - (add-spec-to-specifier has-modeline-p nil (selected-frame)) - (select-frame scr) - (switch-to-buffer buf) - eos::print-frame - ))) - -;; set delete-frame-hook and check for this frame... then do - - - -(defun eos::ensure-available-print-frame () - ;; ensures that there is at least one available print frame - t) - -(defun eos::show-print-frame () - (interactive) - (setq eos::print-frame (eos::new-available-print-frame)) - (select-frame eos::print-frame) - (switch-to-buffer eos::print-buffer) - (set-frame-height eos::print-frame - (+ 1 (eos::buffer-line-size eos::print-buffer))) - (goto-char (point-min)) - ) - -(defun eos::dismiss-print-frame () - (interactive) - (if (frame-live-p eos::print-frame) - (progn - (make-frame-invisible eos::print-frame) - (select-frame (car (visible-frame-list)))))) -;; -;; print output -;; - -(defun eos::spro_spider_print_output (msg pat) - ;; For spider print output (switched with spro_spider_output - (let ((buf (current-buffer)) - (scr (selected-frame))) - (save-excursion ; does not work in callbacks? - (switch-to-buffer eos::print-buffer) - (delete-region (point-min) (point-max)) - (goto-char (point-max)) - (insert (format "%s" (get-tooltalk-message-attribute msg - 'arg_val 1))) - (let ((err (get-tooltalk-message-attribute msg - 'arg_val 2))) - (if (and err (not (string-equal err ""))) - (insert (format "STDERR> %s" err)))) - (eos::show-print-frame) - (select-frame scr) - (switch-to-buffer buf) - ) - (destroy-tooltalk-message msg) - (setq eos::last-command-was-print nil) - )) - - -;; User interface - -(defvar eos::prefix-map (make-keymap)) - -(defun eos::define-prefix-map () - - (define-key eos::prefix-map "%" 'eos::dbx-cmd) - (define-key eos::prefix-map "r" 'eos::run) - (define-key eos::prefix-map "f" 'eos::fix) - - (define-key eos::prefix-map "p" 'eos::print) - (define-key eos::prefix-map "\C-p" 'eos::print*) - - (define-key eos::prefix-map "c" 'eos::cont) - (define-key eos::prefix-map "b" 'eos::stop-at) - (define-key eos::prefix-map "\C-b" 'eos::clear-at) - - (define-key eos::prefix-map "n" 'eos::next) - (define-key eos::prefix-map "s" 'eos::step) - (define-key eos::prefix-map "\C-s" 'eos::step-up) - - (define-key eos::prefix-map "u" 'eos::up) - (define-key eos::prefix-map "d" 'eos::down) - -) - -(defun eos::set-key-mode (mode) - ;; Set the key MODE to either 'none, 'prefix, or 'function - (setq eos::key-mode mode) - (cond - ((eq eos::key-mode 'none) - (define-key global-map "\C-cd" nil) - (eos::remove-function-keys) - (add-submenu nil (append '("SPARCworks") eos::short-menu)) - ) - ((eq eos::key-mode 'prefix) - (define-key global-map "\C-cd" eos::prefix-map) - (eos::remove-function-keys) - (add-submenu nil (append '("SPARCworks") eos::long-menu)) - ) - ((eq eos::key-mode 'function) - (define-key global-map "\C-cd" nil) - (eos::add-function-keys) - (add-submenu nil (append '("SPARCworks") eos::long-menu)) - ) - (t - (error "unimplemented") - ))) - -(defun eos::add-function-keys () - (interactive) - - ;; - (global-set-key [f6] 'eos::dbx-cmd) - (global-set-key [(control f6)] 'eos::run) - (global-set-key [(shift f6)] 'eos::fix) - ;; - (global-set-key [f7] 'eos::print) - (global-set-key [(control f7)] 'eos::print*) - (global-set-key [(shift f7)] 'eos::dismiss-print-frame) - ;; - (global-set-key [f8] 'eos::cont) - (global-set-key [(control f8)] 'eos::stop-at) - (global-set-key [(shift f8)] 'eos::clear-at) - ;; - (global-set-key [f9] 'eos::next) - (global-set-key [(control f9)] 'eos::step) - (global-set-key [(shift f9)] 'eos::step-up) - ;; - ) - -(defun eos::remove-function-keys () - (interactive) - - ;; - (global-set-key [f6] nil) - (global-set-key [(control f6)] nil) - (global-set-key [(shift f6)] nil) - ;; - (global-set-key [f7] nil) - (global-set-key [(control f7)] nil) - (global-set-key [(shift f7)] nil) - ;; - (global-set-key [f8] nil) - (global-set-key [(control f8)] nil) - (global-set-key [(shift f8)] nil) - ;; - (global-set-key [f9] nil) - (global-set-key [(control f9)] nil) - (global-set-key [(shift f9)] nil) - ;; - ) - -;; Provides popup access - -(defvar eos::popup-mode nil) -(defvar eos::saved-global-popup-menu nil) - -(defun eos::toggle-popup-menu () - ;; Toggle whether to use or not popup menus for SPARCworks - (interactive) - (if eos::popup-mode - (setq global-popup-menu eos::saved-global-popup-menu) - (eos::push-popup-menu)) - (setq eos::popup-mode (null eos::popup-mode)) - ) - -(defun eos::push-popup-menu () - (setq eos::saved-global-popup-menu global-popup-menu) - (setq global-popup-menu - (append - '("SPARCworks Command" - ["Stop At" eos::stop-at t] - ["Clear At" eos::clear-at t] - ["Stop In" eos::stop-in t] - ["Cont To" eos::cont-to t] - ["Print" eos::print t] - ["Print*" eos::print* t] - "---" - ["Read a Dbx Command" eos::dbx-cmd t] - "---") - (list - eos::saved-global-popup-menu)) - )) - -(provide 'eos-debugger) - -;;; sun-eos-debugger.el ends here diff --git a/xemacs-packages/Sun/sun-eos-debugger.el b/xemacs-packages/Sun/sun-eos-debugger.el deleted file mode 100644 index 409b55b2..00000000 --- a/xemacs-packages/Sun/sun-eos-debugger.el +++ /dev/null @@ -1,594 +0,0 @@ -;;; sun-eos-debugger.el --- Implements the XEmacs/SPARCworks interface - -;; Copyright (C) 1995 Sun Microsystems, Inc. - -;; Maintainer: Eduardo Pelegri-Llopart -;; Author: Eduardo Pelegri-Llopart - -;; Keywords: SPARCworks EOS Era on SPARCworks Debugger dbx - -;;; Commentary: - -;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com - -;;; Code: - -(require 'eos-common "sun-eos-common") - -;;; ================= -;;; debugger protocol -;;; ================= - -(defvar eos::current-hollow-arrow nil) -(defvar eos::current-solid-arrow nil) -(defvar eos::current-dbx-proc-id nil - "TT id for the current dbx") -(defvar eos::current-debugger-clique-id nil - "Clique_ID for the current debugger/dbx") - -;; currentpc.color - -(defvar eos::currentpc-inst "/* XPM */ -static char * file[] = { -\"16 11 5 1\", -\" s background c #BDBDBDBDBDBD\", -\". c #000000000000\", -\"X c #0000FFFF0000\", -\"o c #000077770000\", -\"O c #000044440000\", -\" . \", -\" .. \", -\" .X. \", -\" .........XX. \", -\" .XXXXXXXXXoX. \", -\" .Xooooooooooo. \", -\" .oOOOOOOOOoO. \", -\" .........OO. \", -\" .O. \", -\" .. \", -\" . \"};") - -(defvar eos::currentpc-inst-alt - "/* XPM */ -static char * file[] = { -\"16 11 5 1\", -\" s background c #BDBDBDBDBDBD\", -\". c #000000000000\", -\"X c #0000FFFF0000\", -\"o c #000077770000\", -\"O c #000044440000\", -\" . \", -\" .. \", -\" .X. \", -\" .........XX. \", -\" .XXXXXXXXXoX. \", -\" .Xooooooooooo. \", -\" .oOOOOOOOOoO. \", -\" .........OO. \", -\" .O. \", -\" .. ..\", -\" . ..\"};") - -(defvar eos::visitedpc-inst - "/* XPM */ -static char * file[] ={ -\"16 11 5 1\", -\" s background c #BDBDBDBDBDBD\", -\". c #000000000000\", -\"X c #AFAFAFAFAFAF\", -\"o c #7E7E7E7EA9A9\", -\"O c #666633339999\", -\" . \", -\" .. \", -\" .X. \", -\" .........XX. \", -\" .XXXXXXXXXoX. \", -\" .XooooooooooO. \", -\" .XOOOOOOOOoO. \", -\" .........OO. \", -\" .O. \", -\" .. \", -\" . \"};") - -(defvar eos::visitedpc-inst-alt - "/* XPM */ -static char * file[] ={ -\"16 11 5 1\", -\" s background c #BDBDBDBDBDBD\", -\". c #000000000000\", -\"X c #AFAFAFAFAFAF\", -\"o c #7E7E7E7EA9A9\", -\"O c #666633339999\", -\" . \", -\" .. \", -\" .X. \", -\" .........XX. \", -\" .XXXXXXXXXoX. \", -\" .XooooooooooO. \", -\" .XOOOOOOOOoO. \", -\" .........OO. \", -\" .O. \", -\" .. ..\", -\" . ..\"};") - -(defvar eos::breakpoint-inst - "/* XPM */ -static char * file[] ={ -\"11 11 5 1\", -\" s background c #BDBDBDBDBDBD\", -\". c #000000000000\", -\"X c #FFFF66666666\", -\"o c #FFFF00000000\", -\"O c #777700000000\", -\" ..... \", -\" .XXXXX. \", -\" .XXoooXX. \", -\".XXoooooXO.\", -\".XoooooooO.\", -\".XoooooooO.\", -\".XoooooooO.\", -\".XXoooooOO.\", -\" .XXoooOO. \", -\" .OOOOO. \", -\" ..... \"};") - -(defvar eos::breakpoint-inst-alt - "/* XPM */ -static char * file[] ={ -\"11 11 5 1\", -\" s background c #BDBDBDBDBDBD\", -\". c #000000000000\", -\"X c #FFFF66666666\", -\"o c #FFFF00000000\", -\"O c #777700000000\", -\" ..... \", -\" .XXXXX. \", -\" .XXoooXX. \", -\".XXoooooXO.\", -\".XoooooooO.\", -\".XoooooooO.\", -\".XoooooooO.\", -\".XXoooooOO.\", -\" .XXoooOO. \", -\" .OOOOO...\", -\" ..... ..\"};") - -;; The TT protocol does not provide enough information to -;; use the eos::disabledBreakpoint glyph. - -(defvar eos::disabledBreakpoint-inst - "/* XPM */ -static char * file[] ={ -\"11 11 4 1\", -\" s background c #BDBDBDBDBDBD\", -\". c #000000000000\", -\"X c Grey\", -\"O c Grey80\", -\" ..... \", -\" .XXXXX. \", -\" .XXXXXXX. \", -\".XXXXXXXXO.\", -\".XXXXXXXXO.\", -\".XXXXXXXXO.\", -\".XXXXXXXXO.\", -\".XXXXXXXOO.\", -\" .XXXXXOO. \", -\" .OOOOO. \", -\" ..... \"};") - -(defvar eos::disabledBreakpoint-inst-alt - "/* XPM */ -static char * file[] ={ -\"11 11 4 1\", -\" s background c #BDBDBDBDBDBD\", -\". c #000000000000\", -\"X c Grey\", -\"O c Grey80\", -\" ..... \", -\" .XXXXX. \", -\" .XXXXXXX. \", -\".XXXXXXXXO.\", -\".XXXXXXXXO.\", -\".XXXXXXXXO.\", -\".XXXXXXXXO.\", -\".XXXXXXXOO.\", -\" .XXXXXOO. \", -\" .OOOOO...\", -\" ..... ..\"};") - -(defvar eos::dbx-pattern-list nil) - -(defun eos::debugger-startup () - ;; Actions to do at startup for eos-debugger.el - (make-face 'stop-face) - (make-face 'solid-arrow-face) - (make-face 'hollow-arrow-face) - - (set-face-foreground 'stop-face eos::stop-color) - (set-face-background 'stop-face - (face-background (get-face 'default))) - (set-face-foreground 'solid-arrow-face eos::solid-arrow-color) - (set-face-background 'solid-arrow-face - (face-background (get-face 'default))) - (set-face-foreground 'hollow-arrow-face eos::hollow-arrow-color) - (set-face-background 'hollow-arrow-face - (face-background (get-face 'default))) - - (setq eos::dbx-pattern-list ; list of dbx TT patterns - (eos::create-debugger-patterns)) - -;; should there be only one stop-face, with different properties depending -;; on the frame/device? - - (eos::annotation-set-inst 'debugger-stop 'x eos::breakpoint-inst [nothing]) - (eos::annotation-set-inst 'debugger-stop 'tty "[S]" [nothing]) - (eos::annotation-set-face 'debugger-stop 'x - (get-face 'stop-face) (get-face 'stop-face)) - (eos::annotation-set-face 'debugger-stop 'tty - (get-face 'highlight) (get-face 'highlight)) - - (eos::annotation-set-inst 'debugger-hollow-arrow 'x eos::visitedpc-inst [nothing]) - (eos::annotation-set-inst 'debugger-hollow-arrow 'tty "[]>" [nothing]) - (eos::annotation-set-face 'debugger-hollow-arrow 'x - (get-face 'hollow-arrow-face) - (get-face 'hollow-arrow-face)) - (eos::annotation-set-face 'debugger-hollow-arrow 'tty - (get-face 'highlight) (get-face 'highlight)) - - (eos::annotation-set-inst 'debugger-solid-arrow 'x eos::currentpc-inst [nothing]) - (eos::annotation-set-inst 'debugger-solid-arrow 'tty "=>" [nothing]) - (eos::annotation-set-face 'debugger-solid-arrow 'x - (get-face 'solid-arrow-face) - (get-face 'solid-arrow-face)) - (eos::annotation-set-face 'debugger-solid-arrow 'tty - (get-face 'highlight) (get-face 'highlight)) -) - -;; Not yet ready for prime time. - -(defvar eos::fill-stack-buffer nil - "when t don't try any stack tracing") - -(defvar eos::stack-buffer "*Eos Stack*" - "name of buffer where to log Stack") - -(defun eos::empty-stack () - ;; No valid stack data - e.g. resume/run program - - (if eos::fill-stack-buffer - (progn - (set-buffer (get-buffer-create eos::stack-buffer)) - (toggle-read-only -1) - (delete-region (point-min) (point-max)) - (toggle-read-only 1) - ))) - -(defun eos::load-stack () - ;; Should send a TT message requesting for the stack information; - ;; with the real work done in a callback - (if eos::fill-stack-buffer - (eos::stack-test 1))) - -(defun eos::visit-stack (stackpos) - (if eos::fill-stack-buffer - (progn - (eos::empty-stack) - (eos::stack-test 1) - ))) - -(defun eos::create-stack-patterns () - ;; returns a list of patterns - (list - (make-an-observer "SPRO_SPIDER_FRAMES" 'eos::spro_spider_frames) - )) - -(defun eos::spro_spider_frames (msg pat) - ;; We have received a SPRO_SPIDER_FRAMES notice - (let ((count (get-tooltalk-message-attribute msg 'args_count)) - (i 1)) - (set-buffer (get-buffer-create eos::stack-buffer)) - (toggle-read-only -1) - (while (< i count) - ;; optional leading comment - (if (equal (get-tooltalk-message-attribute msg 'arg_type i) - "Stack_Info1") - (progn - (insert (get-tooltalk-message-attribute msg 'arg_val i)) - (setq i (1+ i)))) - ;; current frame? - (insert (if (equal (get-tooltalk-message-attribute msg 'arg_ival i) - "0") " " "> ")) - (setq i (1+ i)) - (insert (format "[%s] %s%s %s:%s" - ;; frameno - (get-tooltalk-message-attribute msg 'arg_ival i) - ;; funcname - (get-tooltalk-message-attribute msg 'arg_val (+ i 1)) - ;; funcargs - (get-tooltalk-message-attribute msg 'arg_val (+ i 2)) - ;; source - (get-tooltalk-message-attribute msg 'arg_val (+ i 3)) - ;; line - (get-tooltalk-message-attribute msg 'arg_val (+ i 4)))) - (setq i (+ i 5)) - (if (equal (get-tooltalk-message-attribute msg 'arg_type i) - "Stack_Info2") - (progn - (insert (get-tooltalk-message-attribute msg 'arg_val i)) - (setq i (1+ i)))) - (insert "\n")) - (toggle-read-only 1) -;; (return-tooltalk-message msg) - )) - -(defun eos::spider-stack-callback (msg pat) - ;; Callback after processing a spider_stack request - (destroy-tooltalk-message msg) - ) - -(defmacro eos::stack-tt-args (spider-id clique-id hidden verbose quick starting-index count) - (` (list - 'class TT_REQUEST - 'address TT_HANDLER - 'scope TT_SESSION - 'handler (, spider-id) - 'op "SPRO_SPIDER_STACK" - 'callback 'eos::spider-stack-callback - 'args (list - (list 'TT_IN (, clique-id) "Context_ID") - (list 'TT_IN (, hidden) "Boolean") - (list 'TT_IN (, verbose) "Boolean") - (list 'TT_IN (, quick) "Boolean") - (list 'TT_IN (, starting-index) "int") - (list 'TT_IN (, count) "int")) - ))) - -(defun eos::stack-test (starting-index) - (let ((msg (make-tooltalk-message - (eos::stack-tt-args eos::current-dbx-proc-id - eos::current-debugger-clique-id - 0 ; hidden - 1 ; verbose - 0 ; quick - starting-index - 4 ; count - )))) - (send-tooltalk-message msg) -;; (destroy-tooltalk-message msg) - )) - -;; (setq eos::fill-stack-buffer t) -;; (setq eos::fill-stack-buffer nil) -;; (setq eos::stack-pattern-list (eos::create-stack-patterns)) -;; (mapcar 'register-tooltalk-pattern eos::stack-pattern-list) -;; (mapcar 'unregister-tooltalk-pattern eos::stack-pattern-list) -;; (eos::stack-test 1) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -;; - -(defun eos::spro_te_eventset (msg pat) - ;; thread_id trap_id string string filename lineno string string - (let* ((trap-id - (get-tooltalk-message-attribute msg 'arg_val 1)) - (filename - (get-tooltalk-message-attribute msg 'arg_val 4)) - (lineno - (read (get-tooltalk-message-attribute msg 'arg_ival 5)))) - (eos::add-annotation 'debugger-stop filename lineno trap-id) -;; (return-tooltalk-message msg) - )) - -(defun eos::spro_te_eventdel (msg pat) - ;; trap_id string string filename lineno string string - (let* ((trap-id - (get-tooltalk-message-attribute msg 'arg_val 0)) - (filename - (get-tooltalk-message-attribute msg 'arg_val 3)) - (lineno - (read (get-tooltalk-message-attribute msg 'arg_ival 4)))) - (eos::delete-annotation 'debugger-stop filename lineno trap-id) -;; (return-tooltalk-message msg) - )) - -(defun eos::spro_te_stopped (msg pat) - ;; thread_id filename procname lineno filename procname lineno - (let* ((filename-hollow - (get-tooltalk-message-attribute msg 'arg_val 1)) - (procname-hollow - (get-tooltalk-message-attribute msg 'arg_val 2)) - (lineno-hollow - (read (get-tooltalk-message-attribute msg 'arg_ival 3))) - (filename-solid - (get-tooltalk-message-attribute msg 'arg_val 4)) - (lineno-solid - (read (get-tooltalk-message-attribute msg 'arg_ival 6))) - ) - (setq eos::current-solid-arrow - (eos::make-annotation-visible eos::current-solid-arrow - filename-solid - lineno-solid - 'debugger-solid-arrow)) - (if (or (not (equal filename-solid filename-hollow)) - (not (equal lineno-solid lineno-hollow))) - (setq eos::current-hollow-arrow - (eos::make-annotation-visible eos::current-hollow-arrow - filename-hollow - lineno-hollow - 'debugger-hollow-arrow))) -;; (return-tooltalk-message msg) - (eos::load-stack) - )) - -;; Tracking current id's -;; - -(defun eos::update-dbx-proc-id (msg) - (setq eos::current-dbx-proc-id - (get-tooltalk-message-attribute msg 'sender)) - ;; the following is needed to make toolbar entries be active or not - ;; I think it is not needed in 19.13 - (eos::select-debugger-frame eos::debugger-frame) - ) - -(defun eos::update-current-debugger-clique-id (msg) - (setq eos::current-debugger-clique-id - (get-tooltalk-message-attribute msg 'arg_val 0)) - ) - -;; -;; Updating arrows -;; - - -(defun eos::update-pids (msg) - (eos::update-dbx-proc-id msg) - (eos::update-current-debugger-clique-id msg)) - -(defun eos::internal-clear-annotations (stack arrows stops &optional clique) - (if stack - (eos::empty-stack)) - (if arrows - (progn - (eos::make-annotation-invisible eos::current-hollow-arrow) - (eos::make-annotation-invisible eos::current-solid-arrow))) - (if clique - (progn - (setq eos::current-debugger-clique-id nil) - ;; not needed in 19.13? - (eos::select-debugger-frame eos::debugger-frame))) - (if stops - (eos::remove-all-from-annotation-list 'debugger-stop))) - - -(defun eos::clear-arrows (msg pat) - (eos::internal-clear-annotations t t nil) -;; (return-tooltalk-message msg) - ) - -(defun eos::update-clear-stops (msg pat) - (eos::update-pids msg) - (eos::internal-clear-annotations t nil t) -;; (return-tooltalk-message msg) - ) - -(defun eos::update-clear-arrows-stops (msg pat) - (eos::update-pids msg) - (eos::internal-clear-annotations t t t) -;; (return-tooltalk-message msg) - ) - -(defun eos::clear-arrows-stops (msg pat) - (let ((this-proc-id - (get-tooltalk-message-attribute msg 'sender))) - (if (equal eos::current-dbx-proc-id this-proc-id) - (progn - (eos::internal-clear-annotations t t t) - ;; (return-tooltalk-message msg) - )))) - -;; - -;; - -(defun eos::spro_detach (msg pat) - ;; a detach notification has been received. this means dbx/debugger - ;; is exiting - (eos::internal-clear-annotations t t t t) - (eos::dismiss-print-frame)) - -(defun eos::spro_te_location (msg pat) - ;; thread_id filename procname lineno filename procname lineno - (let* ((filename-hollow - (get-tooltalk-message-attribute msg 'arg_val 1)) - (lineno-hollow - (read (get-tooltalk-message-attribute msg 'arg_ival 3))) - (filename-solid - (get-tooltalk-message-attribute msg 'arg_val 4)) - (lineno-solid - (read (get-tooltalk-message-attribute msg 'arg_ival 6))) - ) - (setq eos::current-solid-arrow - (eos::make-annotation-visible eos::current-solid-arrow - filename-solid - lineno-solid - 'debugger-solid-arrow)) - (if (or (not (equal filename-solid filename-hollow)) - (not (equal lineno-solid lineno-hollow))) - (setq eos::current-hollow-arrow - (eos::make-annotation-visible eos::current-hollow-arrow - filename-hollow - lineno-hollow - 'debugger-hollow-arrow))) -;; (return-tooltalk-message msg) - )) - -(defun eos::spro_te_visit (msg pat) - ;; thread_id filename procname lineno stackpos - (let* ((filename - (get-tooltalk-message-attribute msg 'arg_val 1)) - (procname - (get-tooltalk-message-attribute msg 'arg_val 2)) - (lineno - (read (get-tooltalk-message-attribute msg 'arg_ival 3))) - (stackpos - (read (get-tooltalk-message-attribute msg 'arg_ival 4))) - ) - (eos::make-annotation-invisible eos::current-hollow-arrow) - (if (equal stackpos 1) - (progn - (eos::make-annotation-invisible eos::current-solid-arrow) - (setq eos::current-solid-arrow - (eos::make-annotation-visible eos::current-solid-arrow - filename - lineno - 'debugger-solid-arrow)) - ) - (setq eos::current-hollow-arrow - (eos::make-annotation-visible eos::current-hollow-arrow - filename - lineno - 'debugger-hollow-arrow)) - ) -;; (return-tooltalk-message msg) - (eos::visit-stack stackpos) - )) - -;; generate a list of patterns -;; so it can be registered and unregistered. - - -(defun eos::create-debugger-patterns () - ;; returns a list of patterns - (list - (make-an-observer "SPRO_TE_STOPPED" 'eos::spro_te_stopped) - (make-an-observer "SPRO_SE_STARTED" 'eos::clear-arrows) - (make-an-observer "SPRO_TE_STEPPED" 'eos::clear-arrows) - (make-an-observer "SPRO_TE_CONTINUED" 'eos::clear-arrows) - (make-an-observer "SPRO_SE_DROPPED" 'eos::clear-arrows-stops) - (make-an-observer "SPRO_SE_DEBUGGED" 'eos::update-clear-stops) - (make-an-observer "SPRO_SE_REVIVED" 'eos::update-clear-arrows-stops) - (make-an-observer "SPRO_SE_ATTACHED" 'eos::update-clear-arrows-stops) - (make-an-observer "SPRO_SE_GONE" 'eos::clear-arrows) - (make-an-observer "SPRO_TE_LOCATION" 'eos::spro_te_location) - (make-an-observer "SPRO_TE_VISIT" 'eos::spro_te_visit) - (make-an-observer "SPRO_TE_EVENTSET" 'eos::spro_te_eventset) - (make-an-observer "SPRO_TE_EVENTDEL" 'eos::spro_te_eventdel) - (make-an-observer "SPRO_DETACH" 'eos::spro_detach) - )) - -(defun eos::register-debugger-patterns () - ;; register all dbx patterns - (mapcar 'register-tooltalk-pattern eos::dbx-pattern-list) - (eos::register-debugger-extra-patterns)) - -(defun eos::unregister-debugger-patterns () - ;; unregister all dbx patterns - (mapcar 'unregister-tooltalk-pattern eos::dbx-pattern-list) - (eos::unregister-debugger-extra-patterns)) - -(provide 'eos-debugger) - -;;; sun-eos-debugger.el ends here diff --git a/xemacs-packages/Sun/sun-eos-editor.el b/xemacs-packages/Sun/sun-eos-editor.el deleted file mode 100644 index 3b9a1b20..00000000 --- a/xemacs-packages/Sun/sun-eos-editor.el +++ /dev/null @@ -1,114 +0,0 @@ -;;; sun-eos-editor.el --- Implements the XEmacs/SPARCworks editor protocol - -;; Copyright (C) 1995 Sun Microsystems, Inc. - -;; Maintainer: Eduardo Pelegri-Llopart -;; Author: Eduardo Pelegri-Llopart - -;; Keywords: SPARCworks EOS Era on SPARCworks editor - -;;; Commentary: - -;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com - -;;; Code: - -(require 'eos-common "sun-eos-common") - -;; =============== -;; Editor protocol -;; -;; message is -;; SPRO_Visit_File CONTEXT_UID filename lineno center==0 - -(defvar eos::visit-file-pattern) -(defvar eos::get-src-line-pattern) - -(defun eos::editor-startup () - ;; Actions to do at startup time for eos-editor - (setq eos::visit-file-pattern - (eos::create-visit-file-pattern)) - (setq eos::get-src-line-pattern - (eos::create-get-src-line-pattern)) - (eos::register-get-src-line-pattern) - ) - -(defun eos::visit-file-callback (msg pat) - ;; A callback for a SPRO_Visit_File message - ;; really should be discarded in the pattern - (let* ((filename - (get-tooltalk-message-attribute msg 'arg_val 1)) - (lineno-dot - (read - (get-tooltalk-message-attribute msg 'arg_ival 2))) - ) - (if (null (eos::find-line filename lineno-dot 'debugger-visit)) - (message "No frame to select")) - (return-tooltalk-message msg) - )) - -(defun eos::create-visit-file-pattern () - ;; Create Visit File pattern - (let* ((pattern-desc '(category TT_HANDLE - scope TT_SESSION - class TT_REQUEST - op "SPRO_Visit_File" - callback eos::visit-file-callback)) - (pattern (make-tooltalk-pattern pattern-desc)) - ) - pattern - )) - -(defun eos::register-visit-file-pattern () - ;; Register Visit File pattern - (register-tooltalk-pattern eos::visit-file-pattern)) - -(defun eos::unregister-visit-file-pattern () - ;; Unregister Visit File pattern - (unregister-tooltalk-pattern eos::visit-file-pattern)) - -;; -;; ==================== -;; -;; Auxiliary TT message to get source and lineno. -;; -;; message is -;; SPRO_Get_Src_Line CONTEXT_UID (INOUT filename) (INOUT lineno) - -;; - -(defun eos::get-src-line-callback (msg pat) - ;; A callback for a SPRO_Get_Src_Line message - ;; really should be discarded in the pattern - (let* ((filename - (buffer-file-name)) - (lineno - (format "%d" (eos::line-at (point))))) - (set-tooltalk-message-attribute filename msg 'arg_val 1) - (set-tooltalk-message-attribute lineno msg 'arg_val 2) - (return-tooltalk-message msg) - )) - -(defun eos::create-get-src-line-pattern () - ;; Create a pattern to get filename and lineno - (let* ((pattern-desc '(category TT_HANDLE - scope TT_SESSION - class TT_REQUEST - op "SPRO_Get_Src_Line" - callback eos::get-src-line-callback)) - (pattern (make-tooltalk-pattern pattern-desc)) - ) - pattern - )) - -(defun eos::register-get-src-line-pattern () - ;; Register Get Src Line pattern - (register-tooltalk-pattern eos::get-src-line-pattern)) - -(defun eos::unregister-get-src-line-pattern () - ;; Unregister Get Src Line pattern - (unregister-tooltalk-pattern eos::get-src-line-pattern)) - -(provide 'eos-editor) - -;;; sun-eos-debugger.el ends here diff --git a/xemacs-packages/Sun/sun-eos-init.el b/xemacs-packages/Sun/sun-eos-init.el deleted file mode 100644 index fc3047b2..00000000 --- a/xemacs-packages/Sun/sun-eos-init.el +++ /dev/null @@ -1,38 +0,0 @@ -;;; sun-eos-init.el --- Initializes the XEmacs/SPARCworks interface - -;; Copyright (C) 1996 Sun Microsystems, Inc. - -;; Maintainer: Eduardo Pelegri-Llopart -;; Author: Eduardo Pelegri-Llopart - -;; Keywords: SPARCworks EOS Era on SPARCworks initialize - -;;; Commentary: - -;; Initialize EOS -;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com - -;;; Code: - -;; This stuff needs to be done at startup time -(defun eos::start () - "Initialization needed at start-up time. Should be done by automatic -loading of eos" - (if (not (and (string-match "XEmacs" emacs-version) - (emacs-version>= 19 12))) - (error "Eos version %s only runs on XEmacs 19.12 and later" - eos::version)) - (if (not noninteractive) - (progn - (eos::common-startup) - (eos::editor-startup) - (eos::debugger-startup) - (eos::debugger-extra-startup) - (eos::browser-startup) - (eos::menubar-startup)))) - -;(add-hook 'before-init-hook 'eos::start t) ; append to the end of hook list - -(provide 'eos-init) - -;;; sun-eos-init.el ends here diff --git a/xemacs-packages/Sun/sun-eos-load.el b/xemacs-packages/Sun/sun-eos-load.el deleted file mode 100644 index 6f8ae220..00000000 --- a/xemacs-packages/Sun/sun-eos-load.el +++ /dev/null @@ -1,28 +0,0 @@ -;;; sun-eos-load.el --- Loads the XEmacs/SPARCworks interface code - -;; Copyright (C) 1995 Sun Microsystems, Inc. - -;; Maintainer: Eduardo Pelegri-Llopart -;; Author: Eduardo Pelegri-Llopart - -;; Keywords: SPARCworks EOS Era on SPARCworks Debugger dbx - -;;; Commentary: - -;; Load EOS code -;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com - -;;; Code: - -(load "sun-eos-init" nil t) -(load "sun-eos-common" nil t) -(load "sun-eos-editor" nil t) -(load "sun-eos-browser" nil t) -(load "sun-eos-debugger" nil t) -(load "sun-eos-debugger-extra" nil t) -(load "sun-eos-menubar" nil t) -;; don't load toolbar (load "sun-eos-toolbar" nil t) - -(provide 'eos-load) - -;;; sun-eos-load.el ends here diff --git a/xemacs-packages/Sun/sun-eos-menubar.el b/xemacs-packages/Sun/sun-eos-menubar.el deleted file mode 100644 index 5c558a38..00000000 --- a/xemacs-packages/Sun/sun-eos-menubar.el +++ /dev/null @@ -1,555 +0,0 @@ -;;; sun-eos-menu.el --- Implements the XEmacs/SPARCworks menubar - -;; Copyright (C) 1995 Sun Microsystems, Inc. - -;; Maintainer: Eduardo Pelegri-Llopart -;; Author: Eduardo Pelegri-Llopart - -;; Keywords: SPARCworks EOS Era on SPARCworks menubar - -;;; Commentary: -;; This file contains functions that populate a SPARCworks menu -;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com - -;;; Code: - -(require 'eos-common "sun-eos-common") - -(defun eos::toggle-sbrowser-selected-frame () - ;; Toggle whether this frame is selected for SBrowser - (interactive) - (if (equal eos::sbrowser-frame (selected-frame)) - (eos::select-sbrowser-frame nil) - (eos::select-sbrowser-frame (selected-frame))) - ) - -(defun eos::toggle-debugger-selected-frame () - ;; Toggle whether this frame is selected for Debugger - (interactive) - (if (equal eos::debugger-frame (selected-frame)) - (eos::select-debugger-frame nil) - (eos::select-debugger-frame (selected-frame))) - ) - -(defvar eos::long-menu - '( - ["Read and Execute a Dbx Command" eos::dbx-cmd (not (eq eos::key-mode 'none))] - ["Run" eos::run (not (eq eos::key-mode 'none))] - ["Fix" eos::fix (not (eq eos::key-mode 'none))] - "-----" - ["Print" eos::print (not (eq eos::key-mode 'none))] - ["Print *" eos::print* (not (eq eos::key-mode 'none))] - ["Dismiss Print" eos::dismiss-print-frame (not (eq eos::key-mode 'none))] - "-----" - ["Continue" eos::cont (not (eq eos::key-mode 'none))] - ["Stop" eos::stop-at (not (eq eos::key-mode 'none))] - ["Clear" eos::clear-at (not (eq eos::key-mode 'none))] - ["Next" eos::next (not (eq eos::key-mode 'none))] - ["Step" eos::step (not (eq eos::key-mode 'none))] - ["Step Up" eos::step-up (not (eq eos::key-mode 'none))] - ["Continue To" eos::cont-to (not (eq eos::key-mode 'none))] - "-----" - ["Stack Up" eos::up (not (eq eos::key-mode 'none))] - ["Stack Down" eos::down (not (eq eos::key-mode 'none))] - "-----" - ("Start Tool and Enable Frame" - ["Debugger" eos::start-debugger t] - ["Dbx" eos::start-dbx t] - ["SBrowser" eos::start-sbrowser t] - ) - "-----" - ["Enable Frame for SBrowser" - eos::toggle-sbrowser-selected-frame - :style toggle - :selected (equal eos::sbrowser-frame - (selected-frame))] - ["Enable Frame for Debugger and Dbx" - eos::toggle-debugger-selected-frame - :style toggle - :selected (equal eos::debugger-frame - (selected-frame))] - "-----" - ["News..." eos::sw-news t] - ) - ) - -(defvar eos::short-menu - '( - ("Start Tool and Enable Frame" - ["Debugger" eos::start-debugger t] - ["Dbx" eos::start-dbx t] - ["SBrowser" eos::start-sbrowser t] - ) - "-----" - ["Enable Frame for SBrowser" - eos::toggle-sbrowser-selected-frame - :style toggle - :selected (equal eos::sbrowser-frame - (selected-frame))] - ["Enable Frame for Debugger and Dbx" - eos::toggle-debugger-selected-frame - :style toggle - :selected (equal eos::debugger-frame - (selected-frame))] - "-----" - ["News..." eos::sw-news t] - ) - ) - -(defun eos::menubar-startup () - ;; Actions to do at startup for eos-menubar.el - (if (and (eq (device-type (selected-device)) 'x) - (or (not (local-variable-p 'current-menubar (current-buffer))) - (yes-or-no-p - "SPARCworks menu will be local (menubar is buffer-local); proceed?"))) - (progn - (add-menu-button '("Help") ["SPARCworks..." eos::sw-intro t]) - (add-submenu nil - (append '("SPARCworks") (copy-tree eos::short-menu)) - "Version Control" - ) - ))) - -;; -;; Insertion of text with a font -;; - -(defun eos::insert-italics (a-string) - (eos::insert-with-font a-string 'italic)) - -(defun eos::insert-bold (a-string) - (eos::insert-with-font a-string 'bold)) - -(defun eos::insert-with-font (a-string a-font) - (interactive "") - (let (a b ext) - (setq a (point)) - (insert a-string) - (setq b (point)) - (setq ext (make-extent a b)) - (set-extent-face ext (find-face a-font)) - )) - -;; -;; Generic insert code -;; - -(defun eos::insert (s) - (let ((len (length s)) - (pos 0) - (newpos 0) - (state 'normal)) - (while (< pos len) - (setq newpos (string-match "#[bnir]" s pos)) - (if (and newpos (> newpos pos)) - (progn - (cond ((equal (aref s (+ newpos 1)) ?b) ; bold - (if (equal state 'normal) - (progn - (insert (substring s pos newpos)) - (setq state 'bold)) - (error "found bold when not in normal"))) - ((equal (aref s (+ newpos 1)) ?r) ; red - (if (equal state 'normal) - (progn - (insert (substring s pos newpos)) - (setq state 'red)) - (error "found red when not in normal"))) - ((equal (aref s (+ newpos 1)) ?i) ; italics - (if (equal state 'normal) - (progn - (insert (substring s pos newpos)) - (setq state 'italics)) - (error "found italics when not in normal"))) - ((equal (aref s (+ newpos 1)) ?n) ; normal - (cond ((equal state 'italics) - (eos::insert-italics (substring s pos newpos)) - (setq state 'normal)) - ((equal state 'bold) - (eos::insert-bold (substring s pos newpos)) - (setq state 'normal)) - ((equal state 'normal) - (error "found normal when in normal")))) - (t - (error "internal error")) - ) - (setq pos (+ newpos 2)) - ) - (if (equal state 'normal) - (progn - (insert (substring s pos)) - (setq pos len)) - (error "eos::insert with unclosed special font")) - )) - )) - -;; -;; Introduction File -;; - -(defun eos::sw-intro () - "Generate an intro buffer." - (interactive) - (let ((buffer1 (get-buffer-create " *SPARCworks Intro*")) - ) - (switch-to-buffer buffer1) - (setq buffer-read-only nil) - (delete-region (point-min) (point-max)) - (eos::insert " - #bSPARCworks Editor Integration#n - Eos is copyright (c) 1995 by Sun Microsystems. - -#bIntroduction (for Eos 1.5.x)#n - -#iSPARCworks#n is a set of integrated programming tools from SunSoft that -support the program development cycle. #iXEmacs#n is a version of the Emacs -editor that includes interfaces to the selection service and to the -#iToolTalk#n service. The #iEos#n package uses these two interfaces to provide -a simple yet useful editor integration with three SPARCworks tools: -the #iSourceBrowser#n, the #iDebugger#n and #iDbx#n. Eos requires XEmacs 19.12 -or above, and SW3.0.1 or above. - -When used with Eos, the Debugger and SourceBrowser do not include a -source pane for displaying of sources and instead use an XEmacs frame. -Then the user can interact with the XEmacs frame in a way very similar -to how the source panes of the SW tools would be used. The user can also -start Dbx and request that sources be shown in XEmacs. - -#bSimple Startup#n - -In most cases, the user will start an interaction with Eos as follows: - - (1) Start XEmacs, - - (2) Load \"eos.el\" to add a SPARCworks submenu to the menubar (this -step might not be needed if Eos is preloaded to your XEmacs binary), and - - (3) On some XEmacs frame use the SPARCworks submenu and start the -desired tool and simultaneously enable that frame to display sources. - -The toolbar for the enabled frame will change after (3) to show that -this frame will behave as the source display for the SW tool and to -indicate that some actions on the tool can be performed from this frame. - -The actions available depend on the SW tool. The interaction model for -the Debugger and the SourceBrowser can be described as #iselect on the -XEmacs frame and then click on the button on the SW tool#n. As an example, -a browser query can be performed by selecting some text and then clicking -on the query button on the SBrowser tool; the source for the first match -will appear in the XEmacs frame, together with a glyph showing the match. - -The Debugger and Dbx can also be driven from XEmacs. Most frequently -this will be done using the ToolBar. Entries in the toolbar of a frame -enabled for debugging are deactivated when there is not enough information -to invoke their associated commands (due to technical reasons, it is -necessary for XEmacs to have had a frame enabled for Debugger/Dbx when -a debug or attach command was issued to Debugger/Dbx to make most toolbar -commands active). As an example, to set a breakpoint at some line, select -a position in that line and then click on the toolbar icon with the stop -with the arrow inside. - -#bDetails#n - -#iManual Startup#n - -In the scenario described above, the user simultaneously starts a tool -and enables a frame for that tool. The two actions can also be done -independently. The tools (Source Browser, Debugger, and Dbx) have to -be started with the \"-editor\" option and the XEmacs frame can be -enabled manually using the SPARCworks submenu. The most common use -of this feature is to disable and re-enable a frame, be it to recover -the default toolbar, or to avoid conflicts with other active tools -(see the paragraph below on multiple active tools). - -#iFrame Enabling#n - -At any given time there can be at most one frame enabled to display -Source Browser sources, and at most one frame enabled to display -Debugger and Dbx sources. The same XEmacs frame can be used for both -types of sources. The toolbar of an enabled frame always starts with -an informational icon. This icon is a large-font #ii#n with either a -smaller-font #iB#n, if the frame has browsing enabled, and/or a smaller-font -#iD#n, if the frame has debugging enabled. - -If no frames are enabled for a given tool, the editor integration for -that tool is disabled. This means that XEmacs deregisters the TT -patterns relevant to this tool, and XEmacs does not receive any -messages from that tool. - -#iMultiple Active Tools#n - -In order to provide a simpler user model, Eos has no provisions to -#igracefully#n support more than one simultaneous active tool of a -given class per TT session. A Debugger and a SourceBrowser, or a Dbx -and a SourceBrowser, can coexist gracefully, but a Debugger and a Dbx -cannot, and neither can two SourceBrowsers, two Debuggers, or two -dbxs. This simplification is consistent with the needs of most users. - -The implementation of Eos notifies the user if she attempts to start two -conflicting tools, but it does not enforce the restriction. In some -cases two conflicting tools can be used profitably by a careful user, -but in others the result is likely to be chaos. An example of the first -is using two SourceBrowsers, and one of the later is attempting to send -debugging commands from XEmacs to two debuggers. - -If a user really needs to have multiple active tools, she can do this -in a safe way by creating several TT sessions (e.g. using #ittsession --c /bin/csh#n, see the man page for ttsession), and placing the tools -with their own XEmacses in separate TT sessions. - -#iA Visual Data Inspector in XEmacs#n - -Users that choose to drive the debugger from XEmacs also have -available a #ivery simple#n but fast visual data inspector. The results -of #iprint#n and #iprint*#n commands are formatted into an XEmacs buffer -(#i\"*Eos Print Output*\"#n) and presented into a separate frame. -This frame is mapped and unmapped so that, except for the first time, -it appears quickly. - -#iBuffers for Debugger/Dbx Interaction#n - -When starting dbx as a subprocess, a buffer will be created to interact -with dbx. The name of this buffer is of the form #i\"*Eos dbx*\"#n. - -If a dbx engine is receiving requests from both Debugger and XEmacs -(e.g. it was started via #idebugger -editor#n), the responses to -commands sent by XEmacs will be shown in the echo area and will be -recorded in a read-only buffer (#i\"*Eos Debugger Log*\"#n), but responses -to Debugger commands will not appear. Conversely, responses to Debugger -commands will appear in the Debugger transcript pane but not in XEmacs's -log buffer. This is a limitation of the underlying TT protocols. - -#bTTY Support#n - -Although tty support is not an official part of Eos, it is possible -with some extra effort and specialized knowledge from the user. - -#iStarting a ToolTalk Session#n - -Eos requires a ToolTalk communication. This may require starting a TT -session by: - - (0) Start a ToolTalk session, and a shell so that all processes -started from this shell will use the new TT session. Do this by -executing \"ttsession -c /bin/csh\" - or whatever shell you use - -At this point, you can start your XEmacs on that shell, as shown in -step (1) above. Note that, since there is no TTY toolbar in 19.12 -(nor 19.13), an alternative mechanism must be used to enable the -(tty) frame. - -A typical use for tty is to interact with dbx. The command -#ieos::start-dbx#n will select the tty frame for debugging and will start -a dbx buffer. From this point on, dbx will use this tty frame to show -its sources. The introduction and news messages can be generated -using the commands #ieos::sw-intro#n and #ieos::sw-news#n. You can interact -with the dbx subprocess by typing to its associated input buffer or -using some key bindings. - -#iKey Bindings#n - -A tty user can interact with Eos by invoking directly the Eos -commands, evaluating elisp expressions, or through some key-bindings. -The expert user may provide her own key bindings. Eos also provides two -set of global bindings, which are activated by evaluating the -expressions (eos::set-key-mode 'prefix) or (eos::set-key-mode -'function). - -#bKnown Bugs#n - -Due to a bug in the internal subprocess machinery of XEmacs 19.12, the -default prompt of dbx subprocesses will show the full path to the binary. -The prompt can be overridden using the ksh variable PS1\; one way to do -this is by adding the following line to your ~/.dbxrc: - - PS1='(dbx) ' - -#bFeedback#n - -You are encouraged to send us feedback via the Comments button in -the About Box of either SPARCworks tool, or directly to -eos-comments@cs.uiuc.edu. - -#bEnjoy.#n") - (setq buffer-read-only t) - (goto-char (point-min)) - (view-mode nil 'kill-buffer) ;; assume the new view-less - )) - -;; -;; Cheat Sheets for keyboard mappings -;; -;; This depends on the mapping being used! -;; - -(defun eos::sw-cheat-sheet () - "Generate buffer that has a description of the key maps that can be -printed, cut and then taped somewhere (like on the keyboard or on your -monitor). This is particularly useful for the function keys" - (interactive) - (let ((buffer1 (get-buffer-create " *Cheat Sheets*")) - ) - (switch-to-buffer buffer1) - (setq buffer-read-only nil) - (delete-region (point-min) (point-max)) - (eos::insert " - #bCheat Sheets for Eos#n - -This buffer has a description of the key maps that can be printed, cut -and then taped somewhere (like on the keyboard or on your monitor). -This is particularly useful for the function keys since their numbers -don't any particular mnemonic value. - - -#bWhen using function keys#n #i[Options->SPARCworks->Use Function Keys]#n - ----------------------------------------- - -F6 F7 F8 F9 - -Do Print Cont ---- Next -Run Print* Stop Step -Fix Dismiss Clear Step Up - - ----------------------------------------- - -#bWhen using prefix map#n #i[Options->SPARCworks->Use C-c d Prefix Map]#n - ----------------------------------------- -Basic prefix: C-c d - - - Do % - Run r - Fix f - - Print p - Print* C-p - - Cont c - Stop b (for breakpoint) - Clear C-b - - Next n - Step s - Step up C-s - - Up u - Down d ----------------------------------------- - -") - (setq buffer-read-only t) - (goto-char (point-min)) - (view-mode nil 'kill-buffer) ;; assume the new view-less - )) - -;; -;; News files -;; - -(defun eos::sw-news () - "Generate a News buffer." - (interactive) - (let ((buffer1 (get-buffer-create " *Eos News*")) - ) - (switch-to-buffer buffer1) - (setq buffer-read-only nil) - (delete-region (point-min) (point-max)) - (eos::insert " - #bEos News#n - -See the #iHelp#n top-level menu for additional information on the -SPARCworks lightweight editor integration (Eos). The current version -of Eos is available as the contents of the variable eos::version. - -#bversion 1.5.2#n - - Support for 19.12 and 19.13. Works on TTYs. Uses real ToolBar. - Toolbars for debugger & content inspector are frame-local. - Better icons and glyphs. Support for (load-library \"eos\"). - Ease-of-use: startup for tools. - Icon files are now defined \"in-line\" to simplify administration. - - Removed the following to simplify use: - - Textual toolbar (from 1.4). - - Option submenu to add keymaps for debugger use. - - Popup menu. - - Any pretenses to support SW3.0; use SW3.0.1 instead. - -#bversion 1.4.1#n - - Added eos::add-button interface. - -#bversion 1.4#n - - Added toolbar like in dbxtool. Toolbar uses echo-help to show - meaning of buttons, (setq inhibit-help-echo t) if you don't - want it. - - Selection now remains after \"print\"-like commands. Now it - is possible to have the *debugger* buffer in the frame selected - for displaying debugged sources. - - Added a command to relayout debugger buffers so they show in - a layout similar to that of dbxtool. - -#bversion 1.3#n - - Provided popup-menu bindings for those debugger actions - that operate on the contents of the selection or its position; - selectable via options. - - The *debugger* buffer now support M-p and M-n. - -#bversion 1.2#n - - Better support for interactions via *debugger* buffer and directly - using a prefix map and function keys. - - Converted to use new toggle and radio menus, reorganizing - SPARCworks menu to factor out help and options into submenus, - which are now available under the Options and Help top-level menus. - -#bversion 1.1#n - - Some internal cleanup. - - Eos now provides basic machinery to drive the debugger - engine directly using ToolTalk messages. This feature is - not yet very well polished. You can try using it at your own risk, - or await for release 1.2 (soon to come) that will provide a better - interface and improved functionality, as well as documentation - for the interface. - -#bversion 1.0#n - - First widely available release. Supports simple #iselect and click#n model. - -#bPossible Future Enhancements#n - -* Add a \"peek-in-source\" mechanism to show the values of - expressions in the sources. - -* The comint package should be generalized to allow for TT-based - interpreters and it should be used in Eos. - -* Key & popup bindings should probably be a minor mode (currently - it conflicts with cc-mode). - -* Should support locking a print frame to force new print frames. Also, - should allow for following fields in print frames. - - -#bFeedback#n - - Send feedback to #ieos-comments@cs.uiuc.edu#n") - (setq buffer-read-only t) - (goto-char (point-min)) - (view-mode nil 'kill-buffer) ;; assume the new view-less - )) - -(provide 'eos-menubar) - -;;; sun-eos-debugger.el ends here diff --git a/xemacs-packages/Sun/sun-eos-toolbar.el b/xemacs-packages/Sun/sun-eos-toolbar.el deleted file mode 100644 index d448ac40..00000000 --- a/xemacs-packages/Sun/sun-eos-toolbar.el +++ /dev/null @@ -1,1110 +0,0 @@ -;;; sun-eos-toolbar.el --- Implements the EOS toolbar interface - -;; Copyright (C) Sun Microsystems, Inc. - -;; Maintainer: Eduardo Pelegri-Llopart -;; Author: Eduardo Pelegri-Llopart - -;; Keywords: SPARCworks EOS Era on SPARCworks toolbar - -;;; Commentary: - -;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com - -;;; Code: - -(defvar eos::toolbar-icon-directory - (file-name-as-directory (locate-data-directory "eos"))) - -(defvar eos::toolbar-run-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 5 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\". s FgColor c #000000000000\", -\"X c #0000FFFF0000\", -\"+ c #000077770000\", -\"@ c #000044440000\", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" ....... \", -\" \", -\" ..... \", -\" .X+@. ....... \", -\" .X+@. \", -\" ......@.... \", -\" .XXX++++. ....... \", -\" .XX++@. \", -\" .@+@. \", -\" .@. ....... \", -\" . \", -\" \", -\" ....... \", -\" \", -\" \", -\" ....... \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-run.xbm" eos::toolbar-icon-directory))) - "A Run icon pair.") - -(defvar eos::toolbar-type-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 2 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\"X c #000000000000\", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" XX XX \", -\" XX XX \", -\" XXXX XXXX XX XX \", -\" XX XX XX XX XX XX XXX X \", -\" XX XX XX XX XXX X X X \", -\" XX XX XX XX X XXXX \", -\" XX XX XX XX XXX XXXX \", -\" XX XX XX XX XX XX X X X \", -\" XXX XXX XX XX X XXX \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-type.xbm" eos::toolbar-icon-directory))) - "A Type-at icon pair.") - - -(defvar eos::toolbar-stop-at-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 5 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\". c #4B4B4B4B4B4B\", -\"X c #FFFFFFFFFFFF\", -\"o c #AFAFAFAFAFAF\", -\"O c #FFFF00000000\", -\" \", -\" \", -\" \", -\" \", -\" ........ \", -\" .XXXXXXXX. \", -\" .XoOOOOOOoX. \", -\" .XoOOOOOOOOoX. \", -\" .XoOOOOOOOOOOoX. \", -\" .XoOOOOOOOOOOOOoX. \", -\" .XoOOOOOOOOXOOOOOoX. \", -\" .XOOOOOOOOOXXOOOOOX. \", -\" .XOOOOXXXXXXXXOOOOX. \", -\" .XOOOOXXXXXXXXXOOOX. \", -\" .XOOOOXXXXXXXXOOOOX. \", -\" .XOOOOOOOOOXXOOOOOX. \", -\" .XOOOOOOOOOXOOOOOOX. \", -\" .XoOOOOOOOOOOOOOOoX. \", -\" .XoOOOOOOOOOOOOOX. \", -\" .XoOOOOOOOOOOoX. \", -\" .XoOOOOOOOOoX. \", -\" .XoOOOOOOoX. \", -\" .XXXXXXXX. \", -\" ........ \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-stop.xbm" eos::toolbar-icon-directory))) - "A Stop At icon pair.") - -(defvar eos::toolbar-clear-at-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 5 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\". c #4B4B4B4B4B4B\", -\"X c #FFFFFFFFFFFF\", -\"o c #AFAFAFAFAFAF\", -\"O c #FFFF00000000\", -\" \", -\" \", -\" \", -\" \", -\" ........ \", -\" .XXXXXXXX. \", -\" .XoOOOOOOoX. \", -\" .XoOOOOOOOOoX. \", -\" .XoOOOOOOOOOOoX. \", -\" .XoOOOOOOOOOOOOoX. \", -\" .XoOOOXXOOOOXXOOOoX. \", -\" .XOOOOOXXOOXXOOOOOX. \", -\" .XOOOOOOXXXXOOOOOOX. \", -\" .XOOOOOOOXXOOOOOOOX. \", -\" .XOOOOOOXXXXOOOOOOX. \", -\" .XOOOOOXXOOXXOOOOOX. \", -\" .XOOOOXXOOOOXXOOOOX. \", -\" .XoOOOXOOOOOOXOOOoX. \", -\" .XoOOOOOOOOOOOOoX. \", -\" .XoOOOOOOOOOOoX. \", -\" .XoOOOOOOOOoX. \", -\" .XoOOOOOOoX. \", -\" .XXXXXXXX. \", -\" ........ \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-clear-at.xbm" eos::toolbar-icon-directory))) - "A Clear At icon pair.") - -(defvar eos::toolbar-stop-in-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 5 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\". c #4B4B4B4B4B4B\", -\"X c #FFFFFFFFFFFF\", -\"o c #AFAFAFAFAFAF\", -\"O c #FFFF00000000\", -\" \", -\" \", -\" \", -\" \", -\" ........ \", -\" .XXXXXXXX. \", -\" .XoOOOOOOoX. \", -\" .XoOOOOOOOOoX. \", -\" .XoOOOOOOOOOOoX. \", -\" .XoOOOOOOOOOOOOoX. \", -\" .XoOOOOOOOOOXOXOOoX. \", -\" .XOOOXXXXOOXOOOXOOX. \", -\" .XOOOXOOOOOXOOOXOOX. \", -\" .XOOOXOOOOOXOOOXOOX. \", -\" .XOOOXXXOOXOOOOOXOX. \", -\" .XOOOXOOOOOXOOOXOOX. \", -\" .XOOOXOOOOOXOOOXOOX. \", -\" .XoOOXOOOOOXOOOXOoX. \", -\" .XoOOOOOOOOXOXOoX. \", -\" .XoOOOOOOOOOOoX. \", -\" .XoOOOOOOOOoX. \", -\" .XoOOOOOOoX. \", -\" .XXXXXXXX. \", -\" ........ \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-stop-in.xbm" eos::toolbar-icon-directory))) - "A Stop in icon pair.") - -(defvar eos::toolbar-step-into-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 5 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\". c #000000000000\", -\"O c #0000FFFF0000\", -\"+ c #000077770000\", -\"@ c #000044440000\", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" ..... ....... \", -\" .OOOO. \", -\" .O++++. \", -\" .O+.... ........ \", -\" .O+. \", -\" .O+. . \", -\" .O+. .. \", -\" .O+. .O. \", -\" .O+...O@. ....... \", -\" .O++OOO+@. \", -\" .O+++++++@. \", -\" .++++++@. ....... \", -\" ....O@. \", -\" .O. \", -\" .. ....... \", -\" . \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-step-into.xbm" eos::toolbar-icon-directory))) - "A Step Into icon pair.") - -(defvar eos::toolbar-step-up-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 5 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\". c #000000000000\", -\"O c #0000FFFF0000\", -\"+ c #000077770000\", -\"@ c #000044440000\", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" . \", -\" .. ....... \", -\" .O. \", -\" ....O@. \", -\" .++++++@. ....... \", -\" .O+++++++@. \", -\" .O++OOO+@. \", -\" .O+...O@. ....... \", -\" .O+. .O. \", -\" .O+. .. \", -\" .O+. . \", -\" .O+. \", -\" .O+.... ........ \", -\" .O++++. \", -\" .OOOO. \", -\" ..... ....... \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-step-up.xbm" eos::toolbar-icon-directory))) - "A Step up icon pair.") - -(defvar eos::toolbar-step-over-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 5 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\". c #000000000000\", -\"X c #0000FFFF0000\", -\"+ c #000077770000\", -\"@ c #000044440000\", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" ..... \", -\" .XXXX. ....... \", -\" .X++++. \", -\" .X+.... \", -\" .X+. ....... \", -\" .X+. . \", -\" .X+. .. \", -\" .X+. .X. ....... \", -\" .X+...X@. \", -\" .X++XXX+@. \", -\" .X+++++++@. ....... \", -\" .++++++@. \", -\" ....X@. \", -\" .X. ....... \", -\" .. \", -\" . \", -\" ....... \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-step-over.xbm" eos::toolbar-icon-directory))) - "A Step Over icon pair.") - -(defvar eos::toolbar-evaluate-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 2 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\". c #000000000000\", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" .... \", -\" .. .. ...... \", -\" .. .. ...... \", -\" .. .. \", -\" .. .. ...... \", -\" .. .. ...... \", -\" .... \", -\" .. \", -\" .. \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-evaluate.xbm" eos::toolbar-icon-directory))) - "A Evaluate icon pair.") - -(defvar eos::toolbar-evaluate-star-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 2 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\"X c #000000000000\", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" XX XX \", -\" XXX \", -\" XXXXXXX \", -\" XXX XXXX \", -\" XX XX XX XX XXXXXX \", -\" XX XX XXXXXX \", -\" XX XX \", -\" XX XX XXXXXX \", -\" XX XX XXXXXX \", -\" XXXX \", -\" XX \", -\" XX \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-evaluate-star.xbm" eos::toolbar-icon-directory))) - "A Evaluate Star icon pair.") - -(defvar eos::toolbar-fix-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 8 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\". c #7D7D7D7D7D7D\", -\"X c #000000000000\", -\"o c #FFFFFFFF0000\", -\"O c #FFFF99990000\", -\"+ c #FFFFCCCC3333\", -\"@ c #CCCC9999FFFF\", -\"# c #99996666CCCC\", -\" \", -\" \", -\" \", -\" \", -\" .XX. \", -\" XoOXX. \", -\" .Xo+OOXXX. \", -\" Xo++++OOOXXX \", -\" .Xo+++++++OOOX. \", -\" Xo++++++OOOXX. \", -\" .Xo++++OOXXX. \", -\" Xo++OOOXX. \", -\" .XoOOOXXXXXXXXXXXX \", -\" XoOXXX@@@@@@@@@@@X \", -\" XXX##############X \", -\" X@##############X \", -\" XXXXXXXXXXXXXXXXX \", -\" X@@@@X X@@@@X \", -\" X@###X X@###X \", -\" X@###X X@###X \", -\" X@###X X@###X \", -\" X@###X X@###X \", -\" XXXXXX XXXXXX \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-fix.xbm" eos::toolbar-icon-directory))) - "A Fix icon pair.") - -(defvar eos::toolbar-run2-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 5 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\". s FgColor c #000000000000\", -\"X c #0000FFFF0000\", -\"o c #000077770000\", -\"O c #000044440000\", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" . \", -\" .. \", -\" .X. \", -\" ............XX. \", -\" .XXXXXXXXXXXXoX. \", -\" .XoooooooooooooX. \", -\" .Xooooooooooooooo. \", -\" .XoooooooooooooO. \", -\" .oOOOOOOOOOOOoO. \", -\" ............OO. \", -\" .O. \", -\" .. \", -\" . \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-run2.xbm" eos::toolbar-icon-directory))) - "A Run icon pair.") - -(defvar eos::toolbar-cont-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 6 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\". c #000000000000\", -\"O c #0000FFFF0000\", -\"+ c #000077770000\", -\"@ c #000044440000\", -\"o c #FFFF00000000\", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" ..... ....... \", -\" .OOOO. \", -\" .O++++. \", -\" .O+.... ........ \", -\" .O+. \", -\" .O+. . \", -\" .O+. .. \", -\" .O+. .O. \", -\" .O+...O@. .. \", -\" .O++OOO+@. .oo. \", -\" .O+++++++@. .oooo. \", -\" .++++++@. .oooo. \", -\" ....O@. .oo. \", -\" .O. .. \", -\" .. \", -\" . \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-cont.xbm" eos::toolbar-icon-directory))) - "A Cont icon pair.") - - -(defvar eos::toolbar-up-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 8 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\". s FgColor c #000000000000\", -\"X c #CCCC9999FFFF\", -\"o c #99996666CCCC\", -\"O c #FFFFFFFF0000\", -\"+ c #FFFFCCCC3333\", -\"@ c #0000FFFF0000\", -\"# c #000077770000\", -\" \", -\" \", -\" \", -\" \", -\" . \", -\" ... \", -\" ........ ..... \", -\" .XXXXXX. ....... \", -\" .Xooooo. ... \", -\" .Xooooo. ... \", -\" .Xooooo. ... \", -\" .Xooooo. ... \", -\" .O+++++. ... \", -\" .O+++++. ... \", -\" .O+++++. \", -\" .O+++++. \", -\" .O+++++. \", -\" .@#####. \", -\" .@#####. \", -\" .@#####. \", -\" .@#####. \", -\" .@#####. \", -\" ........ \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-up.xbm" eos::toolbar-icon-directory))) - "A Up icon pair.") - -(defvar eos::toolbar-down-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 8 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\". s FgColor c #000000000000\", -\"X c #CCCC9999FFFF\", -\"o c #99996666CCCC\", -\"O c #FFFFFFFF0000\", -\"+ c #FFFFCCCC3333\", -\"@ c #0000FFFF0000\", -\"# c #000077770000\", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" ........ \", -\" .XXXXXX. \", -\" .Xooooo. \", -\" .Xooooo. \", -\" .Xooooo. \", -\" .Xooooo. \", -\" .O+++++. ... \", -\" .O+++++. ... \", -\" .O+++++. ... \", -\" .O+++++. ... \", -\" .O+++++. ... \", -\" .@#####. ... \", -\" .@#####. ....... \", -\" .@#####. ..... \", -\" .@#####. ... \", -\" .@#####. . \", -\" ........ \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-down.xbm" eos::toolbar-icon-directory))) - "A Down icon pair.") - -(defvar eos::toolbar-build-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 8 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\". c #000000000000\", -\"X c #CCCC9999FFFF\", -\"o c #99996666CCCC\", -\"O c #FFFFFFFF0000\", -\"+ c #FFFFCCCC3333\", -\"@ c #FFFF99990000\", -\"# c #FFFF66666666\", -\" \", -\" \", -\" \", -\" \", -\" ...... \", -\" .XXXX. \", -\" .Xooo. \", -\" .Xooo. \", -\" .Xooo. \", -\" .Xooo. \", -\" . .Xooo. \", -\" .O. .Xooo. \", -\" .O+@. .Xooo. \", -\" .O+++@. .Xooo. \", -\" .O+++++@..Xooo. \", -\" .O+++++++@.Xooo. \", -\" .O+++.............. \", -\" .O@@@@. . \", -\" ....... ###########. \", -\" . ###########. \", -\" . ###########. \", -\" .............. \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-build.xbm" eos::toolbar-icon-directory))) - "A Build icon pair.") - -(defvar eos::toolbar-dismiss-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * file[] = { -\"28 28 5 1\", -\" c #C8C8C8C8C8C8 s backgroundToolBarColor\", -\"X c #4B4B4B4B4B4B\", -\". c #FFFFFFFFFFFF\", -\"o c #AFAFAFAFAFAF\", -\"O c #FFFF00000000\", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" X X \", -\" XX XX \", -\" XX XX \", -\" XX XX \", -\" XX XX \", -\" XX XX \", -\" XXXX \", -\" XX \", -\" XXXX \", -\" XX XX \", -\" XX XX \", -\" XX XX \", -\" XX XX \", -\" XX XX \", -\" X X \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \", -\" \"};") - (toolbar-make-button-list - (expand-file-name "eos-dismiss.xbm" eos::toolbar-icon-directory))) - "A Dismiss icon pair.") - -(defvar eos::toolbar-intro-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * info[] = { -\"28 28 2 1\", -\"X c Gray75 s backgroundToolBarColor\", -\"o c #000077770000\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXoooooooXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXooooooXXXXXXXXXXXX\", -\"XXXXXXXXXoooooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXoooooooXXXXXXXXXXX\", -\"XXXXXXXXXoooooooooXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\"};") - (toolbar-make-button-list - (expand-file-name "eos-intro.xbm" eos::toolbar-icon-directory))) - "An intro icon pair.") - -(defvar eos::toolbar-introD-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * info[] = { -\"28 28 2 1\", -\"X c Gray75 s backgroundToolBarColor\", -\"o c #000077770000\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXoooooooXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXooooooXXXXXXXXXXXX\", -\"XXXXXXXXXoooooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXoooXXXXXXoooooXXXXXXXXXXXX\", -\"XXoXXoXXXXXoooooXXXXXXXXXXXX\", -\"XXoXXoXXXXoooooooXXXXXXXXXXX\", -\"XXoXXoXXXoooooooooXXXXXXXXXX\", -\"XXoXXoXXXXXXXXXXXXXXXXXXXXXX\", -\"XXoXXoXXXXXXXXXXXXXXXXXXXXXX\", -\"XXoooXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\"};") - (toolbar-make-button-list - (expand-file-name "eos-introD.xbm" eos::toolbar-icon-directory))) - "An intro icon pair.") - -(defvar eos::toolbar-introDB-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * info[] = { -\"28 28 2 1\", -\"X c Gray75 s backgroundToolBarColor\", -\"o c #000077770000\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXoooooooXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXooooooXXXXXXXXXXXX\", -\"XXXXXXXXXoooooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXoooXXXXXXoooooXXXXXXoooXXX\", -\"XXoXXoXXXXXoooooXXXXXXoXXoXX\", -\"XXoXXoXXXXoooooooXXXXXoXXoXX\", -\"XXoXXoXXXoooooooooXXXXoooXXX\", -\"XXoXXoXXXXXXXXXXXXXXXXoXXoXX\", -\"XXoXXoXXXXXXXXXXXXXXXXoXXoXX\", -\"XXoooXXXXXXXXXXXXXXXXXoooXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\"};") - (toolbar-make-button-list - (expand-file-name "eos-introDB.xbm" eos::toolbar-icon-directory))) - "An intro icon pair.") - -(defvar eos::toolbar-introB-icon - (if (featurep 'xpm) - (toolbar-make-button-list - "/* XPM */ -static char * info[] = { -\"28 28 2 1\", -\"X c Gray75 s backgroundToolBarColor\", -\"o c #000077770000\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXoooooooXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\", -\"XXXXXXXXXXooooooXXXXXXXXXXXX\", -\"XXXXXXXXXoooooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXXXXXXX\", -\"XXXXXXXXXXXoooooXXXXXXoooXXX\", -\"XXXXXXXXXXXoooooXXXXXXoXXoXX\", -\"XXXXXXXXXXoooooooXXXXXoXXoXX\", -\"XXXXXXXXXoooooooooXXXXoooXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXoXXoXX\", -\"XXXXXXXXXXXXXXXXXXXXXXoXXoXX\", -\"XXXXXXXXXXXXXXXXXXXXXXoooXXX\", -\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\"};") - (toolbar-make-button-list - (expand-file-name "eos-introB.xbm" eos::toolbar-icon-directory))) - "An intro icon pair.") - - -(defvar eos::debugger-toolbar - '( - [eos::toolbar-introD-icon - eos::sw-intro - t - "Show Introduction to Eos"] - [eos::toolbar-stop-at-icon - eos::stop-at - eos::current-debugger-clique-id - "stop at: Stop at selected position"] - [eos::toolbar-stop-in-icon - eos::stop-in - eos::current-debugger-clique-id - "stop in: Stop in function whose name is selected"] - [eos::toolbar-clear-at-icon - eos::clear-at - eos::current-debugger-clique-id - "clear at: Clear at selected position"] - [eos::toolbar-run-icon - eos::run - eos::current-debugger-clique-id - "run: Run current program"] - [eos::toolbar-evaluate-icon - eos::print - eos::current-debugger-clique-id - "print: Evaluate selected expression; shows in separate XEmacs frame"] - [eos::toolbar-evaluate-star-icon - eos::print* - eos::current-debugger-clique-id - "print *: Evaluate selected expression as a pointer; shows in separate XEmacs frame"] - [eos::toolbar-up-icon - eos::up - eos::current-debugger-clique-id - "up: move in stack towards \"cooler\" (less recently visited) frames"] - [eos::toolbar-down-icon - eos::down - eos::current-debugger-clique-id - "down: move in stack towards \"warmer\" (more recently visited) frames)"] - [eos::toolbar-cont-icon - eos::cont - eos::current-debugger-clique-id - "cont: Continue current program"] - [eos::toolbar-step-over-icon - eos::next - eos::current-debugger-clique-id - "next: Step over subprogram calls"] - [eos::toolbar-step-into-icon - eos::step - eos::current-debugger-clique-id - "step: Step into subprogram calls)"] - [eos::toolbar-step-up-icon - eos::step-up - eos::current-debugger-clique-id - "step up: Step up from subprogram calls)"] - [eos::toolbar-build-icon - eos::build - eos::current-debugger-clique-id - "make: Build target"] - [eos::toolbar-fix-icon - eos::fix - eos::current-debugger-clique-id - "fix: Fix file"] - [eos::toolbar-type-icon - eos::type - (or (and (eq eos::dbx-or-debugger 'debugger) - eos::current-debugger-clique-id) - (and (eq eos::dbx-or-debugger 'dbx) - (eos::dbx-process) - (eq (process-status (eos::dbx-process)) 'run))) - "Type a Dbx command"] - )) - -(defvar eos::debugger-sbrowser-toolbar - '( - [eos::toolbar-introDB-icon - eos::sw-intro - t - "Show Introduction to Eos"] - [eos::toolbar-stop-at-icon - eos::stop-at - eos::current-debugger-clique-id - "stop at: Stop at selected position"] - [eos::toolbar-stop-in-icon - eos::stop-in - eos::current-debugger-clique-id - "stop in: Stop in function whose name is selected"] - [eos::toolbar-clear-at-icon - eos::clear-at - eos::current-debugger-clique-id - "clear at: Clear at selected position"] - [eos::toolbar-run-icon - eos::run - eos::current-debugger-clique-id - "run: Run current program"] - [eos::toolbar-evaluate-icon - eos::print - eos::current-debugger-clique-id - "print: Evaluate selected expression; shows in separate XEmacs frame"] - [eos::toolbar-evaluate-star-icon - eos::print* - eos::current-debugger-clique-id - "print *: Evaluate selected expression as a pointer; shows in separate XEmacs frame"] - [eos::toolbar-up-icon - eos::up - eos::current-debugger-clique-id - "up: move in stack towards \"cooler\" (less recently visited) frames"] - [eos::toolbar-down-icon - eos::down - eos::current-debugger-clique-id - "down: move in stack towards \"warmer\" (more recently visited) frames)"] - [eos::toolbar-cont-icon - eos::cont - eos::current-debugger-clique-id - "cont: Continue current program"] - [eos::toolbar-step-over-icon - eos::next - eos::current-debugger-clique-id - "next: Step over subprogram calls"] - [eos::toolbar-step-into-icon - eos::step - eos::current-debugger-clique-id - "step: Step into subprogram calls)"] - [eos::toolbar-step-up-icon - eos::step-up - eos::current-debugger-clique-id - "step up: Step up from subprogram calls)"] - [eos::toolbar-build-icon - eos::build - eos::current-debugger-clique-id - "make: Build target"] - [eos::toolbar-fix-icon - eos::fix - eos::current-debugger-clique-id - "fix: Fix file"] - [eos::toolbar-type-icon - eos::type - (or (and (eq eos::dbx-or-debugger 'debugger) - eos::current-debugger-clique-id) - (and (eq eos::dbx-or-debugger 'dbx) - (eos::dbx-process) - (eq (process-status (eos::dbx-process)) 'run))) - "Type a Dbx command"] - )) - -(defvar eos::sbrowser-toolbar - '([eos::toolbar-introB-icon - eos::sw-intro - t - "Show Introduction to Eos"] - )) - -(defvar eos::print-toolbar - '( - [eos::toolbar-intro-icon - eos::sw-intro - t - "Show Introduction to Eos"] - [eos::toolbar-evaluate-icon - eos::print - eos::current-debugger-clique-id - "print: Evaluate selected expression; shows in separate XEmacs frame"] - [eos::toolbar-evaluate-star-icon - eos::print* - eos::current-debugger-clique-id - "print *: Evaluate selected expression as a pointer; shows in separate XEmacs frame"] - [eos::toolbar-cont-icon - eos::cont-and-dismiss - eos::current-debugger-clique-id - "cont & dismiss: Continue current program and dismiss this frame"] - [eos::toolbar-step-over-icon - eos::next-and-dismiss - eos::current-debugger-clique-id - "next & dismiss: Step over subprogram calls and dismiss this frame"] - [eos::toolbar-step-into-icon - eos::step-and-dismiss - eos::current-debugger-clique-id - "step & dismiss: Step into subprogram calls and dismiss this frame)"] - [eos::toolbar-dismiss-icon - eos::dismiss-print-frame - t - "dismiss (make invisible) this print frame"] - )) - -(defun eos::toolbar-position () - (let ((pos (default-toolbar-position))) - (cond ((eq pos 'top) top-toolbar) - ((eq pos 'bottom) bottom-toolbar) - ((eq pos 'left) left-toolbar) - ((eq pos 'right) right-toolbar) - (t top-toolbar)))) - -(provide 'eos-toolbar) - -;;; sun-eos-toolbar.el ends here diff --git a/xemacs-packages/Sun/sun-eos.el b/xemacs-packages/Sun/sun-eos.el deleted file mode 100644 index 80a117ec..00000000 --- a/xemacs-packages/Sun/sun-eos.el +++ /dev/null @@ -1,20 +0,0 @@ -;;; sun-eos.el --- Intereactively loads the XEmacs/SPARCworks interface - -;; Copyright (C) 1995 Sun Microsystems, Inc. - -;; Maintainer: Eduardo Pelegri-Llopart -;; Author: Eduardo Pelegri-Llopart - -;; Keywords: SPARCworks EOS Era on SPARCworks load - -;;; Commentary: - -;; If manual loading is desired... -;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com - -;;; Code: - -(load "sun-eos-load.el") -(eos::start) - -;;; sun-eos-eos.el ends here diff --git a/xemacs-packages/Sun/sunpro-init.el b/xemacs-packages/Sun/sunpro-init.el deleted file mode 100644 index b5085411..00000000 --- a/xemacs-packages/Sun/sunpro-init.el +++ /dev/null @@ -1,191 +0,0 @@ -;;; No byte-compiler warnings -;(eval-when-compile -; (require 'w3)) - -;;; Keep these obsolete variables for backward compatibility -(defconst era-version "0.95" "\ -Version numbers of this version of Era.") - -;; We're (not really anymore) calling this version Sun Era. -(defconst sun-era t) - -(defun era-version () - "Return (obsolete) string describing the version of Era that is running. -Era is now known as XEmacs. Use (emacs-version) instead." - (interactive) - (if (interactive-p) - (message "%s" (era-version)) - (format "%sEra %s of %s %s on %s (%s)" - (if sun-era "Sun " "") - era-version - (substring emacs-build-time 0 - (string-match " *[0-9]*:" emacs-build-time)) - (substring emacs-build-time - (string-match "[0-9]*$" emacs-build-time)) - emacs-build-system system-type))) - -;(defun sunpro-maybe-connect-to-tooltalk () -; (if (and (not (noninteractive)) -; (fboundp 'command-line-do-tooltalk)) -; (command-line-do-tooltalk nil))) - -;; sunpro-maybe-connect-to-tooltalk must appear in the hook list -;; before any clients that register patterns, like eos-load.el. -;; Currently eos-load.el places its functions at the end of the list - -;(add-hook 'before-init-hook 'sunpro-maybe-connect-to-tooltalk) - -(set-glyph-image text-pointer-glyph "xterm") -(set-glyph-image nontext-pointer-glyph "xterm") - -;; W3 doesn't know about using pageview, so let's fix that. -;; There doesn't seem to be any such function `w3-parse-mailcap' - mrb - -;(defun sunpro-fix-postscript-viewer () -; (if (not (noninteractive)) -; (condition-case nil -; (w3-parse-mailcap -; (expand-file-name "sparcworks/sunpro-mailcap" data-directory)) -; (error nil)))) - -;(add-hook 'w3-load-hooks 'sunpro-fix-postscript-viewer) - -;; turn on pending delete without messing up its autoloads -;(defun sunpro-pending-delete-on () -; (if (not (noninteractive)) -; (pending-delete-on nil))) - -;(add-hook 'before-init-hook 'sunpro-pending-delete-on) - -;;; Decide whether to use workshop.el or eos at runtime, based on -;;; which Sun DevPro products are installed. - -(defun sunpro-update-paths-for-workshop () - "Update exec-path and load-path to find supporting workshop files. -Returns nil if the required files cannot be found." - (and - (cond - ((locate-file "workshop.el" load-path)) - - ((file-exists-p (concat sunpro-dir "lib/workshop.el")) - (setq load-path (append load-path (list (concat sunpro-dir "lib/")))))) - - (cond - ((locate-file "workshop" exec-path)) - - ((file-exists-p (concat sunpro-dir "bin/workshop")) - (setq exec-path (append exec-path (list (concat sunpro-dir "bin/")))))))) - -(defun sunpro-startup () - "Runs at startup if support for Sun Workshop is compiled in. Don't run this." - - ;; Sun distribution censors yow, among other things... - (unless (locate-file "yow.el" load-path) - (fmakunbound 'yow) - (delete-menu-item '("Apps" "Games" "Quote from Zippy")) - (delete-menu-item '("Apps" "Games" "Psychoanalyze Zippy!"))) - - (when (not (noninteractive)) - - (flet - ((sunpro-dir-p (dir) - (and dir - (file-exists-p (concat dir "bin/workshop")) - (file-exists-p (concat dir "lib/workshop.el"))))) - (defconst sunpro-dir - (cond - ;; Look on the PATH - ((let ((path exec-path) dir (found nil)) - (while (and path (not found)) - (setq dir (or (car path) ".")) - (setq path (cdr path)) - (setq dir (concat dir (if (string-match "/$" dir) "../" "/../"))) - (setq found (sunpro-dir-p dir))) - (if found - (expand-file-name dir)))) - - ;; Check for standard Sun DevPro CD Install layout - ((if (string-match "contrib/[^/]+/[^/]+/[^/]+/[^/]+/$" exec-directory) - (let ((dir (substring exec-directory 0 (match-beginning 0)))) - (if (sunpro-dir-p dir) - (expand-file-name dir))))) - - ;; Default install location - ("/opt/SUNWspro/")) - - "Directory where Sun Developer Products are installed.")) - - ;; Sunpro ships the mule version as a 2-file addition to the - ;; non-mule distribution - the binary and the doc file. - ;; - ;; This is a quick hack, I know... - ;; There ought to be a better way to do this. - ;; Perhaps a --xemacs-flavor=mule flag? - (if (featurep 'mule) - (let ((mule-doc-file-name (concat internal-doc-file-name "-mule"))) - (if (file-exists-p (concat doc-directory mule-doc-file-name)) - (setq internal-doc-file-name mule-doc-file-name)))) - - ;; Connect to tooltalk, but only on an X server. - (when (and (featurep 'tooltalk) - (fboundp 'command-line-do-tooltalk) - (eq 'x (device-type))) - (command-line-do-tooltalk nil)) - - ;; Sun's pending-del default is like textedit's - (require 'pending-del) - (turn-on-pending-delete) - - ;; Bar cursor 2 pixels wide - (setq bar-cursor 2) - - ;; Nice CDE compliant icon -- now the default... - ;;(if (featurep 'xpm) - ;; (set-glyph-image - ;; frame-icon-glyph - ;; (format "%s%s" data-directory "xemacs-icon3.xpm") - ;; 'global 'x)) - - (cond - ;; Use Sun WorkShop if available - ((sunpro-update-paths-for-workshop) - ;; Unfortunately, changes to the default toolbar in 20.3 b21 - ;; have broken workshop-frob-toolbar in workshop.el. Since new - ;; XEmacsen have to work with older WorkShops, this must be - ;; fixed both in workshop.el (distributed on the Sun WorkShop CD) - ;; and worked-around here. - (set-specifier default-toolbar - (append (specifier-instance default-toolbar) - `([,(toolbar-make-button-list nil) - workshop-bugfix nil nil]))) - (require 'workshop) - (set-specifier default-toolbar - (delete-if (lambda (b) (eq (aref b 1) 'workshop-bugfix)) - (specifier-instance default-toolbar)))) - - ;; Else, use eos package with sparcworks if available - ((or - (locate-file "sparcworks" exec-path) - (prog1 - (file-exists-p (concat sunpro-dir "bin/sparcworks")) - (setq exec-path (append exec-path (list (concat sunpro-dir "bin/")))))) - - (load "sun-eos-init") - (load "sun-eos-common") - (load "sun-eos-editor") - (load "sun-eos-browser") - (load "sun-eos-debugger") - (load "sun-eos-debugger-extra") - (load "sun-eos-menubar") - (eos::start)) - - (t ; Neither? Complain... - (display-warning - 'sunpro - "XEmacs was compiled with support for Sun Developer Products, -but neither `workshop' nor `sparcworks' were found on the PATH."))) - )) - -(add-hook 'before-init-hook 'sunpro-startup) - -(provide 'sunpro) diff --git a/xemacs-packages/Sun/sunpro-keys.el b/xemacs-packages/Sun/sunpro-keys.el deleted file mode 100644 index c29eb955..00000000 --- a/xemacs-packages/Sun/sunpro-keys.el +++ /dev/null @@ -1,26 +0,0 @@ -;;; sunpro-keys.el --- SunPro-specific key bindings - -;; Copyright (C) 1993, 1994 Sun Microsystems, Inc - -(define-key global-map 'find 'x-isearch-maybe-with-region) - -(define-key isearch-mode-map 'f18 'isearch-yank-x-clipboard) -(add-hook 'isearch-mode-hook 'sunpro-set-isearch-direction) -(define-key isearch-mode-map 'f19 'isearch-repeat-forward) - -(defun x-isearch-maybe-with-region (&optional backward-p) - "Enter isearch mode. If the region is active, find the selected text." - (interactive "P") - (let ((sunpro-isearch-direction - (if backward-p 'backward 'forward))) - (if (and zmacs-regions (mark)) - (progn (isearch-mode (not backward-p)) (isearch-yank-x-selection)) - (if backward-p (isearch-backward) (isearch-forward))))) - -(defun sunpro-set-isearch-direction () - (if (or (eq this-command 'isearch-backward) - (eq this-command 'isearch-backward-regexp) - (and (boundp 'sunpro-isearch-direction) - (eq sunpro-isearch-direction 'backward))) - (define-key isearch-mode-map 'f19 'isearch-repeat-backward) - (define-key isearch-mode-map 'f19 'isearch-repeat-forward))) diff --git a/xemacs-packages/Sun/sunpro-menubar.el b/xemacs-packages/Sun/sunpro-menubar.el deleted file mode 100644 index e09c4ae7..00000000 --- a/xemacs-packages/Sun/sunpro-menubar.el +++ /dev/null @@ -1,234 +0,0 @@ -;;; sunpro-menubar.el --- Initialize the SunPro menubar - -;; Copyright (C) 1993, 1994 Sun Microsystems, Inc - -;; Author: Aaron Endelman -;; Maintainer: Vladimir Ivanovic -;; Created: 93/09/13 15:16:24 - -;; Keywords: SunPro menubar initialization - -;;; Commentary: -;; Creates the default SunPro menubars. - -;;; To Do: - -;;; Code: - -(defconst sunpro-menubar - (purecopy-menubar ;the simple, new user menubar - (list - '("File" - ["New" sunpro-new-buffer t] - ["Open:" find-file t] - ["Include File:" insert-file t] - "-----" - ["Save" save-buffer t nil] - ["Save As:" write-file t] - ["Revert..." revert-buffer t nil] - "-----" - ["Print" lpr-buffer t nil] - "-----" - ["Close" delete-frame t] - ["Exit XEmacs" save-buffers-kill-emacs t] - ) - - '("Edit" - ["Undo" advertised-undo t] - "-----" - ["Cut" x-kill-primary-selection t] - ["Copy" x-copy-primary-selection t] - ["Paste" x-yank-clipboard-selection t] - ["Delete" x-delete-primary-selection t] - "-----" - ["Select Block" mark-paragraph t] - ["Select All" mark-whole-buffer t] - ) - - '("View" - ["New View" make-frame t] - "-----" - ["Split Window" (split-window) t] - ["Unsplit Window" delete-other-windows t] - ["Close Buffer" (kill-buffer nil) t nil] - "-----! before list all buffers" - ["List All Buffers" list-buffers t] - ) - - '("Find" - ["Forward:" sunpro-search-forward t] - ["Backward:" sunpro-search-backward t] - ["And Replace:" sunpro-query-replace t] - ) - - ;; Copy the options menu from the default menubar - (car (find-menu-item default-menubar '("Options"))) - - '("Utilities" - ["Cancel Command" (keyboard-quit) t] - "-----" - ["Execute Macro" call-last-kbd-macro last-kbd-macro] - ["Start Macro Recording" start-kbd-macro (not defining-kbd-macro)] - ["End Macro Recording" end-kbd-macro defining-kbd-macro] - "-----" - ["Spell" ispell-buffer t] - ["Sort" sort-lines t] - "-----" - ["Format Paragraph " fill-paragraph t] - "-----" - ["Goto Line:" goto-line t] - ) - - ;; the following is supposed to be here! It ensures that the - ;; Help item is always the rightmost item. - - nil ; the partition: menus after this are flushright - - '("Help" ["About XEmacs..." about-xemacs t] - "-----" - ["XEmacs WWW Page" xemacs-www-page t] - ["XEmacs FAQ via WWW" xemacs-www-faq t] - "-----" - ["Info" info t] - ["Describe Mode" describe-mode t] - ["Hyper Apropos..." hyper-apropos t] - ["Command Apropos..." command-apropos t] - ["Full Apropos..." apropos t] - ["List Keybindings" describe-bindings t] - ["Describe Key..." describe-key t] - ["Describe Function..." describe-function t] - ["Describe Variable..." describe-variable t] - "-----" - ["Unix Manual..." manual-entry t] - ["XEmacs Tutorial" help-with-tutorial t] - ["XEmacs News" view-emacs-news t] - )))) - -(set-menubar sunpro-menubar) - -(defconst programmer-menu '(["Programmer Menus" - (toggle-programmer-menus) - :style toggle - :selected programmer-menus-p] - ["-----! before save options" nil t])) -(setq save-options-menu-item - (car (find-menu-item default-menubar '("Options" "Save Options")))) -(delete-menu-item '("Options" "Save Options")) -(add-menu () "Options" (append - (cdr (car - (find-menu-item default-menubar '("Options")))) - programmer-menu - (list save-options-menu-item))) - -;;; -;;; helper commands -;;; - -(defun sunpro-new-buffer () - (interactive) - (switch-to-buffer (generate-new-buffer "Untitled"))) - -(defun sunpro-new-window () - (interactive) - (switch-to-buffer-other-frame (generate-new-buffer "Untitled"))) - -(defun sunpro-clone-buffer () - (interactive) - (let - ((old (current-buffer))) - (switch-to-buffer (generate-new-buffer (buffer-name old))) - (insert-buffer old))) - -(defun sunpro-search-forward () - (interactive) - (if isearch-mode (isearch-repeat-forward) - (x-isearch-maybe-with-region))) - -(defun sunpro-search-backward () - (interactive) - (if isearch-mode (isearch-repeat-backward) - (x-isearch-maybe-with-region t))) - -(put 'sunpro-search-forward 'isearch-command t) -(put 'sunpro-search-backward 'isearch-command t) - -(defun sunpro-query-replace () - (interactive) - (call-interactively 'query-replace)) - -(defun sunpro-menu-quit () - "Abort minibuffer input if any." - (while (not (zerop (minibuffer-depth))) - (abort-recursive-edit))) - -(defvar programmer-menus-p nil) -(defvar sccs-or-vc-menus 'sccs - "Choose to use the SCCS or the VC menu.") - -(defun toggle-programmer-menus () - (interactive) - (if programmer-menus-p - (progn - (if (equal sccs-or-vc-menus 'sccs) - (delete-menu-item '("SCCS")) - (delete-menu-item '("Version Control"))) - (delete-menu-item '("SPARCworks")) - (delete-menu-item '("Options" "SPARCworks")) - (delete-menu-item '("Options" "-----! before save options")) - (delete-menu-item '("Help" "SPARCworks")) - (setq programmer-menus-p nil)) - (progn - (require 'eos-load "sun-eos-load") - (eos::start) - (if (equal sccs-or-vc-menus 'sccs) - (progn - (delete-menu-item '("Version Control")) - (require 'sccs) - (add-menu '() "SCCS" (cdr sccs-menu))) - (progn - (require 'vc) - (delete-menu-item '("SCCS")) - (add-menu '() "Version Control" vc-default-menu))) - (setq programmer-menus-p t)))) - -(defun sunpro-build-buffers-menu-hook () - "For use as a value of activate-menubar-hook. -This function changes the contents of the \"View\" menu to add -at the end the current set of buffers. Only the most-recently-used few buffers -will be listed on the menu, for efficiency reasons. You can control how -many buffers will be shown by setting `buffers-menu-max-size'. -You can control the text of the menu items by redefining the function -`format-buffers-menu-line'." - (let ((buffer-menu (car (find-menu-item current-menubar '("View")))) - buffers) - (if (not buffer-menu) - nil - (setq buffer-menu (cdr buffer-menu)) - (setq buffers (buffer-list)) - - (if (and (integerp buffers-menu-max-size) - (> buffers-menu-max-size 1)) - (if (> (length buffers) buffers-menu-max-size) - (setcdr (nthcdr buffers-menu-max-size buffers) nil))) - - (setq buffers (build-buffers-menu-internal buffers)) - (setq buffers (append (delq nil buffers))) - ;; slightly (only slightly) more efficient to not install the menubar - ;; if it hasn't visibly changed. - (let ((tail (member "-----! before list all buffers" (cdr buffer-menu))) - ) - (if tail - (if (equal buffers (cdr tail)) - t ; return t meaning "no change" - (setcdr tail buffers) - nil) - ;; only the first time - (add-menu nil "View" (append buffer-menu - '("-----! before list all buffers") - buffers)) - nil - ))))) - -(add-hook 'activate-menubar-hook 'sunpro-build-buffers-menu-hook) - -;;; sunpro-menubar.el ends here diff --git a/xemacs-packages/Sun/sunpro-sparcworks.el b/xemacs-packages/Sun/sunpro-sparcworks.el deleted file mode 100644 index ea202a9d..00000000 --- a/xemacs-packages/Sun/sunpro-sparcworks.el +++ /dev/null @@ -1,127 +0,0 @@ -;;; sunpro-sparcworks.el --- support SPARCworks manager ToolTalk messages - -;; Copyright (C) Sun Microsystems, Inc. - -;; Author: Vladimir Ivanovic -;; Maintainer: Vladimir Ivanovic -;; Created: 20 Mar 95 - -;; Keywords: SPARCworks, ToolTalk, messages - -;;; Commentary: - -;; Called from the SPARCworks Manager with the command: -;; -;; xemacs -q -l sunpro-sparcworks $SUNPRO_SWM_TT_ARGS $SUNPRO_SWM_GUI_ARGS -;; - -;;; To Do: - -;;; Code: - -(require 'cl) ; Common Lisp compatibility - -(defvar sunpro-sparcworks-ops - '("quit" - "hide" - "expose" - "PEI_CLOSE" - "PEI_OPEN" - "PEI_NOP") - "The ToolTalk operations that are handled.") - -(defvar sunpro-sparcworks-callbacks - '(sp-sw-quit-handler - sp-sw-hide-handler - sp-sw-expose-handler - sp-sw-close-handler - sp-sw--open-handler - sp-sw-nop-handler) - "The ToolTalk operations that are handled.") - -(defvar sunpro-sparcworks-invocation-count nil - "The number of XEmacsen invoked via the SPARCworks Manager.") - -(defun sp-sw-quit-handler (msg pat) - (return-tooltalk-message msg 'reply) - (save-buffers-kill-emacs)) - -(defun sp-sw-hide-handler (msg pat) - (return-tooltalk-message msg 'reply) - (mapcar #'make-frame-invisible (frame-list))) - -(defun sp-sw-expose-handler (msg pat) - (return-tooltalk-message msg 'reply) - (mapcar #'make-frame-visible (frame-list))) - -(defun sp-sw-close-handler (msg pat) - (return-tooltalk-message msg 'reply) - (mapcar #'iconify-frame (frame-list))) - -(defun sp-sw-open-handler (msg pat) - (return-tooltalk-message msg 'reply) - (mapcar #'deiconify-frame (frame-list))) - -(defun sp-sw-nop-handler (msg pat) - (return-tooltalk-message msg 'reply) - '()) - -(register-tooltalk-pattern - (make-tooltalk-pattern - '(category TT_HANDLE - scope TT_SESSION - op "quit" - callback sp-sw-quit-handler))) - -(register-tooltalk-pattern - (make-tooltalk-pattern - '(category TT_HANDLE - scope TT_SESSION - op "hide" - callback sp-sw-hide-handler))) - -(register-tooltalk-pattern - (make-tooltalk-pattern - '(category TT_HANDLE - scope TT_SESSION - op "expose" - callback sp-sw-expose-handler))) - -(register-tooltalk-pattern - (make-tooltalk-pattern - '(category TT_HANDLE - scope TT_SESSION - op "PEI_CLOSE" - callback sp-sw-close-handler))) - -(register-tooltalk-pattern - (make-tooltalk-pattern - '(category TT_HANDLE - scope TT_SESSION - op "PEI_OPEN" - callback sp-sw-open-handler))) - -(register-tooltalk-pattern - (make-tooltalk-pattern - '(category TT_HANDLE - scope TT_SESSION - op "PEI_NOP" - callback sp-sw-nop-handler))) - -(defun sunpro-sparcworks-handle-command-line (arg) - "Handle the SPARCworks Manager-specific command line arguments." - (setq *sunpro-sparcworks-invocation-count* arg) - ;;Fix up the command-line in case there are more arguments - (setq command-line-args-left - (cdr command-line-args-left))) - - -;;; Initialize -(setq command-switch-alist - (purecopy - (append '(("-swtm" . sunpro-sparcworks-handle-command-line)) - command-switch-alist))) - - -;;; sunpro-sparcworks.el ends here -