(defconst package-directory-map
'(
;; xemacs-packages
- ("Sun" . "xemacs-packages")
("ada" . "xemacs-packages")
("apel" . "xemacs-packages")
("auctex" . "xemacs-packages")
\
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 \
+++ /dev/null
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.19 released.
-
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.18 released.
-
-2014-05-13 Jerry James <james@xemacs.org>
-
- * .cvsignore: Remove.
- * .hgignore: New file.
-
-2012-01-10 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.17 released.
-
-2011-12-30 Aidan Kehoe <kehoea@parhasard.net>
-
- * 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 <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.16 released.
-
-2004-08-24 Jerry James <james@xemacs.org>
-
- * sun-eos-debugger-extra.el (get-buffer-window-list): Removed.
-
-2003-10-31 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.15 released.
-
-2003-09-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.14 released.
-
-2003-03-30 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (EARLY_GENERATED_LISP): Revert previous change.
-
-2003-03-22 Steve Youngs <youngs@xemacs.org>
-
- * 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 <ben@xemacs.org>
-
- * Makefile:
- Delete explicit compile:: and binkit: rules.
-
-2002-11-29 Ben Wing <ben@xemacs.org>
-
- * .cvsignore: Remove files now handled automatically by CVS.
- * Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-10-15 Ville Skyttä <scop@xemacs.org>
-
- * Makefile (srckit): Remove.
-
-1998-07-25 SL Baur <steve@altair.xemacs.org>
-
- * dumped-lisp.el: removed.
-
-1998-07-18 SL Baur <steve@altair.xemacs.org>
-
- * dumped-lisp.el: Elimination of Lisp read-time macros.
-
-1998-03-06 SL Baur <steve@altair.xemacs.org>
-
- * dumped-lisp.el: Don't dump cc-mode, it's broken for dumping.
-
-1998-01-24 SL Baur <steve@altair.xemacs.org>
-
- * Makefile (PACKAGE): Update to package standard 1.0.
-
-1998-01-04 SL Baur <steve@altair.xemacs.org>
-
- * dumped-lisp.el: New file from standard dumped-lisp.el.
-
-1997-12-24 SL Baur <steve@altair.xemacs.org>
-
- * Makefile: Created.
-
+++ /dev/null
-# 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 <xemacs-beta@xemacs.org>
-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
+++ /dev/null
-### Makefile --- The makefile to build EOS
-
-## Copyright (C) 1995 Sun Microsystems, Inc.
-
-## Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-## Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-## 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
+++ /dev/null
-;;; 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 <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; 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
+++ /dev/null
-(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
-))
+++ /dev/null
-;; 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: %s>" (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)
- )
-
-\f
-;;; 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
+++ /dev/null
-;;; sun-eos-browser.el --- Implements the XEmacs/SPARCworks SourceBrowser interface
-
-;; Copyright (C) 1995 Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; 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
+++ /dev/null
-;; 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)
+++ /dev/null
-;;; sun-eos-debugger.el --- Implements the XEmacs/SPARCworks Debugger interface
-
-;; Copyright (C) Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; 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 <CR>
- ))
- (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 <CR>
- ))
- (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
- ))
-\f
-
-;; (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)
- ))
-
-\f
-;; 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)
- )))
-
-\f
-;;
-;; 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")))
-
-\f
-;;
-;; 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))
-
-\f
-;;
-;;
-;; 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)
- ))
-
-\f
-;; 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
+++ /dev/null
-;;; sun-eos-debugger.el --- Implements the XEmacs/SPARCworks interface
-
-;; Copyright (C) 1995 Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; 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
+++ /dev/null
-;;; sun-eos-editor.el --- Implements the XEmacs/SPARCworks editor protocol
-
-;; Copyright (C) 1995 Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; 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
+++ /dev/null
-;;; sun-eos-init.el --- Initializes the XEmacs/SPARCworks interface
-
-;; Copyright (C) 1996 Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; 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
+++ /dev/null
-;;; sun-eos-load.el --- Loads the XEmacs/SPARCworks interface code
-
-;; Copyright (C) 1995 Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; 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
+++ /dev/null
-;;; sun-eos-menu.el --- Implements the XEmacs/SPARCworks menubar
-
-;; Copyright (C) 1995 Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; 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 <Ctrl> Step
-Fix Dismiss Clear <Shft> 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
+++ /dev/null
-;;; sun-eos-toolbar.el --- Implements the EOS toolbar interface
-
-;; Copyright (C) Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; 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
+++ /dev/null
-;;; sun-eos.el --- Intereactively loads the XEmacs/SPARCworks interface
-
-;; Copyright (C) 1995 Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; 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
+++ /dev/null
-;;; 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)
+++ /dev/null
-;;; 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)))
+++ /dev/null
-;;; sunpro-menubar.el --- Initialize the SunPro menubar
-
-;; Copyright (C) 1993, 1994 Sun Microsystems, Inc
-
-;; Author: Aaron Endelman <endelman@Eng.Sun.COM>
-;; Maintainer: Vladimir Ivanovic <vladimir@Eng.Sun.COM>
-;; 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
+++ /dev/null
-;;; sunpro-sparcworks.el --- support SPARCworks manager ToolTalk messages
-
-;; Copyright (C) Sun Microsystems, Inc.
-
-;; Author: Vladimir Ivanovic <vladimir@Eng.Sun.COM>
-;; Maintainer: Vladimir Ivanovic <vladimir@Eng.Sun.COM>
-;; 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
-