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 / x11 / x-toolbar.el < prev    next >
Encoding:
Text File  |  1995-08-29  |  13.8 KB  |  391 lines
  1. ;; Toolbar support for X.
  2. ;; Copyright (C) 1994 Andy Piper <andyp@parallax.demon.co.uk>
  3. ;; Copyright (C) 1995 Board of Trustees, University of Illinois
  4.  
  5. ;; This file is part of XEmacs.
  6.  
  7. ;; XEmacs is free software; you can redistribute it and/or modify it
  8. ;; under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 2, or (at your option)
  10. ;; any later version.
  11.  
  12. ;; XEmacs is distributed in the hope that it will be useful, but
  13. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. ;; General Public License for more details.
  16.  
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  19. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21. ;; DO NOT attempt to dump this file.  It will cause the dump to die a
  22. ;; horrible death.
  23.  
  24. ;; x-init-toolbar-from-resources is defined in term/x-win.el
  25.  
  26. ;;
  27. ;; toolbar ispell variables and defuns
  28. ;;
  29.  
  30. (defun toolbar-ispell ()
  31.   "Intelligently spell the region or buffer."
  32.   (interactive)
  33.   (if (region-active-p)
  34.       (ispell-region (region-beginning) (region-end))
  35.     (ispell-buffer)))
  36.  
  37. ;;
  38. ;; toolbar mail variables and defuns
  39. ;;
  40.  
  41. (defvar toolbar-use-separate-mail-frame nil
  42.   "If non-nil run mail in a separate frame.")
  43.  
  44. (defvar toolbar-mail-frame nil
  45.   "The frame in which mail is displayed.")
  46.  
  47. (defvar toolbar-mail-command 'vm
  48.   "The mail reader to run.")
  49.  
  50. (defun toolbar-mail ()
  51.   "Run mail in a separate frame."
  52.   (interactive)
  53.   (if (not toolbar-use-separate-mail-frame)
  54.       (funcall toolbar-mail-command)
  55.     (if (or (not toolbar-mail-frame)
  56.         (not (frame-live-p toolbar-mail-frame)))
  57.     (progn
  58.       (setq toolbar-mail-frame (make-frame))
  59.       (add-hook 'vm-quit-hook
  60.             '(lambda ()
  61.                (save-excursion
  62.              (if (frame-live-p toolbar-mail-frame)
  63.                  (delete-frame toolbar-mail-frame)))))
  64.       (select-frame toolbar-mail-frame)
  65.       (raise-frame toolbar-mail-frame)
  66.       (funcall toolbar-mail-command)))
  67.     (if (frame-iconified-p toolbar-mail-frame)
  68.     (deiconify-frame toolbar-mail-frame))
  69.     (select-frame toolbar-mail-frame)
  70.     (raise-frame toolbar-mail-frame)))
  71.  
  72. ;;
  73. ;; toolbar info variables and defuns
  74. ;;
  75.  
  76. (defvar toolbar-info-frame nil
  77.   "The frame in which info is displayed.")
  78.  
  79. (defun toolbar-info ()
  80.   "Run info in a separate frame."
  81.   (interactive)
  82.   (if (or (not toolbar-info-frame)
  83.       (not (frame-live-p toolbar-info-frame)))
  84.       (progn
  85.     (setq toolbar-info-frame (make-frame))
  86.     (select-frame toolbar-info-frame)
  87.     (raise-frame toolbar-info-frame)))
  88.   (if (frame-iconified-p toolbar-info-frame)
  89.       (deiconify-frame toolbar-info-frame))
  90.   (select-frame toolbar-info-frame)
  91.   (raise-frame toolbar-info-frame)
  92.   (info))
  93.  
  94. ;;
  95. ;; toolbar debug variables and defuns
  96. ;;
  97.  
  98. (defun toolbar-debug ()
  99.   (interactive)
  100.   (require 'gdbsrc)
  101.   (call-interactively 'gdbsrc)
  102.   )
  103.  
  104. (defvar compile-command)
  105.  
  106. (defun toolbar-compile ()
  107.   "Run compile without having to touch the keyboard."
  108.   (interactive)
  109.   (require 'compile)
  110.   (popup-dialog-box
  111.    `(,(concat "Compile:\n        " compile-command)
  112.      ["Compile" (compile compile-command) t]
  113.      ["Edit command" compile t]
  114.      nil
  115.      ["Cancel" (message "Quit") t])))
  116.  
  117. ;;
  118. ;; toolbar news variables and defuns
  119. ;;
  120.  
  121. (defvar toolbar-news-frame nil
  122.   "The frame in which news is displayed.")
  123.  
  124. (defun toolbar-news ()
  125.   "Run GNUS in a separate frame."
  126.   (interactive)
  127.   (if (or (not toolbar-news-frame)
  128.       (not (frame-live-p toolbar-news-frame)))
  129.       (progn
  130.     (setq toolbar-news-frame (make-frame))
  131.     (add-hook 'gnus-exit-gnus-hook
  132.           '(lambda ()
  133.              (if (frame-live-p toolbar-news-frame)
  134.              (delete-frame toolbar-news-frame))))
  135.     (select-frame toolbar-news-frame)
  136.     (raise-frame toolbar-news-frame)
  137.     (gnus)))
  138.   (if (frame-iconified-p toolbar-news-frame)
  139.       (deiconify-frame toolbar-news-frame))
  140.   (select-frame toolbar-news-frame)
  141.   (raise-frame toolbar-news-frame))
  142.  
  143. (defvar toolbar-file-icon
  144.   (if (featurep 'xpm)
  145.       (toolbar-make-button-list
  146.        (expand-file-name "file-up.xpm" toolbar-icon-directory)
  147.        nil
  148.        (expand-file-name "file-xx.xpm" toolbar-icon-directory)
  149.        (expand-file-name "file-cap-up.xpm" toolbar-icon-directory)
  150.        nil
  151.        (expand-file-name "file-cap-xx.xpm" toolbar-icon-directory))
  152.     (toolbar-make-button-list
  153.      (expand-file-name "file-up.xbm" toolbar-icon-directory)
  154.      (expand-file-name "file-dn.xbm" toolbar-icon-directory)
  155.      (expand-file-name "file-xx.xbm" toolbar-icon-directory)))
  156.   "A file icon pair.")
  157.  
  158. (defvar toolbar-folder-icon
  159.   (if (featurep 'xpm)
  160.       (toolbar-make-button-list
  161.        (expand-file-name "folder-up.xpm" toolbar-icon-directory)
  162.        nil
  163.        (expand-file-name "folder-xx.xpm" toolbar-icon-directory)
  164.        (expand-file-name "folder-cap-up.xpm" toolbar-icon-directory)
  165.        nil
  166.        (expand-file-name "folder-cap-xx.xpm" toolbar-icon-directory))
  167.     (toolbar-make-button-list
  168.      (expand-file-name "folder-up.xbm" toolbar-icon-directory)
  169.      (expand-file-name "folder-dn.xbm" toolbar-icon-directory)
  170.      (expand-file-name "folder-xx.xbm" toolbar-icon-directory)))
  171.   "A folder icon pair")
  172.  
  173. (defvar toolbar-disk-icon
  174.   (if (featurep 'xpm)
  175.       (toolbar-make-button-list
  176.        (expand-file-name "disk-up.xpm" toolbar-icon-directory)
  177.        nil
  178.        (expand-file-name "disk-xx.xpm" toolbar-icon-directory)
  179.        (expand-file-name "disk-cap-up.xpm" toolbar-icon-directory)
  180.        nil
  181.        (expand-file-name "disk-cap-xx.xpm" toolbar-icon-directory))
  182.     (toolbar-make-button-list
  183.      (expand-file-name "disk-up.xbm" toolbar-icon-directory)
  184.      (expand-file-name "disk-dn.xbm" toolbar-icon-directory)
  185.      (expand-file-name "disk-xx.xbm" toolbar-icon-directory)))
  186.   "A disk icon pair.")
  187.  
  188. (defvar toolbar-printer-icon
  189.   (if (featurep 'xpm)
  190.       (toolbar-make-button-list
  191.        (expand-file-name "printer-up.xpm" toolbar-icon-directory)
  192.        nil
  193.        (expand-file-name "printer-xx.xpm" toolbar-icon-directory)
  194.        (expand-file-name "printer-cap-up.xpm" toolbar-icon-directory)
  195.        nil
  196.        (expand-file-name "printer-cap-xx.xpm" toolbar-icon-directory))
  197.     (toolbar-make-button-list
  198.      (expand-file-name "printer-up.xbm" toolbar-icon-directory)
  199.      (expand-file-name "printer-dn.xbm" toolbar-icon-directory)
  200.      (expand-file-name "printer-xx.xbm" toolbar-icon-directory)))
  201.   "A printer icon pair.")
  202.  
  203. (defvar toolbar-cut-icon
  204.   (if (featurep 'xpm)
  205.       (toolbar-make-button-list
  206.        (expand-file-name "cut-up.xpm" toolbar-icon-directory)
  207.        nil
  208.        (expand-file-name "cut-xx.xpm" toolbar-icon-directory)
  209.        (expand-file-name "cut-cap-up.xpm" toolbar-icon-directory)
  210.        nil
  211.        (expand-file-name "cut-cap-xx.xpm" toolbar-icon-directory))
  212.     (toolbar-make-button-list
  213.      (expand-file-name "cut-up.xbm" toolbar-icon-directory)
  214.      (expand-file-name "cut-dn.xbm" toolbar-icon-directory)
  215.      (expand-file-name "cut-xx.xbm" toolbar-icon-directory)))
  216.   "A cut icon pair.")
  217.  
  218. (defvar toolbar-copy-icon
  219.   (if (featurep 'xpm)
  220.       (toolbar-make-button-list
  221.        (expand-file-name "copy-up.xpm" toolbar-icon-directory)
  222.        nil
  223.        (expand-file-name "copy-xx.xpm" toolbar-icon-directory)
  224.        (expand-file-name "copy-cap-up.xpm" toolbar-icon-directory)
  225.        nil
  226.        (expand-file-name "copy-cap-xx.xpm" toolbar-icon-directory))
  227.     (toolbar-make-button-list
  228.      (expand-file-name "copy-up.xbm" toolbar-icon-directory)
  229.      (expand-file-name "copy-dn.xbm" toolbar-icon-directory)
  230.      (expand-file-name "copy-xx.xbm" toolbar-icon-directory)))
  231.   "A copy icon pair.")
  232.  
  233. (defvar toolbar-paste-icon
  234.   (if (featurep 'xpm)
  235.       (toolbar-make-button-list
  236.        (expand-file-name "paste-up.xpm" toolbar-icon-directory)
  237.        nil
  238.        (expand-file-name "paste-xx.xpm" toolbar-icon-directory)
  239.        (expand-file-name "paste-cap-up.xpm" toolbar-icon-directory)
  240.        nil
  241.        (expand-file-name "paste-cap-xx.xpm" toolbar-icon-directory))
  242.     (toolbar-make-button-list
  243.      (expand-file-name "paste-up.xbm" toolbar-icon-directory)
  244.      (expand-file-name "paste-dn.xbm" toolbar-icon-directory)
  245.      (expand-file-name "paste-xx.xbm" toolbar-icon-directory)))
  246.   "A paste icon pair.")
  247.  
  248. (defvar toolbar-undo-icon
  249.   (if (featurep 'xpm)
  250.       (toolbar-make-button-list
  251.        (expand-file-name "undo-up.xpm" toolbar-icon-directory)
  252.        nil
  253.        (expand-file-name "undo-xx.xpm" toolbar-icon-directory)
  254.        (expand-file-name "undo-cap-up.xpm" toolbar-icon-directory)
  255.        nil
  256.        (expand-file-name "undo-cap-xx.xpm" toolbar-icon-directory))
  257.     (toolbar-make-button-list
  258.      (expand-file-name "undo-up.xbm" toolbar-icon-directory)
  259.      (expand-file-name "undo-dn.xbm" toolbar-icon-directory)
  260.      (expand-file-name "undo-xx.xbm" toolbar-icon-directory)))
  261.   "An undo icon pair.")
  262.  
  263. (defvar toolbar-spell-icon
  264.   (if (featurep 'xpm)
  265.       (toolbar-make-button-list
  266.        (expand-file-name "spell-up.xpm" toolbar-icon-directory)
  267.        nil
  268.        (expand-file-name "spell-xx.xpm" toolbar-icon-directory)
  269.        (expand-file-name "spell-cap-up.xpm" toolbar-icon-directory)
  270.        nil
  271.        (expand-file-name "spell-cap-xx.xpm" toolbar-icon-directory))
  272.     (toolbar-make-button-list
  273.      (expand-file-name "spell-up.xbm" toolbar-icon-directory)
  274.      (expand-file-name "spell-dn.xbm" toolbar-icon-directory)
  275.      (expand-file-name "spell-xx.xbm" toolbar-icon-directory)))
  276.   "A spell icon pair.")
  277.  
  278. (defvar toolbar-replace-icon
  279.   (if (featurep 'xpm)
  280.       (toolbar-make-button-list
  281.        (expand-file-name "replace-up.xpm" toolbar-icon-directory)
  282.        nil
  283.        (expand-file-name "replace-xx.xpm" toolbar-icon-directory)
  284.        (expand-file-name "replace-cap-up.xpm" toolbar-icon-directory)
  285.        nil
  286.        (expand-file-name "replace-cap-xx.xpm" toolbar-icon-directory))
  287.     (toolbar-make-button-list
  288.      (expand-file-name "replace-up.xbm" toolbar-icon-directory)
  289.      (expand-file-name "replace-dn.xbm" toolbar-icon-directory)
  290.      (expand-file-name "replace-xx.xbm" toolbar-icon-directory)))
  291.   "A replace icon pair.")
  292.  
  293. (defvar toolbar-mail-icon
  294.   (if (featurep 'xpm)
  295.       (toolbar-make-button-list
  296.        (expand-file-name "mail-up.xpm" toolbar-icon-directory)
  297.        nil
  298.        (expand-file-name "mail-xx.xpm" toolbar-icon-directory)
  299.        (expand-file-name "mail-cap-up.xpm" toolbar-icon-directory)
  300.        nil
  301.        (expand-file-name "mail-cap-xx.xpm" toolbar-icon-directory))
  302.     (toolbar-make-button-list
  303.      (expand-file-name "mail-up.xbm" toolbar-icon-directory)
  304.      (expand-file-name "mail-dn.xbm" toolbar-icon-directory)
  305.      (expand-file-name "mail-xx.xbm" toolbar-icon-directory)))
  306.   "A mail icon pair.")
  307.  
  308. (defvar toolbar-info-icon
  309.   (if (featurep 'xpm)
  310.       (toolbar-make-button-list
  311.        (expand-file-name "info-def-up.xpm" toolbar-icon-directory)
  312.        nil
  313.        (expand-file-name "info-def-xx.xpm" toolbar-icon-directory)
  314.        (expand-file-name "info-def-cap-up.xpm" toolbar-icon-directory)
  315.        nil
  316.        (expand-file-name "info-def-cap-xx.xpm" toolbar-icon-directory))
  317.     (toolbar-make-button-list
  318.      (expand-file-name "info-def-up.xbm" toolbar-icon-directory)
  319.      (expand-file-name "info-def-dn.xbm" toolbar-icon-directory)
  320.      (expand-file-name "info-def-xx.xbm" toolbar-icon-directory)))
  321.   "An info icon pair.")
  322.  
  323. (defvar toolbar-compile-icon
  324.   (if (featurep 'xpm)
  325.       (toolbar-make-button-list
  326.        (expand-file-name "compile-up.xpm" toolbar-icon-directory)
  327.        nil
  328.        (expand-file-name "compile-xx.xpm" toolbar-icon-directory)
  329.        (expand-file-name "compile-cap-up.xpm" toolbar-icon-directory)
  330.        nil
  331.        (expand-file-name "compile-cap-xx.xpm" toolbar-icon-directory))
  332.     (toolbar-make-button-list
  333.      (expand-file-name "compile-up.xbm" toolbar-icon-directory)
  334.      (expand-file-name "compile-dn.xbm" toolbar-icon-directory)
  335.      (expand-file-name "compile-xx.xbm" toolbar-icon-directory)))
  336.   "A compile icon.")
  337.  
  338. (defvar toolbar-debug-icon
  339.   (if (featurep 'xpm)
  340.       (toolbar-make-button-list
  341.        (expand-file-name "debug-up.xpm" toolbar-icon-directory)
  342.        nil
  343.        (expand-file-name "debug-xx.xpm" toolbar-icon-directory)
  344.        (expand-file-name "debug-cap-up.xpm" toolbar-icon-directory)
  345.        nil
  346.        (expand-file-name "debug-cap-xx.xpm" toolbar-icon-directory))
  347.     (toolbar-make-button-list
  348.      (expand-file-name "debug-up.xbm" toolbar-icon-directory)
  349.      (expand-file-name "debug-dn.xbm" toolbar-icon-directory)
  350.      (expand-file-name "debug-xx.xbm" toolbar-icon-directory)))
  351.   "A debugger icon.")
  352.  
  353. (defvar toolbar-news-icon
  354.   (if (featurep 'xpm)
  355.       (toolbar-make-button-list
  356.        (expand-file-name "news-up.xpm" toolbar-icon-directory)
  357.        nil
  358.        (expand-file-name "news-xx.xpm" toolbar-icon-directory)
  359.        (expand-file-name "news-cap-up.xpm" toolbar-icon-directory)
  360.        nil
  361.        (expand-file-name "news-cap-xx.xpm" toolbar-icon-directory))
  362.     (toolbar-make-button-list
  363.      (expand-file-name "news-up.xbm" toolbar-icon-directory)
  364.      (expand-file-name "news-dn.xbm" toolbar-icon-directory)
  365.      (expand-file-name "news-xx.xbm" toolbar-icon-directory)))
  366.    "A news icons.")
  367.  
  368. (defvar initial-toolbar-spec
  369.   '([toolbar-file-icon        find-file    t    "Open a file"    ]
  370.     [toolbar-folder-icon    dired        t    "View directory"]
  371.     [toolbar-disk-icon        save-buffer    t    "Save buffer"    ]
  372.     [toolbar-printer-icon    lpr-buffer    t    "Print buffer"    ]
  373.     [toolbar-cut-icon        x-kill-primary-selection t "Kill region"]
  374.     [toolbar-copy-icon        x-copy-primary-selection t "Copy region"]
  375.     [toolbar-paste-icon        x-yank-clipboard-selection t
  376.                 "Paste from clipboard"]
  377.     [toolbar-undo-icon        undo        t    "Undo edit"    ]
  378.     [toolbar-spell-icon        toolbar-ispell    t    "Spellcheck"    ]
  379.     [toolbar-replace-icon    query-replace    t    "Replace text"    ]
  380.     [toolbar-mail-icon        toolbar-mail    t    "Mail"        ]
  381.     [toolbar-info-icon        toolbar-info    t    "Information"    ]
  382.     [toolbar-compile-icon    toolbar-compile        t    "Compile"    ]
  383.     [toolbar-debug-icon        toolbar-debug    t    "Debug"        ]
  384.     [toolbar-news-icon        toolbar-news    t    "News"        ])
  385.   "The initial toolbar for a buffer.")
  386.  
  387. (set-specifier default-toolbar initial-toolbar-spec)
  388.  
  389.  
  390. (provide 'x-toolbar)
  391.