home *** CD-ROM | disk | FTP | other *** search
- Newsgroups: comp.sources.misc
- From: sbo@vlsi.polymtl.ca (Stephane Boucher)
- Subject: v31i062: bam - [OpenLook|Athena] menu system for [GNU|Epoch|Lucid] Emacs, Part06/07
- Message-ID: <1992Jul31.042613.23933@sparky.imd.sterling.com>
- X-Md4-Signature: bc9f911afe699f13f9213f09b8f788c1
- Date: Fri, 31 Jul 1992 04:26:13 GMT
- Approved: kent@sparky.imd.sterling.com
-
- Submitted-by: sbo@vlsi.polymtl.ca (Stephane Boucher)
- Posting-number: Volume 31, Issue 62
- Archive-name: bam/part06
- Environment: Lex, Yacc, SunOS 4.x with XView or BSD Unix with Athena Widget
- Supersedes: bam: Volume 27, Issue 68-69
-
- #! /bin/sh
- # This is a shell archive. Remove anything before this line, then unpack
- # it by saving it into a file and typing "sh file". To overwrite existing
- # files, type "sh file -c". You can also feed this as standard input via
- # unshar, or by typing "sh <file", e.g.. If this archive is complete, you
- # will see the following message at the end:
- # "End of archive 6 (of 7)."
- # Contents: bam-2.0/COPYING bam-2.0/bam.el
- # Wrapped by sbo@froh on Mon Jul 27 20:11:50 1992
- PATH=/bin:/usr/bin:/usr/ucb ; export PATH
- if test -f 'bam-2.0/COPYING' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'bam-2.0/COPYING'\"
- else
- echo shar: Extracting \"'bam-2.0/COPYING'\" \(12473 characters\)
- sed "s/^X//" >'bam-2.0/COPYING' <<'END_OF_FILE'
- X
- X GNU GENERAL PUBLIC LICENSE
- X Version 1, February 1989
- X
- X Copyright (C) 1989 Free Software Foundation, Inc.
- X 675 Mass Ave, Cambridge, MA 02139, USA
- X Everyone is permitted to copy and distribute verbatim copies
- X of this license document, but changing it is not allowed.
- X
- X Preamble
- X
- X The license agreements of most software companies try to keep users
- Xat the mercy of those companies. By contrast, our General Public
- XLicense is intended to guarantee your freedom to share and change free
- Xsoftware--to make sure the software is free for all its users. The
- XGeneral Public License applies to the Free Software Foundation's
- Xsoftware and to any other program whose authors commit to using it.
- XYou can use it for your programs, too.
- X
- X When we speak of free software, we are referring to freedom, not
- Xprice. Specifically, the General Public License is designed to make
- Xsure that you have the freedom to give away or sell copies of free
- Xsoftware, that you receive source code or can get it if you want it,
- Xthat you can change the software or use pieces of it in new free
- Xprograms; and that you know you can do these things.
- X
- X To protect your rights, we need to make restrictions that forbid
- Xanyone to deny you these rights or to ask you to surrender the rights.
- XThese restrictions translate to certain responsibilities for you if you
- Xdistribute copies of the software, or if you modify it.
- X
- X For example, if you distribute copies of a such a program, whether
- Xgratis or for a fee, you must give the recipients all the rights that
- Xyou have. You must make sure that they, too, receive or can get the
- Xsource code. And you must tell them their rights.
- X
- X We protect your rights with two steps: (1) copyright the software, and
- X(2) offer you this license which gives you legal permission to copy,
- Xdistribute and/or modify the software.
- X
- X Also, for each author's protection and ours, we want to make certain
- Xthat everyone understands that there is no warranty for this free
- Xsoftware. If the software is modified by someone else and passed on, we
- Xwant its recipients to know that what they have is not the original, so
- Xthat any problems introduced by others will not reflect on the original
- Xauthors' reputations.
- X
- X The precise terms and conditions for copying, distribution and
- Xmodification follow.
- X
- X GNU GENERAL PUBLIC LICENSE
- X TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
- X
- X 0. This License Agreement applies to any program or other work which
- Xcontains a notice placed by the copyright holder saying it may be
- Xdistributed under the terms of this General Public License. The
- X"Program", below, refers to any such program or work, and a "work based
- Xon the Program" means either the Program or any work containing the
- XProgram or a portion of it, either verbatim or with modifications. Each
- Xlicensee is addressed as "you".
- X
- X 1. You may copy and distribute verbatim copies of the Program's source
- Xcode as you receive it, in any medium, provided that you conspicuously and
- Xappropriately publish on each copy an appropriate copyright notice and
- Xdisclaimer of warranty; keep intact all the notices that refer to this
- XGeneral Public License and to the absence of any warranty; and give any
- Xother recipients of the Program a copy of this General Public License
- Xalong with the Program. You may charge a fee for the physical act of
- Xtransferring a copy.
- X
- X 2. You may modify your copy or copies of the Program or any portion of
- Xit, and copy and distribute such modifications under the terms of Paragraph
- X1 above, provided that you also do the following:
- X
- X a) cause the modified files to carry prominent notices stating that
- X you changed the files and the date of any change; and
- X
- X b) cause the whole of any work that you distribute or publish, that
- X in whole or in part contains the Program or any part thereof, either
- X with or without modifications, to be licensed at no charge to all
- X third parties under the terms of this General Public License (except
- X that you may choose to grant warranty protection to some or all
- X third parties, at your option).
- X
- X c) If the modified program normally reads commands interactively when
- X run, you must cause it, when started running for such interactive use
- X in the simplest and most usual way, to print or display an
- X announcement including an appropriate copyright notice and a notice
- X that there is no warranty (or else, saying that you provide a
- X warranty) and that users may redistribute the program under these
- X conditions, and telling the user how to view a copy of this General
- X Public License.
- X
- X d) You may charge a fee for the physical act of transferring a
- X copy, and you may at your option offer warranty protection in
- X exchange for a fee.
- X
- XMere aggregation of another independent work with the Program (or its
- Xderivative) on a volume of a storage or distribution medium does not bring
- Xthe other work under the scope of these terms.
- X
- X 3. You may copy and distribute the Program (or a portion or derivative of
- Xit, under Paragraph 2) in object code or executable form under the terms of
- XParagraphs 1 and 2 above provided that you also do one of the following:
- X
- X a) accompany it with the complete corresponding machine-readable
- X source code, which must be distributed under the terms of
- X Paragraphs 1 and 2 above; or,
- X
- X b) accompany it with a written offer, valid for at least three
- X years, to give any third party free (except for a nominal charge
- X for the cost of distribution) a complete machine-readable copy of the
- X corresponding source code, to be distributed under the terms of
- X Paragraphs 1 and 2 above; or,
- X
- X c) accompany it with the information you received as to where the
- X corresponding source code may be obtained. (This alternative is
- X allowed only for noncommercial distribution and only if you
- X received the program in object code or executable form alone.)
- X
- XSource code for a work means the preferred form of the work for making
- Xmodifications to it. For an executable file, complete source code means
- Xall the source code for all modules it contains; but, as a special
- Xexception, it need not include source code for modules which are standard
- Xlibraries that accompany the operating system on which the executable
- Xfile runs, or for standard header files or definitions files that
- Xaccompany that operating system.
- X
- X 4. You may not copy, modify, sublicense, distribute or transfer the
- XProgram except as expressly provided under this General Public License.
- XAny attempt otherwise to copy, modify, sublicense, distribute or transfer
- Xthe Program is void, and will automatically terminate your rights to use
- Xthe Program under this License. However, parties who have received
- Xcopies, or rights to use copies, from you under this General Public
- XLicense will not have their licenses terminated so long as such parties
- Xremain in full compliance.
- X
- X 5. By copying, distributing or modifying the Program (or any work based
- Xon the Program) you indicate your acceptance of this license to do so,
- Xand all its terms and conditions.
- X
- X 6. Each time you redistribute the Program (or any work based on the
- XProgram), the recipient automatically receives a license from the original
- Xlicensor to copy, distribute or modify the Program subject to these
- Xterms and conditions. You may not impose any further restrictions on the
- Xrecipients' exercise of the rights granted herein.
- X
- X 7. The Free Software Foundation may publish revised and/or new versions
- Xof the General Public License from time to time. Such new versions will
- Xbe similar in spirit to the present version, but may differ in detail to
- Xaddress new problems or concerns.
- X
- XEach version is given a distinguishing version number. If the Program
- Xspecifies a version number of the license which applies to it and "any
- Xlater version", you have the option of following the terms and conditions
- Xeither of that version or of any later version published by the Free
- XSoftware Foundation. If the Program does not specify a version number of
- Xthe license, you may choose any version ever published by the Free Software
- XFoundation.
- X
- X 8. If you wish to incorporate parts of the Program into other free
- Xprograms whose distribution conditions are different, write to the author
- Xto ask for permission. For software which is copyrighted by the Free
- XSoftware Foundation, write to the Free Software Foundation; we sometimes
- Xmake exceptions for this. Our decision will be guided by the two goals
- Xof preserving the free status of all derivatives of our free software and
- Xof promoting the sharing and reuse of software generally.
- X
- X NO WARRANTY
- X
- X 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
- XFOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
- XOTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
- XPROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
- XOR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
- XMERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
- XTO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
- XPROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
- XREPAIR OR CORRECTION.
- X
- X 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
- XWILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
- XREDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
- XINCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
- XOUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
- XTO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
- XYOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
- XPROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
- XPOSSIBILITY OF SUCH DAMAGES.
- X
- X END OF TERMS AND CONDITIONS
- X
- X Appendix: How to Apply These Terms to Your New Programs
- X
- X If you develop a new program, and you want it to be of the greatest
- Xpossible use to humanity, the best way to achieve this is to make it
- Xfree software which everyone can redistribute and change under these
- Xterms.
- X
- X To do so, attach the following notices to the program. It is safest to
- Xattach them to the start of each source file to most effectively convey
- Xthe exclusion of warranty; and each file should have at least the
- X"copyright" line and a pointer to where the full notice is found.
- X
- X <one line to give the program's name and a brief idea of what it does.>
- X Copyright (C) 19yy <name of author>
- X
- X This program is free software; you can redistribute it and/or modify
- X it under the terms of the GNU General Public License as published by
- X the Free Software Foundation; either version 1, or (at your option)
- X any later version.
- X
- X This program is distributed in the hope that it will be useful,
- X but WITHOUT ANY WARRANTY; without even the implied warranty of
- X MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- X GNU General Public License for more details.
- X
- X You should have received a copy of the GNU General Public License
- X along with this program; if not, write to the Free Software
- X Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- X
- XAlso add information on how to contact you by electronic and paper mail.
- X
- XIf the program is interactive, make it output a short notice like this
- Xwhen it starts in an interactive mode:
- X
- X Gnomovision version 69, Copyright (C) 19xx name of author
- X Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
- X This is free software, and you are welcome to redistribute it
- X under certain conditions; type `show c' for details.
- X
- XThe hypothetical commands `show w' and `show c' should show the
- Xappropriate parts of the General Public License. Of course, the
- Xcommands you use may be called something other than `show w' and `show
- Xc'; they could even be mouse-clicks or menu items--whatever suits your
- Xprogram.
- X
- XYou should also get your employer (if you work as a programmer) or your
- Xschool, if any, to sign a "copyright disclaimer" for the program, if
- Xnecessary. Here a sample; alter the names:
- X
- X Yoyodyne, Inc., hereby disclaims all copyright interest in the
- X program `Gnomovision' (a program to direct compilers to make passes
- X at assemblers) written by James Hacker.
- X
- X <signature of Ty Coon>, 1 April 1989
- X Ty Coon, President of Vice
- X
- XThat's all there is to it!
- END_OF_FILE
- if test 12473 -ne `wc -c <'bam-2.0/COPYING'`; then
- echo shar: \"'bam-2.0/COPYING'\" unpacked with wrong size!
- fi
- # end of 'bam-2.0/COPYING'
- fi
- if test -f 'bam-2.0/bam.el' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'bam-2.0/bam.el'\"
- else
- echo shar: Extracting \"'bam-2.0/bam.el'\" \(12774 characters\)
- sed "s/^X//" >'bam-2.0/bam.el' <<'END_OF_FILE'
- X; bam - the Born Again Menus for GNU Emacs.
- X; Copyright (C) 1992 Stephane Boucher, Hans Olsson.
- X;
- X; This program is free software; you can redistribute it and/or modify
- X; it under the terms of the GNU General Public License as published by
- X; the Free Software Foundation; either version 1, or (at your option)
- X; any later version.
- X;
- X; This program is distributed in the hope that it will be useful,
- X; but WITHOUT ANY WARRANTY; without even the implied warranty of
- X; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- X; GNU General Public License for more details.
- X;
- X; You should have received a copy of the GNU General Public License
- X; along with this program; if not, write to the Free Software
- X; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- X;
- X; In other words, you are welcome to use, share and improve this program.
- X; You are forbidden to forbid anyone else to use, share and improve
- X; what you give them. Help stamp out software-hoarding!
- X
- X;;; $Id: bam.el,v 1.11 1992/07/27 23:06:26 sbo Exp $
- X
- X(require 'command-process)
- X
- X(load-library "bytecomp")
- X(require 'bam-defaults)
- X
- X(defun y-or-n-p (str)
- X "A better y-or-n-p (oh well the other crashed...)"
- X; To test if you need this:
- X; 0: Comment out this function
- X; 1: save a file
- X; 2: change it(do not save it)
- X; 3: choose Quit in the menu
- X; 4: Press control-g as answer.
- X; 5: If emacs beeps unstoppably you'll need this.
- X;
- X (interactive)
- X (message str)
- X (defun again ()
- X (let ((the-character-in-my-y-or-n-p (read-char)))
- X (cond ((or
- X (= the-character-in-my-y-or-n-p ?\ )
- X (= the-character-in-my-y-or-n-p ?y )) t)
- X ((or
- X (= the-character-in-my-y-or-n-p ?n)
- X (= the-character-in-my-y-or-n-p ?\C-g )
- X (= the-character-in-my-y-or-n-p ?\^? )) '())
- X (t (again)))))
- X (again))
- X
- X;;;
- X;;; Manipulations of command line args
- X;;;
- X(setq command-switch-alist
- X (append
- X '(("-bam" . bam-menu-mode))
- X command-switch-alist))
- X
- X(defun bam-menu-mode (arg)
- X "Loads the next argument with menus"
- X (interactive)
- X (if (not (null command-line-args-left))
- X (progn
- X (bam-load-menu (car command-line-args-left))
- X (bam-open-menu (car command-line-args-left))
- X (setq command-line-args-left (cdr command-line-args-left)))))
- X;;;-------------------------------------
- X
- X(defun bam-font-option (font)
- X "Returns options suitable for setting a font"
- X (cond
- X ((string= bam-widget "ATHENA")
- X (list "-font" font))
- X ((string= bam-widget "XVIEW")
- X (list "-Wt" font))
- X (t
- X (error "Unknown widget toolkit %s" bam-widget))))
- X
- X(defun bam-geometry-option (x y w h &optional grab)
- X "Returns options suitable for the specified geometry.
- XIf the optional argument grab is true, the options
- Xwill make bam grab the emacs window."
- X (cond
- X ((string= bam-widget "XVIEW")
- X (list "-Wp" (int-to-string x) (int-to-string y) "-Ws"
- X (int-to-string w) (int-to-string h)))
- X ((string= bam-widget "ATHENA")
- X (if (and (not (null grab)) (not (null bam-window-name)))
- X (list "-geometry" "482x314+1000+1000" "-w" bam-window-name)
- X (list "-geometry"
- X (concat (int-to-string w) "x" (int-to-string h) "+"
- X (int-to-string x) "+" (int-to-string y)))))
- X (t
- X (error "Unknown widget toolkit %s" bam-widget))))
- X
- X(defun bam-grab-option ()
- X "Returns options that makes bam grab the emacs"
- X (if (and (string= bam-widget "ATHENA")
- X (not (null bam-window-name)))
- X (list "-w" bam-window-name)
- X (list )))
- X
- X(defun bam-after (opt li)
- X "Returns the argument after opt in li"
- X (cond
- X ((null li) nil)
- X ((equal opt (car li)) (car (cdr li)))
- X ('t (bam-after opt (cdr li)))))
- X
- X(setq bam-window-name (bam-after "-wn" command-line-args))
- X
- X(defvar bam-menus-list '()
- X "List of menus and their respective properties.
- XThe structure for each menu is:
- X (menu-name menu-dir menu-args menu-process)
- XWhere menu-name and menu-dir are strings, and menu-args is a list of
- Xarguments to pass to bam. menu-process indicate the current process
- Xfor this menu.")
- X
- X(defun bam-set-menu-dir (menu-name menu-dir)
- X "Sets the menu directory where the files menu-name.el and menu-name are
- Xlocated. Returns t if the menu exists and nil if it does not exist."
- X (interactive "sBam menu name: \nDBam menu directory: ")
- X (let ((menu (assoc menu-name bam-menus-list)))
- X (if menu
- X (prog1 t
- X (setcar (nthcdr 1 menu)
- X ;; Remove the traling '/', if any.
- X (if (string= (substring menu-dir -1) "/")
- X (substring menu-dir 0 -1)
- X (concat menu-dir))))
- X nil)))
- X
- X
- X(defun bam-get-menu-dir (menu-name)
- X "Gets the menu directory corresponding to the menu named menu-name.
- XReturn nil if the menu does not exist."
- X (interactive "sBam menu name: ")
- X (let ((menu (assoc menu-name bam-menus-list)))
- X (if menu
- X (progn
- X (if (interactive-p)
- X (message (car (nthcdr 1 menu))))
- X (concat (car (nthcdr 1 menu))))
- X (prog1 nil
- X (if (interactive-p)
- X (message (concat "Bam menu \"" menu-name "\" was not found.")))))))
- X
- X
- X(defun bam-set-menu-args (menu-name &optional args)
- X "Sets the arguments to be passed to Bam for the given menu.
- Xmenu-name. Return t if the menu exists, nil otherwise."
- X (interactive "sBam menu name: \nLBam menu args list: ")
- X (let ((menu (assoc menu-name bam-menus-list)))
- X (if menu
- X ;; Menu was found.
- X (prog1 t
- X (setcar
- X (nthcdr 2 menu)
- X (if (and (not (null args)) (listp args))
- X (copy-sequence args)
- X (append
- X (bam-font-option "7x14") ; font
- X (bam-geometry-option 0 0 1000 300)) ; Position, size
- X )))
- X (prog1 nil
- X (if (interactive-p)
- X (message "Bam menu \"" menu-name "\" was not found"))))))
- X
- X(defun bam-set-menu-process (menu-name &optional menu-process)
- X "Store the process handle for menu-name in the menu's structure."
- X (let ((menu (assoc menu-name bam-menus-list)))
- X (if menu
- X ;; Menu was found.
- X (prog1 t
- X (setcar
- X (nthcdr 3 menu)
- X (if (and menu-process
- X (processp menu-process)
- X (eq (process-status menu-process) 'run))
- X menu-process
- X nil)))
- X nil)))
- X
- X
- X(defun bam-set-mode-hook (menu-name mode-hook-variable)
- X "Sets a mode hook that will cause the given menu to be openned.
- XThe hook will cause the specified menu (menu-name) to be openned
- Xwhen a given emacs mode is activated."
- X (if (not (boundp mode-hook-variable))
- X (set-variable mode-hook-variable nil))
- X (cond
- X ;; No hook functions
- X ((equal (eval mode-hook-variable) nil)
- X (set-variable mode-hook-variable
- X (` (lambda () (bam-open-menu (, menu-name))))))
- X ;; List of hook functions
- X ((and (listp (eval mode-hook-variable))
- X (listp (car (eval mode-hook-variable))))
- X (set-variable mode-hook-variable
- X (cons (` (lambda () (bam-open-menu (, menu-name))))
- X (eval mode-hook-variable))))
- X ;; one hook function
- X ((listp (eval mode-hook-variable))
- X (set-variable mode-hook-variable
- X (cons (` (lambda () (bam-open-menu (, menu-name))))
- X (list (eval mode-hook-variable)))))
- X (t
- X (message (concat "Can't hook menu \"" menu-name "\" to "
- X (symbol-name mode-hook-variable)))
- X nil)))
- X
- X
- X(defun bam-get-menu-args (menu-name)
- X "Gets the args for the menu named menu-name. Return the list of args.
- XReturns nil if the menu was not found."
- X (interactive "sBam menu name: ")
- X (let ((menu (assoc menu-name bam-menus-list)))
- X (if menu
- X ;; Menu was found.
- X (copy-sequence (car (nthcdr 2 menu)))
- X (prog1 nil
- X (if (interactive-p)
- X (message "Bam menu \"" menu-name "\" was not found"))))))
- X
- X
- X(defun bam-get-menu-process (menu-name)
- X "Gets the process-handle for the menu named menu-name.
- XReturn the found handle."
- X (let ((menu (assoc menu-name bam-menus-list)))
- X (if menu
- X ;; Menu was found.
- X (car (nthcdr 3 menu))
- X nil)))
- X
- X;; Add the bam-exec-dir to the beginning of the list
- X;; exec-path, only if bam-exec-dir is not already in
- X;; exec-path.
- X;(let ((path exec-path)
- X; (path-found nil))
- X; (while (and (not path-found) path)
- X; (if (string= (car path) bam-exec-dir)
- X; (setq path-found t)
- X; (setq path (cdr path))))
- X; (if (not path-found)
- X; (setq exec-path (cons bam-exec-dir exec-path))))
- X
- X
- X(defun bam-load-menu (menu-name)
- X "Load the bam menu menu-name. This does not open the menu.
- XThe directory where the menu-name is located is determined,
- Xand then this menu is registered as being ready to be opened."
- X (interactive "sBam menu name: ")
- X (let ((path bam-menus-path))
- X (while path
- X (let ((menu-file-name (concat (car path) "/" menu-name)))
- X (if (and (file-exists-p menu-file-name)
- X (file-readable-p menu-file-name))
- X (prog1 t
- X (bam-add-menu-to-menu-list menu-name (car path))
- X (let ((elisp-menu-file-name
- X (concat menu-file-name ".el")))
- X (if (and (file-exists-p elisp-menu-file-name)
- X (file-readable-p elisp-menu-file-name))
- X (load-file elisp-menu-file-name)))
- X (message (concat "Bam menu \""
- X menu-name "\" successfully loaded.")))
- X (message (concat "Cannot locate the \""
- X menu-name "\" menu"))))
- X (setq path (cdr path)))))
- X
- X
- X(defun bam-elisp-to-unix-path (path-list)
- X "Convert a path in the form of a list to a path in the form of a unix path
- Xe.g. (\"path1\" \"path2\" \"path3\") to \"path1:path2:path3\"."
- X (let ((path path-list) (full-path ""))
- X (while path
- X (if (string= full-path "")
- X (setq full-path (car path))
- X (setq full-path (concat full-path ":" (car path))))
- X (setq path (cdr path)))
- X full-path))
- X
- X
- X(defun bam-add-menu-to-menu-list (menu-name menu-dir)
- X "Register the bam menu and save useful information about the menu. The
- Xlist as currently the format ((menu-name menu-dir) ...) where menu-dir
- Xis the directory where the files menu-name.el and menu-name are
- Xstored. menu-name and menu-dir are both string."
- X (let ((menu (assoc menu-name bam-menus-list)))
- X (if menu
- X ;; The menu was found in the list. Modify the stored information.
- X (progn
- X (bam-set-menu-dir menu-name menu-dir)
- X (bam-set-menu-args menu-name)
- X (message (concat "Bam menu \"" menu-name "\" replaced")))
- X
- X ;; The menu was not found in the list. Add it to the list.
- X (progn
- X (setq bam-menus-list
- X (cons (` ((, menu-name) nil nil nil))
- X bam-menus-list))
- X (bam-set-menu-dir menu-name menu-dir)
- X (bam-set-menu-args menu-name)
- X; (bam-set-menu-process nil)
- X (message (concat "Bam menu \"" menu-name "\" added"))))))
- X
- X(defun bam-expand-lists-to-strings (args)
- X "Recursively parse args to generate a list of strings."
- X (if (listp args)
- X (let ((sub-args args)
- X (new-list '())
- X (car-arg nil))
- X (while sub-args
- X (setq car-arg (car sub-args))
- X (cond ((stringp car-arg)
- X (setq new-list (append new-list (list car-arg))))
- X ((integerp car-arg)
- X (setq new-list
- X (append new-list (list (int-to-string car-arg)))))
- X ((symbolp car-arg)
- X (setq new-list
- X (append new-list (list (symbol-name car-arg)))))
- X ((listp car-arg)
- X (setq new-list
- X (append new-list
- X (bam-expand-lists-to-strings car-arg))))
- X ((null car-arg) )
- X (t
- X (progn
- X (error "Wrong type argument type " (car-arg))
- X (setq sub-args nil))))
- X (setq sub-args (cdr sub-args)))
- X new-list)
- X (error "args must be a list")))
- X
- X
- X(defun bam-open-menu (menu-name &rest bam-args)
- X "Open the menu specified by menu-name, passing bam-args to the bam menu.
- XIf the menu is already opened, no additional menu of the same name is
- Xopened. bam-args is not allowed in interactive mode."
- X;;; (interactive "sBam Menu Name: \nxBam Arguments (surrounded by paran): ")
- X (interactive "sBam Menu Name: ")
- X (let ((menu (assoc menu-name bam-menus-list)))
- X ;; The menu exist. Try to start it.
- X (if menu
- X ;; If the menu process is not already running, start a process
- X (let ((p (bam-get-menu-process menu-name)))
- X (if (or (not (processp p))
- X (not (eq (process-status (process-name p)) 'run)))
- X (progn
- X (bam-set-menu-process
- X menu-name
- X (apply 'command-process
- X (concat bam-exec-dir "/bam")
- X (bam-expand-lists-to-strings
- X (append
- X (list '-B (bam-elisp-to-unix-path bam-bitmaps-path))
- X (bam-get-menu-args menu-name)
- X bam-args
- X (list
- X (concat (bam-get-menu-dir menu-name)
- X "/" menu-name))))))
- X (process-kill-without-query (bam-get-menu-process menu-name)))))
- X
- X ;; The menu does not exist.
- X (message
- X (concat "The bam menu \"" menu-name "\" is not in the menu list")))))
- X
- X(defun strings-to-buffer (string1 string2)
- X "*Inserts STRING1 and STRING2 in current buffer, puts point after STRING1."
- X (insert string1)
- X (let ((newpoint (point)))
- X (insert string2)
- X (goto-char newpoint)))
- X
- X(byte-compile (function strings-to-buffer))
- X
- X(provide 'bam)
- X
- X
- END_OF_FILE
- if test 12774 -ne `wc -c <'bam-2.0/bam.el'`; then
- echo shar: \"'bam-2.0/bam.el'\" unpacked with wrong size!
- fi
- # end of 'bam-2.0/bam.el'
- fi
- echo shar: End of archive 6 \(of 7\).
- cp /dev/null ark6isdone
- MISSING=""
- for I in 1 2 3 4 5 6 7 ; do
- if test ! -f ark${I}isdone ; then
- MISSING="${MISSING} ${I}"
- fi
- done
- if test "${MISSING}" = "" ; then
- echo You have unpacked all 7 archives.
- rm -f ark[1-9]isdone
- else
- echo You still need to unpack the following archives:
- echo " " ${MISSING}
- fi
- ## End of shell archive.
- exit 0
-
- exit 0 # Just in case...
-