home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / sunpro / sunpro-menubar.el < prev    next >
Encoding:
Text File  |  1995-06-16  |  6.9 KB  |  237 lines
  1. ;;; sunpro-menubar.el --- Initialize the SunPro menubar
  2.  
  3. ;; Copyright (C) 1993, 1994 Sun Microsystems, Inc
  4.  
  5. ;; Author:    Aaron Endelman <endelman@Eng.Sun.COM>
  6. ;; Maintainer:    Vladimir Ivanovic <vladimir@Eng.Sun.COM>
  7. ;; Created:    93/09/13 15:16:24
  8. ;; Version:    1.7
  9. ;; Header:    @(#) sunpro-menubar.el: v1.7 95/06/15 19:02:09
  10.  
  11. ;; Keywords:    SunPro menubar initialization
  12.  
  13. ;;; Commentary:
  14. ;;  Creates the default SunPro menubars.
  15.  
  16. ;;; To Do:
  17.  
  18. ;;; Code:
  19.  
  20. (defconst sunpro-menubar
  21.  (purecopy-menubar            ;the simple, new user menubar
  22.   (list
  23.    '("File"
  24.      ["New"            sunpro-new-buffer       t]
  25.      ["Open:"            find-file            t]
  26.      ["Include File:"        insert-file        t]
  27.      "-----"
  28.      ["Save"            save-buffer        t nil]
  29.      ["Save As:"        write-file        t]
  30.      ["Revert..."        revert-buffer        t nil]
  31.      "-----"
  32.      ["Print"                lpr-buffer        t nil]
  33.      "-----"
  34.      ["Close"                delete-frame        t]
  35.      ["Exit XEmacs"        save-buffers-kill-emacs    t]
  36.      )
  37.    
  38.    '("Edit"
  39.      ["Undo"            advertised-undo        t]
  40.      "-----"
  41.      ["Cut"            x-kill-primary-selection   t]
  42.      ["Copy"            x-copy-primary-selection   t]
  43.      ["Paste"            x-yank-clipboard-selection t]
  44.      ["Delete"            x-delete-primary-selection t]
  45.      "-----"
  46.      ["Select Block"        mark-paragraph         t]
  47.      ["Select All"        mark-whole-buffer    t]
  48.      )
  49.    
  50.    '("View"
  51.      ["New View"                make-frame             t]
  52.      "-----"
  53.      ["Split Window"        (split-window)        t]
  54.      ["Unsplit Window"        delete-other-windows    t]
  55.      ["Close Buffer"        (kill-buffer nil)    t nil]
  56.      "-----! before list all buffers"
  57.      ["List All Buffers"     list-buffers        t]
  58.      )
  59.      
  60.    '("Find"
  61.      ["Forward:"        sunpro-search-forward    t]
  62.      ["Backward:"        sunpro-search-backward    t]
  63.      ["And Replace:"        sunpro-query-replace    t]
  64.      )
  65.  
  66.    ;; Copy the options menu from the default menubar
  67.   (car (find-menu-item default-menubar '("Options")))
  68.  
  69.    '("Utilities"
  70.      ["Cancel Command"        (keyboard-quit)    t]
  71.      "-----"
  72.      ["Execute Macro"        call-last-kbd-macro last-kbd-macro]
  73.      ["Start Macro Recording"    start-kbd-macro     (not defining-kbd-macro)]
  74.      ["End Macro Recording"    end-kbd-macro        defining-kbd-macro]
  75.      "-----"
  76.      ["Spell"        ispell-buffer    t]
  77.      ["Sort"        sort-lines    t]
  78.      "-----"
  79.      ["Format Paragraph  "    fill-paragraph    t]
  80.      "-----"
  81.      ["Goto Line:"        goto-line    t]
  82.      )
  83.    
  84.    ;; the following is supposed to be here!  It ensures that the
  85.    ;; Help item is always the rightmost item.
  86.  
  87.     nil        ; the partition: menus after this are flushright
  88.  
  89.     '("Help"    ["About XEmacs..."    about-xemacs        t]
  90.         "-----"
  91.         ["XEmacs WWW Page"    xemacs-www-page        t]
  92.         ["XEmacs FAQ via WWW"    xemacs-www-faq        t]
  93.         "-----"
  94.         ["Info"            info            t]
  95.         ["Describe Mode"    describe-mode        t]
  96.          ["Hyper Apropos..."    hyper-apropos        t]
  97.         ["Command Apropos..."    command-apropos        t]
  98.         ["Full Apropos..."    apropos            t]
  99.         ["List Keybindings"    describe-bindings    t]
  100.         ["Describe Key..."    describe-key        t]
  101.         ["Describe Function..."    describe-function    t]
  102.         ["Describe Variable..."    describe-variable    t]
  103.         "-----"
  104.         ["Unix Manual..."    manual-entry        t]
  105.         ["XEmacs Tutorial"    help-with-tutorial    t]
  106.         ["XEmacs News"        view-emacs-news        t]
  107.         ))))
  108.  
  109. (set-menubar sunpro-menubar)
  110.  
  111. (defconst programmer-menu '(["Programmer Menus" 
  112.                  (toggle-programmer-menus) 
  113.                  :style toggle 
  114.                  :selected programmer-menus-p]
  115.                 ["-----! before save options" nil t]))
  116. (setq save-options-menu-item
  117.       (car (find-menu-item default-menubar '("Options" "Save Options"))))
  118. (delete-menu-item '("Options" "Save Options"))
  119. (add-menu () "Options" (append 
  120.              (cdr (car
  121.                    (find-menu-item default-menubar '("Options"))))
  122.              programmer-menu
  123.              (list save-options-menu-item)))
  124.  
  125. ;;;
  126. ;;; helper commands
  127. ;;;
  128.  
  129. (defun sunpro-new-buffer ()
  130.   (interactive)
  131.   (switch-to-buffer (generate-new-buffer "Untitled")))
  132.  
  133. (defun sunpro-new-window ()
  134.   (interactive)
  135.   (switch-to-buffer-other-frame (generate-new-buffer "Untitled")))
  136.  
  137. (defun sunpro-clone-buffer ()
  138.   (interactive)
  139.     (let
  140.     ((old (current-buffer)))
  141.       (switch-to-buffer (generate-new-buffer (buffer-name old)))
  142.     (insert-buffer old)))
  143.  
  144. (defun sunpro-search-forward ()
  145.   (interactive)
  146.   (if isearch-mode (isearch-repeat-forward)
  147.     (x-isearch-maybe-with-region)))
  148.  
  149. (defun sunpro-search-backward ()
  150.   (interactive)
  151.   (if isearch-mode (isearch-repeat-backward)
  152.     (x-isearch-maybe-with-region t)))
  153.  
  154. (put 'sunpro-search-forward 'isearch-command t)
  155. (put 'sunpro-search-backward 'isearch-command t)
  156.  
  157. (defun sunpro-query-replace ()
  158.   (interactive)
  159.   (call-interactively 'query-replace))
  160.  
  161. (defun sunpro-menu-quit ()
  162.   "Abort minibuffer input if any."
  163.   (while (not (zerop (minibuffer-depth)))
  164.     (abort-recursive-edit)))
  165.  
  166. (defvar programmer-menus-p nil)
  167. (defvar sccs-or-vc-menus 'sccs
  168.   "Choose to use the SCCS or the VC menu.")
  169.  
  170. (defun toggle-programmer-menus ()
  171.   (interactive)
  172.   (if programmer-menus-p
  173.       (progn
  174.     (if (equal sccs-or-vc-menus 'sccs)
  175.         (delete-menu-item '("SCCS"))
  176.       (delete-menu-item '("VC")))
  177.     (delete-menu-item '("SPARCworks"))
  178.     (delete-menu-item '("Options" "SPARCworks"))
  179.     (delete-menu-item '("Options" "-----! before save options"))
  180.     (delete-menu-item '("Help" "SPARCworks"))
  181.     (setq programmer-menus-p nil))
  182.     (progn
  183.       (require 'eos-load "sun-eos-load")
  184.       (eos::start)
  185.       (if (equal sccs-or-vc-menus 'sccs)
  186.       (progn
  187.         (delete-menu-item '("VC"))
  188.         (require 'sccs)
  189.         (add-menu '() "SCCS" (cdr sccs-menu)))
  190.     (progn
  191.       (require 'vc)
  192.       (delete-menu-item '("SCCS"))
  193.       (add-menu '() "VC" vc-default-menu)))
  194.       (setq programmer-menus-p t))))
  195.  
  196. (defun sunpro-build-buffers-menu-hook ()
  197.   "For use as a value of activate-menubar-hook.
  198. This function changes the contents of the \"View\" menu to add
  199. at the end the current set of buffers.  Only the most-recently-used few buffers
  200. will be listed on the menu, for efficiency reasons.  You can control how
  201. many buffers will be shown by setting `buffers-menu-max-size'.
  202. You can control the text of the menu items by redefining the function
  203. `format-buffers-menu-line'."
  204.   (let ((buffer-menu (car (find-menu-item current-menubar '("View"))))
  205.     buffers)
  206.     (if (not buffer-menu)
  207.     nil
  208.       (setq buffer-menu (cdr buffer-menu))
  209.       (setq buffers (buffer-list))
  210.  
  211.       (if (and (integerp buffers-menu-max-size)
  212.            (> buffers-menu-max-size 1))
  213.       (if (> (length buffers) buffers-menu-max-size)
  214.           (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
  215.  
  216.       (setq buffers (build-buffers-menu-internal buffers))
  217.       (setq buffers (append (delq nil buffers)))
  218.       ;; slightly (only slightly) more efficient to not install the menubar
  219.       ;; if it hasn't visibly changed.
  220.       (let ((tail (member "-----! before list all buffers" (cdr buffer-menu)))
  221.         )
  222.     (if tail
  223.         (if (equal buffers (cdr tail))
  224.         t  ; return t meaning "no change"
  225.           (setcdr tail buffers)
  226.           nil)
  227.       ;; only the first time
  228.       (add-menu nil "View" (append buffer-menu
  229.                       '("-----! before list all buffers")
  230.                       buffers))
  231.       nil
  232.       )))))
  233.  
  234. (add-hook 'activate-menubar-hook 'sunpro-build-buffers-menu-hook)
  235.  
  236. ;;; sunpro-menubar.el ends here
  237.