Skip to content

Instantly share code, notes, and snippets.

@rswgnu
Last active August 27, 2017 04:53
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save rswgnu/b714e01d84f715dedc741f695dda4522 to your computer and use it in GitHub Desktop.
Save rswgnu/b714e01d84f715dedc741f695dda4522 to your computer and use it in GitHub Desktop.
InfoDock, https://sourceforge.net/projects/infodock, Menubars from XEmacs (could be easily adapted to GNU Emacs) to simplify usage and expose useful functionality
;;!emacs
;;
;; FILE: id-menubars.el
;; SUMMARY: InfoDock major-mode-specific menubars.
;; USAGE: XEmacs Lisp Library
;;
;; AUTHOR: Bob Weiner
;; ORG: BeOpen.com
;;
;; ORIG-DATE: 9-Nov-92 at 15:56:31
;; LAST-MOD: 20-Jul-99 at 02:12:20 by Bob Weiner
;;
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999 BeOpen.com and the Free Software Foundation, Inc.
;; Licensed under the GNU General Public License, version of your choice.
;;
;; This file is part of InfoDock.
;;
;; DESCRIPTION:
;; DESCRIP-END.
;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************
(require 'id-menus)
(provide 'id-menubars)
;;; ************************************************************************
;;; Public functions
;;; ************************************************************************
;;;###autoload
(defun id-menubar-get (mode)
"Return mode-specific menubar symbol for MODE or nil if none."
(get (intern (downcase (symbol-name mode))) 'id-menubar))
;;;###autoload
(defun id-menubar-set (mode menubar-sym)
"Associate MODE with MENUBAR-SYM."
(let ((lcmode (intern (downcase (symbol-name mode)))))
(put lcmode 'id-menubar menubar-sym)
;; Add mode to list of modes with mode-specific menubars.
(add-hook 'id-menubar-modes lcmode)
;; Add hook to select mode-specific menubar.
(add-hook (intern (concat (symbol-name mode) "-hook"))
'id-set-mode-menubar)))
;;; ************************************************************************
;;; Public variables
;;; ************************************************************************
;;; Popup menus still to be done.
;;;
;;; ["Calendar" calendar t]
;;; ["Read-Mail" vm t]
;;;
;;; Possibly:
;;; ["Calculator" calc t]
;;; Outlining for C, C++, Elisp.
(defvar id-menubar-modes nil
"List of major modes that have mode-specific menubars.")
(defconst id-menubar-asm
(list
'("Assembly"
["Help" describe-mode t]
["Manual" (id-info "(xemacs)Asm Mode") t]
"----"
["Comment-Region" comment-region t]
"----"
["Enable-Debugging"
(gdbsrc-mode 1)
:active t
:included (and buffer-file-name
(boundp 'gdbsrc-mode) (not gdbsrc-mode))]
["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
'("Compile"
["Compile-File"
(compile
(concat "make "
(let ((file (file-name-nondirectory (buffer-file-name))))
(substring file 0 (string-match "\\.[^.]+$" file)))
".o"))
t]
["Compile-Program" compile t]
;; InfoDock sometimes uses a command other than next-error to parse
;; errors, so the key binding is used instead.
["To-Next-Error" (call-interactively (key-binding "\C-x`"))
:active t
:keys "C-x `"]
)
infodock-debug-menu
infodock-edit-menu
infodock-go-menu
(cons "Highlight" infodock-highlighter-menu)
(infodock-options-menu)
(infodock-software-menu)
))
(id-menubar-set 'asm-mode 'id-menubar-asm)
(defconst id-menubar-Buffer-menu
(list
'("Buffer-Menu"
["Help" describe-mode t]
["Manual" (id-info "(xemacs)Several Buffers") t]
"----"
["Delete-and-Save-Buffers" Buffer-menu-execute t]
["Quit" Buffer-menu-select t]
)
'("Display"
["Display-Buffers" Buffer-menu-select t]
["Display-in-2nd-Window" Buffer-menu-2-window t]
["Display-in-One-Window" Buffer-menu-1-window t]
["Display-in-This-Window" Buffer-menu-this-window t]
["Display-in-Other-Window" Buffer-menu-other-window t]
)
infodock-go-menu
'("Mark"
["Mark-Buffer-Unmodified" Buffer-menu-not-modified t]
["Mark-for-Display" Buffer-menu-mark t]
["Mark-for-Deletion" Buffer-menu-delete t]
["Mark-for-Saving" Buffer-menu-save t]
["Unmark" Buffer-menu-unmark t]
)
(infodock-options-menu)
))
(id-menubar-set 'Buffer-menu-mode 'id-menubar-Buffer-menu)
(defconst id-menubar-c++
(list
'("C++"
["Help" describe-mode t]
["Manual" (id-info "(cc-mode)Introduction") t]
"----"
["Comment-Region" comment-region t]
["Fill-Comment-Paragraph" c-fill-paragraph t]
["Uncomment-Region" (comment-region
(region-beginning) (region-end) '(4)) t]
"----"
["Enable-Debugging"
(gdbsrc-mode 1)
:active t
:included (and buffer-file-name
(boundp 'gdbsrc-mode) (not gdbsrc-mode))]
["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
'("Compile"
["Compile-File"
(compile
(concat "make "
(let ((file (file-name-nondirectory (buffer-file-name))))
(substring file 0 (string-match "\\.[^.]+$" file)))
".o"))
t]
["Compile-Program" compile t]
;; InfoDock sometimes uses a command other than next-error to parse
;; errors, so the key binding is used instead.
["To-Next-Error" (call-interactively (key-binding "\C-x`"))
:active t
:keys "C-x `"]
)
infodock-cscope-menu
infodock-debug-menu
infodock-edit-menu
infodock-go-menu
(cons "Highlight" infodock-highlighter-menu)
(list
"Indent-&-Mark"
'["Indent-Function" c++-indent-defun t]
'["Indent-Region" indent-region t]
'["Mark-Expression" mark-sexp t]
'["Mark-Function" mark-c-function t]
(id-c-styles-menu)
)
'("Preprocess"
["Backward-an-Ifdef" c-backward-conditional t]
["Forward-an-Ifdef" c-forward-conditional t]
["Preprocess-Region" c-macro-expand t]
["To-Ifdef-End" (c-up-conditional -1) t]
["Up-an-Ifdef" c-up-conditional t]
)
(infodock-software-menu)
))
(id-menubar-set 'c++-mode 'id-menubar-c++)
(defconst id-menubar-c
(list
'("C"
["Help" describe-mode t]
["Manual" (id-info "(cc-mode)Introduction") t]
"----"
["Comment-Region" comment-region t]
["Fill-Comment-Paragraph" c-fill-paragraph t]
["Uncomment-Region" (comment-region
(region-beginning) (region-end) '(4)) t]
"----"
["Enable-Debugging"
(gdbsrc-mode 1)
:active t
:included (and buffer-file-name
(boundp 'gdbsrc-mode) (not gdbsrc-mode))]
["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
'("Compile"
["Compile-File"
(compile
(concat "make "
(let ((file (file-name-nondirectory (buffer-file-name))))
(substring file 0 (string-match "\\.[^.]+$" file)))
".o"))
t]
["Compile-Program" compile t]
;; InfoDock sometimes uses a command other than next-error to parse
;; errors, so the key binding is used instead.
["To-Next-Error" (call-interactively (key-binding "\C-x`"))
:active t
:keys "C-x `"]
"----"
["Backward-an-Ifdef" c-backward-conditional t]
["Forward-an-Ifdef" c-forward-conditional t]
["Preprocess-Region" c-macro-expand t]
["To-Ifdef-End" (c-up-conditional -1) t]
["Up-an-Ifdef" c-up-conditional t]
)
infodock-cscope-menu
infodock-debug-menu
infodock-edit-menu
infodock-go-menu
(cons "Highlight" infodock-highlighter-menu)
(list
"Indent-&-Mark"
'["Indent-Function" c++-indent-defun t]
'["Indent-Region" indent-region t]
'["Mark-Expression" mark-sexp t]
'["Mark-Function" mark-c-function t]
(id-c-styles-menu)
)
(infodock-options-menu)
(infodock-software-menu)
))
(id-menubar-set 'c-mode 'id-menubar-c)
(defconst id-menubar-c++-c id-menubar-c)
(id-menubar-set 'c++-c-mode 'id-menubar-c++-c)
(defconst id-menubar-objc
(cons
'("Objective-C"
["Help" describe-mode t]
["Manual" (id-info "(cc-mode)Introduction") t]
"----"
["Comment-Region" comment-region t]
["Fill-Comment-Paragraph" c-fill-paragraph t]
["Uncomment-Region" (comment-region
(region-beginning) (region-end) '(4)) t]
"----"
["Enable-Debugging"
(gdbsrc-mode 1)
:active t
:included (and buffer-file-name
(boundp 'gdbsrc-mode) (not gdbsrc-mode))]
["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
(cdr id-menubar-c)))
(id-menubar-set 'objc-mode 'id-menubar-objc)
(defconst id-menubar-dired
(list
'("Dired"
["Help" describe-mode t]
["Manual" (id-info "(xemacs)Dired") t]
"----"
["Quit" dired-quit t]
)
'("Directory"
["Compile-XEmacs-Lisp" (byte-recompile-directory
(dired-get-filename)) t]
["Create" dired-create-directory t]
["Expunge" dired-do-deletions t]
["Kill-Lines" (if (fboundp 'dired-do-kill)
(dired-do-kill)
(dired-do-kill-lines))
t]
["Rescan" revert-buffer t]
["Sort-by-Date-or-Name" dired-sort-toggle-or-edit t]
["Undo" dired-undo t]
"----"
["Down-a-Directory" dired-tree-down t]
["Insert-Subdir" dired-maybe-insert-subdir t]
["To-Next-Subdir" dired-next-subdir t]
["To-Prev-Subdir" dired-prev-subdir t]
["Toggle-Subdir-Display" dired-hide-subdir t]
["Toggle-All-Subdir-Display" dired-hide-all t]
["Up-a-Directory" dired-tree-up t]
)
'("Execution"
["Change-Group" dired-do-chgrp t]
["Change-Owner" dired-do-chown t]
["Change-Permissions" dired-do-chmod t]
["Compile-XEmacs-Lisp" dired-do-byte-compile t]
["Compress" dired-do-compress t]
["Copy" dired-do-copy t]
["Delete" (if (fboundp 'dired-do-deletions)
(dired-do-deletions)
(dired-do-delete))
t]
["Downcase-Filenames" dired-downcase t]
["Expunge" (if (fboundp 'dired-do-deletions)
(dired-do-deletions)
(dired-do-delete))
t]
["Hard-Link" dired-do-hardlink t]
["Load-XEmacs-Lisp" dired-do-load t]
("Matching-Files"
["Copy" dired-do-rename-regexp t]
["Hard-Link" dired-do-hardlink-regexp t]
["Rename" dired-do-rename-regexp t]
["Symbolic-Link" dired-do-copy-regexp t]
)
["Print" dired-do-print t]
["Rename" (if (fboundp 'dired-do-move)
(dired-do-move)
(dired-do-rename))
:active t :keys "r"]
["Rescan" dired-do-redisplay t]
["Shell-Command" dired-do-shell-command t]
["Show-Errors" dired-why t]
["Symbolic-Link" dired-do-symlink t]
["Uncompress" dired-do-uncompress t]
["Upcase-Filenames" dired-upcase t]
)
'("File"
["Delete" dired-flag-file-deleted t]
["Compare" dired-diff t]
["Compare-to-Backup" dired-backup-diff t]
["Compile-XEmacs-Lisp" dired-byte-recompile t]
["Edit" dired-find-file t]
["Find" dired-find-file t]
["Find-Other-Window" dired-find-file-other-window t]
["Mail" (mail-file (dired-get-filename)) t]
["Print" (print-file (dired-get-filename)) t]
["Rename" dired-do-move t]
["View" dired-view-file t]
)
infodock-go-menu
'("Mark"
["Delete-Auto-Saves" dired-flag-auto-save-files t]
["Delete-Interleaf-Backups" dired-flag-interleaf-backups t]
["Delete-Matching-Files" dired-flag-regexp-files t]
["Delete-Numer-Backups" dired-clean-directory t]
["Delete-This-File" dired-flag-file-deleted t]
["Delete-Tilde-Backups" dired-flag-backup-files t]
"----"
["Mark-File-or-Dir" dired-mark-subdir-or-file t]
["Mark-Directories" dired-mark-directories t]
["Mark-Executables" dired-mark-executables t]
["Mark-Matching-Files" dired-mark-files-regexp t]
["Mark-Symbolic-Links" dired-mark-symlinks t]
"----"
["Undo" dired-undo t]
["Unmark-Backward" dired-backup-unflag t]
["Unmark-Forward" dired-unmark-subdir-or-file t]
["Unmark-All" (if (fboundp 'dired-unflag-all-files)
(dired-unflag-all-files nil)
(call-interactively 'dired-unmark-all-files))
t]
)
(infodock-options-menu)
))
(id-menubar-set 'dired-mode 'id-menubar-dired)
(defun id-menubar-edit (major-mode-name info-node)
"Return a menubar appropriate for text editing modes."
(delq nil
(list
(list
major-mode-name
'["Help" describe-mode t]
(vector "Manual" (list 'id-info info-node) t)
"----"
'["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
infodock-edit-menu
infodock-go-menu
(if (fboundp 'infodock-hyperbole-menu) (infodock-hyperbole-menu))
(infodock-options-menu)
infodock-replace-menu
infodock-search-menu)))
(defconst id-menubar-emacs-lisp
(list
'("XEmacs-Lisp"
["Help" describe-mode t]
["Debugging-Manual" (id-info "(lispref)Edebug") t]
["Eval-Manual" (id-info "(xemacs)Lisp Eval") t]
"----"
["Def-in-Manual" lispref-search t]
["Function-Doc" (describe-function (find-tag-default)) t]
["Function-Value" (symbol-function (find-tag-default)) t]
["Variable-Doc" (describe-variable (find-tag-default)) t]
["Variable-Value" (message (eval (find-tag-default))) t]
"----"
["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
'("Debug"
["Check-Parentheses" check-parentheses t]
["Debug-Current-Function" edebug-defun t]
["Disassemble-Function" disassemble t]
["Toggle-Debug-on-Error" toggle-error-debugging t]
)
infodock-edit-menu
'("Execute"
["Compile-Directory" byte-recompile-directory t]
["Compile-File" byte-compile-now t]
["Complete-Symbol" lisp-complete-symbol t]
["Eval-Definition" eval-defun t]
["Eval-Preceding-Sexp" eval-last-sexp t]
["Eval-Sexp-and-Insert" eval-print-last-sexp t]
)
infodock-go-menu
(cons "Highlight" infodock-highlighter-menu)
'("Mark"
["Mark-Expression" mark-sexp t]
["Mark-Function" mark-defun t]
)
(infodock-options-menu)
(infodock-software-menu)
))
(id-menubar-set 'emacs-lisp-mode 'id-menubar-emacs-lisp)
(defconst id-menubar-fortran
(list
'("Fortran"
["Help" describe-mode t]
["Manual" (id-info "(xemacs)Fortran") t]
"----"
["To-Next-Statement" fortran-next-statement t]
["To-Prev-Statement" fortran-previous-statement t]
["To-Subprogram-Begin" beginning-of-fortran-subprogram t]
["To-Subprogram-End" end-of-fortran-subprogram t]
"----"
["Comment-Region" comment-region t]
["Uncomment-Region" (comment-region
(region-beginning) (region-end) '(4)) t]
"----"
["Enable-Debugging"
(gdbsrc-mode 1)
:active t
:included (and buffer-file-name
(boundp 'gdbsrc-mode) (not gdbsrc-mode))]
["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
'("Compile"
["Compile-File"
(compile
(concat "make "
(let ((file (file-name-nondirectory (buffer-file-name))))
(substring file 0 (string-match "\\.[^.]+$" file)))
".o"))
t]
["Compile-Program" compile t]
;; InfoDock sometimes uses a command other than next-error to parse
;; errors, so the key binding is used instead.
["To-Next-Error" (call-interactively (key-binding "\C-x`"))
:active t
:keys "C-x `"]
)
infodock-debug-menu
infodock-edit-menu
infodock-go-menu
'("Indent-&-Mark"
["Indent" fortran-indent-subprogram t]
["Mark" mark-fortran-subprogram t]
)
(infodock-options-menu)
(infodock-software-menu)
))
(id-menubar-set 'fortran-mode 'id-menubar-fortran)
(defconst id-menubar-fundamental (id-menubar-edit "Fundamental" "(xemacs)Text"))
(id-menubar-set 'fundamental-mode 'id-menubar-fundamental)
;; `id-menubar-gdb' and `id-menubar-id-gdb' are defined in "id-gdb-menus.el".
(defconst id-menubar-gud
(list
'("Debugger"
["Help" describe-mode t]
["Manual" (id-info "(infodock)Debugging") t]
"----"
["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
'("Breakpoint"
["One-Time-Break" gud-tbreak t]
["Toggle-Breakpoint" gud-toggle-break t]
)
'["Continue" gud-cont t]
'["Finish-Func" gud-finish t]
infodock-go-menu
'["Print" gud-print t] ;; Print expr at point.
'("Stack"
["Stack-Down-Frame" gud-down t]
["Stack-Up-Frame" gud-up t]
)
'["Step" gud-step t]
'["Step-In" gud-stepi t]
'["Step-Over" gud-next t]
'["To-Source" gud-refresh t]
))
(id-menubar-set 'gud-mode 'id-menubar-gud)
;(defconst id-menubar-gnus-article
; '(
; ("GNUS-Article"
; ["GNUS-Version" gnus-version t]
; ["Help" gnus-article-describe-briefly t]
; ["Manual" gnus-info-find-node t]
; )
; ("Article"
; ["Follow-Reference" gnus-article-refer-article t]
; ["Next-Digest" gnus-article-next-digest t]
; ["Next-Page" gnus-article-next-page t]
; ["Prev-Digest" gnus-article-prev-digest t]
; ["Prev-Page" gnus-article-prev-page t]
; )
; ["Display-Summary" gnus-article-show-summary t]
; infodock-go-menu
; ))
;(id-menubar-set 'gnus-article-mode 'id-menubar-gnus-article)
;(defconst id-menubar-gnus-browse-killed
; '(
; ("GNUS-Browse-Killed"
; ["GNUS-Version" gnus-version t]
; ["Manual" gnus-info-find-node t]
; "----"
; ["Quit" gnus-browse-killed-exit t]
; )
; infodock-go-menu
; ("Group"
; ["Next-Group" gnus-group-next-group t]
; ["Prev-Group" gnus-group-prev-group t]
; ["Yank-Current" gnus-browse-killed-yank t]
; )
; ))
;(id-menubar-set 'gnus-browse-killed-mode 'id-menubar-gnus-browse-killed)
;(defconst id-menubar-gnus-group
; '(
; ("GNUS-Group"
; ["GNUS-Version" gnus-version t]
; ["Help" gnus-group-describe-briefly t]
; ["Manual" gnus-info-find-node t]
; "----"
; ["Force-Restart" gnus-group-restart t]
; ["Get-New-News" gnus-group-get-new-news t]
; ["Save-Status" gnus-group-force-update t]
; "----"
; ["Abort-GNUS" (id-tool-quit 'gnus-group-quit) t]
; ["Exit-GNUS" (id-tool-quit 'gnus-group-exit) t]
; ["Suspend-GNUS" (id-tool-quit 'gnus-group-suspend) t]
; )
; ("Catch-Up"
; ["Unmarked" gnus-group-catchup t]
; ["All" gnus-group-catchup-all t]
; )
; infodock-go-menu
; ("Group"
; ["Check-for-Invalid-Groups" gnus-group-check-bogus-groups t]
; ["Cut" gnus-group-kill-group t]
; ["Cut-Groups-in-Region" gnus-group-kill-region t]
; ["List" gnus-group-list-groups t]
; ["List-All" gnus-group-list-all-groups t]
; ["Narrow-to-Groups-in-Region" gnus-group-restrict-groups t]
; ["Unsubscribe-Current" gnus-group-unsubscribe-current-group t]
; ["Unsubscribe" gnus-group-unsubscribe-group t]
; ["Yank" gnus-group-yank-group t]
; )
; ("Kill"
; ["Edit-Current-Group-Kills" gnus-group-edit-local-kill t]
; ["Edit-Global-Kills" gnus-group-edit-global-kill t]
; )
; ("Move"
; ["Jump-to-Group" gnus-group-jump-to-group t]
; ["Next-Group" gnus-group-next-group t]
; ["Next-Unread-Group" gnus-group-next-unread-group t]
; ["Prev-Group" gnus-group-prev-group t]
; ["Prev-Unread-Group" gnus-group-prev-unread-group t]
; ["Read-Group" gnus-group-read-group t]
; ["Select-Group" gnus-group-select-group t]
; )
; ("Post"
; ["Post-Article" gnus-group-post-news t]
; )
; ))
;(id-menubar-set 'gnus-group-mode 'id-menubar-gnus-group)
;(defconst id-menubar-gnus-kill-file
; '(
; ("GNUS-Kill-File"
; ["GNUS-Version" gnus-version t]
; ["Manual" gnus-info-find-node t]
; "----"
; ["Quit" gnus-kill-file-exit t]
; )
; infodock-go-menu
; ("Kill"
; ["Kill-by-Author" gnus-kill-file-kill-by-author t]
; ["Kill-by-Subject" gnus-kill-file-kill-by-subject t]
; ["Apply-to-Group" gnus-kill-file-apply-buffer t]
; ["Apply-Last-Expr-to-Group" gnus-kill-file-apply-last-sexp t]
; )
; ))
;(id-menubar-set 'gnus-kill-file-mode 'id-menubar-gnus-kill-file)
;(defconst id-menubar-gnus-summary
; '(
; ("GNUS-Summary"
; ["GNUS-Version" gnus-version t]
; ["Help" gnus-summary-describe-briefly t]
; ["Manual" gnus-info-find-node t]
; "----"
; ["Next-Group" gnus-summary-next-group t]
; ["Prev-Group" gnus-summary-prev-group t]
; "----"
; ["Abort-Summary" gnus-summary-quit t]
; ["Exit-Summary" gnus-summary-exit t]
; )
; ("Catch-Up"
; ["Unmarked" gnus-summary-catchup t]
; ["All" gnus-summary-catchup-all t]
; ["and-Exit" gnus-summary-catchup-and-exit t]
; ["All-and-Exit" gnus-summary-catchup-all-and-exit t]
; )
; ("Digest"
; ["Next" gnus-summary-next-digest t]
; ["Previous" gnus-summary-prev-digest t]
; ["Run-Rmail-on" gnus-summary-rmail-digest t]
; )
; ("Display"
; ["Reselect-Current-Group" gnus-summary-reselect-current-group t]
; ["Show-Current-Article" gnus-summary-show-article t]
; ["Summary-Only" gnus-summary-expand-window t]
; )
; infodock-go-menu
; ;; From "gnus-hide.el".
; ("Hide"
; ["Delete-Articles-Marked" gnus-summary-delete-marked-with t]
; ["Delete-Articles-Read" gnus-summary-delete-marked-as-read t]
; "----"
; ["Hide-Signature" gnus-summary-hide-sig t]
; ["Hide-Quote" gnus-summary-hide-quote t]
; ["Unhide" gnus-summary-unhide t]
; ["Simplify-Refs" gnus-summary-simplify-references t]
; ["Toggle-Auto-Hide" gnus-hide-autohide-toggle t]
; )
; ("Move"
; ("Next"
; ["Next-Article" gnus-summary-next-unread-article t]
; ["Next-Subject" gnus-summary-next-unread-subject t]
; ["Next-Any-Article" gnus-summary-next-article t]
; ["Next-Any-Subject" gnus-summary-next-subject t]
; ["Next-Any-Same-Subj" gnus-summary-next-same-subject t]
; ["Next-Same-Subj" gnus-summary-next-unread-same-subject t]
; ["Next-Digest" gnus-summary-next-digest t]
; ["Next-Group" gnus-summary-next-group t]
; )
; ("Previous"
; ["Prev-Article" gnus-summary-prev-unread-article t]
; ["Prev-Subject" gnus-summary-prev-unread-subject t]
; ["Prev-Any-Article" gnus-summary-prev-article t]
; ["Prev-Any-Subject" gnus-summary-prev-subject t]
; ["Prev-Any-Same-Subj" gnus-summary-prev-same-subject t]
; ["Prev-Same-Subj" gnus-summary-prev-unread-same-subject t]
; ["Prev-Digest" gnus-summary-prev-digest t]
; ["Prev-Group" gnus-summary-prev-group t]
; )
; ["To-Article-Begin" gnus-summary-beginning-of-article t]
; ["To-Article-End" gnus-summary-end-of-article t]
; ["To-Prior-Article" gnus-summary-goto-last-article t]
; )
; ("Kill"
; ["Edit-Current-Group-Kills" gnus-summary-edit-local-kill t]
; ["Edit-Global-Kills" gnus-summary-edit-global-kill t]
; ["Kill-Same-Subject" gnus-summary-kill-same-subject-and-select t]
; ["Kill-Thread" gnus-summary-kill-thread t]
; )
; ("Mail"
; ["Append-to-Mail-File" gnus-summary-save-in-mail t]
; ["Forward-Article" gnus-summary-mail-forward t]
; ["Mail-other-Window" gnus-summary-mail-other-window t]
; ["Reply-to-Author" gnus-summary-reply t]
; ["Reply-with-Original" gnus-summary-reply-with-original t]
; )
; ("Mark"
; ["Clear-Mark-Backward" gnus-summary-clear-mark-backward t]
; ["Clear-Mark-Forward" gnus-summary-clear-mark-forward t]
; ["Delete-Articles-Marked" gnus-summary-delete-marked-with t]
; ["Delete-Articles-Read" gnus-summary-delete-marked-as-read t]
; ["Mark-Read-Backward" gnus-summary-mark-as-read-backward t]
; ["Mark-Read-Forward" gnus-summary-mark-as-read-forward t]
; ["Mark-Unread-Backward" gnus-summary-mark-as-unread-backward t]
; ["Mark-Unread-Forward" gnus-summary-mark-as-unread-forward t]
; )
; ("Post"
; ["Add-an-Article" gnus-summary-post-news t]
; ["Followup-on-Article" gnus-summary-followup t]
; ["Followup-with-Original" gnus-summary-followup-with-original t]
; )
; ("Search"
; ["First-Unread-Article" gnus-summary-first-unread-article t]
; ["Isearch-Article" gnus-summary-isearch-article t]
; ["Search-Subjects" isearch-forward t]
; ["Search-and-Scroll-Forward" gnus-summary-search-article-forward t]
; ["Search-and-Scroll-Backward" gnus-summary-search-article-backward t]
; )
; ("Service"
; ["Cancel-Article" gnus-summary-cancel-article t]
; ["Execute-Command" gnus-summary-execute-command t]
; ["Pipe-Article-Through" gnus-summary-pipe-output t]
; ["Show-All-Headers" gnus-summary-show-all-headers t]
; ["Stop-Page-Breaking" gnus-summary-stop-page-breaking t]
; ["Toggle-Header-Pruning" gnus-summary-toggle-header t]
; ["Toggle-Truncation" gnus-summary-toggle-truncation t]
; ["Unrotate-Article" gnus-summary-caesar-message t]
; )
; ("Sort"
; ["by-Author" gnus-summary-sort-by-author t]
; ["by-Date" gnus-summary-sort-by-date t]
; ["by-Number" gnus-summary-sort-by-number t]
; ["by-Subject" gnus-summary-sort-by-subject t]
; )
; ("Thread"
; ["Down" gnus-summary-down-thread t]
; ["Hide" gnus-summary-hide-thread t]
; ["Kill" gnus-summary-kill-thread t]
; ["Next" gnus-summary-next-thread t]
; ["Prev" gnus-summary-prev-thread t]
; ["Show" gnus-summary-show-thread t]
; ["Toggle-Threads" gnus-summary-toggle-threads t]
; ["Up" gnus-summary-up-thread t]
; )
; ))
;(id-menubar-set 'gnus-summary-mode 'id-menubar-gnus-summary)
;; Kotl-mode menubar is loaded by "kotl/kfile.el" rather than here.
(defconst id-menubar-indented-text
(id-menubar-edit "Indented-Text" "(xemacs)Text"))
(id-menubar-set 'indented-text-mode 'id-menubar-indented-text)
(defconst id-menubar-java
(list
'("Java"
["Help" describe-mode t]
["Manual" (id-info "(cc-mode)Introduction") t]
"----"
["Comment-Region" comment-region t]
["Fill-Comment-Paragraph" c-fill-paragraph t]
["Uncomment-Region" (comment-region
(region-beginning) (region-end) '(4)) t]
"----"
["Enable-Debugging"
(gdbsrc-mode 1)
:active t
:included (and buffer-file-name
(boundp 'gdbsrc-mode) (not gdbsrc-mode))]
["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
'("Compile"
["Compile-File"
(compile (concat "javac " (buffer-file-name))) t]
["Compile-Program" compile t]
;; InfoDock sometimes uses a command other than next-error to parse
;; errors, so the key binding is used instead.
["To-Next-Error" (call-interactively (key-binding "\C-x`"))
:active t
:keys "C-x `"]
)
;; '("Debug"
;; ["Invoke-JDB" (make-comint "*jdb*" "jdb") t]
;; )
infodock-edit-menu
infodock-go-menu
(cons "Highlight" infodock-highlighter-menu)
(list
"Indent-&-Mark"
'["Indent-Function" id-java-indent-defun t]
'["Indent-Region" indent-region t]
'["Mark-Expression" mark-sexp t]
'["Mark-Method" id-java-mark-method t]
(id-c-styles-menu)
)
(infodock-options-menu)
(infodock-software-menu)
))
(id-menubar-set 'java-mode 'id-menubar-java)
(defconst id-menubar-jde
(list
'("JDE"
["Browse-JDK-Doc" jde-browse-jdk-doc t]
["Contents" jde-show-help t]
;; (concat "JDE " jde-version)
"----"
["Compile" jde-compile t]
["Run-App" jde-run t]
["Debug-App" jde-db t]
["Run-Applet" jde-run-menu-run-applet t]
["Build" jde-build t]
)
infodock-edit-menu
'("Generate"
["Get-or-Set-Pair" jde-gen-get-set t]
("Listener"
["Action" jde-gen-action-listener t]
["Window" jde-gen-window-listener t]
["Mouse" jde-gen-mouse-listener t]
)
["Other" jde-gen-code t]
)
infodock-go-menu
(infodock-options-menu)
(infodock-software-menu)
'["Speedbar" speedbar-frame-mode t]
))
(id-menubar-set 'jde-mode 'id-menubar-jde)
(defconst id-menubar-lisp-interaction
(list
'("Lisp-Interaction"
["Help" describe-mode t]
["Debugging-Manual" (id-info "(lispref)Edebug") t]
["Eval-Manual" (id-info "(xemacs)Lisp Eval") t]
["Interact-Manual" (id-info "(xemacs)Lisp Interaction") t]
"----"
["Def-in-Manual" lispref-search t]
["Function-Doc" (describe-function (find-tag-default)) t]
["Function-Value" (symbol-function (find-tag-default)) t]
["Variable-Doc" (describe-variable (find-tag-default)) t]
["Variable-Value" (message (eval (find-tag-default))) t]
"----"
["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
'("Debug"
["Check-Parentheses" check-parentheses t]
["Debug-Current-Function" edebug-defun t]
["Disassemble-Function" disassemble t]
["Toggle-Debug-on-Error" toggle-error-debugging t]
)
infodock-edit-menu
'("Execute"
["Complete-Symbol" lisp-complete-symbol t]
["Eval-Definition" eval-defun t]
["Eval-Preceding-Sexp" eval-last-sexp t]
["Eval-Sexp-and-Insert" eval-print-last-sexp t]
)
infodock-go-menu
(cons "Highlight" infodock-highlighter-menu)
'("Jump-to"
["Def-at-Point" smart-lisp t]
["Identifier-Def" find-tag t]
["Set-Def-Lookup-Table" visit-tags-table t]
"----"
["Backward-Expression" backward-sexp t]
["Forward-Expression" forward-sexp t]
["Function-Beginning" beginning-of-defun t]
["Function-End" end-of-defun t]
)
'("Mark"
["Mark-Expression" mark-sexp t]
["Mark-Function" mark-defun t]
)
(infodock-options-menu)
(infodock-software-menu)
))
(id-menubar-set 'lisp-interaction-mode 'id-menubar-lisp-interaction)
(defconst id-menubar-lisp
(list
'("Lisp"
["Help" describe-mode t]
["Manual" (id-info "(xemacs)External Lisp") t]
"----"
["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
infodock-edit-menu
'["Eval-Definition" lisp-send-defun t]
infodock-go-menu
(cons "Highlight" infodock-highlighter-menu)
'("Mark"
["Mark-Expression" mark-sexp t]
["Mark-Function" mark-defun t]
)
(infodock-options-menu)
(infodock-software-menu)
))
(id-menubar-set 'lisp-mode 'id-menubar-lisp)
(defconst id-menubar-Info
(list
'("Info"
["Help" Info-summary t]
["Manual" (id-info "(info)") t]
["Tutorial" Info-help t]
"----"
["Quit" (id-tool-quit 'Info-exit) t]
)
'("Edit"
["Annotate-Node" Info-annotate t]
["Edit-Node" Info-edit t]
)
infodock-go-menu
'("Move-to-Node"
["Final-Node" Info-end t]
["Former-Node" Info-last t]
["Goto-Cross-Ref" Info-follow-reference t]
["Goto-Nearest-Ref" Info-follow-nearest-node t]
["Goto-Node" Info-goto-node t]
["Info-Directory" Info-directory t]
["Menu-Item" Info-menu t]
["Next-Node" Info-global-next t]
["Next-Node-Same-Level" Info-next t]
["Prev-Node" Info-global-prev t]
["Prev-Node-Same-Level" Info-prev t]
["Top-Node" Info-top t]
["Up-a-Level" Info-up t]
)
'("Move-within-Node"
["Browse-Backward" Info-scroll-prev t]
["Browse-Forward" Info-scroll-next t]
["To-Node-Beginning" beginning-of-buffer t]
["To-Node-End" end-of-buffer t]
["To-Prior-Point" Info-restore-point t]
)
(infodock-options-menu)
'("Search"
["Search-for-Regexp" Info-search t]
["Search-Index" Info-index t]
)
))
(id-menubar-set 'Info-mode 'id-menubar-Info)
(defun id-menubar-mail ()
(list
'("Mail"
["Help" describe-mode t]
["Manual" (id-info "(xemacs)Sending Mail") t]
"----"
["Send" mail-send t]
["Send-and-Quit" mail-send-and-exit t]
["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
(delq nil
(list
"Aliases"
'["Expand-Mail-Alias" (let ((local-abbrev-table mail-aliases))
(expand-abbrev)) t]
(if (fboundp 'pgr-alias-expand)
'["Expand-Pager-Alias" pgr-alias-expand t])
'["Insert-Mail-Alias" mail-interactive-insert-alias t]
'["Reload-Personal-Aliases" mailrc-reset t]
))
'("Fields"
["To-To-Field" mail-to t]
["To-Bcc-Field" mail-bcc t]
["To-Cc-Field" mail-cc t]
["To-Fcc-Field" mail-fcc t]
["To-Msg-Body" mail-text t]
["To-Subject-Field" mail-subject t]
["To-To-Field" mail-to t]
)
infodock-go-menu
'("Insertion"
["Fill-Original-Msg" mail-fill-yanked-message t]
["Insert-Buffer" insert-buffer t]
["Insert-Nontext-File" mime-editor/insert-file t]
["Insert-Text-File" insert-file t]
"----"
["Insert-Original-Msg" mail-yank-original t]
["Insert-Sent-Via" mail-sent-via t]
["Insert-Signature" mail-signature t]
)
(infodock-options-menu)
))
(id-menubar-set 'mail-mode 'id-menubar-mail)
(add-hook 'outline-load-hook (function (lambda () (require 'menus-otl))))
(defconst id-menubar-perl
(list
'("Perl"
["About" (describe-variable 'cperl-praise) t]
["Help" describe-mode t]
"----"
["Function-Doc" cperl-info-on-current-command t]
("Micro-Docs"
["Tips" (describe-variable 'cperl-tips) t]
["Non-Problems" (describe-variable 'cperl-non-problems) t]
["Problems" (describe-variable 'cperl-problems) t])
["Symbol-Doc" cperl-get-help t]
"----"
["Comment-Region" comment-region t]
["Fill-Comment-Paragraph" cperl-fill-paragraph t]
["Uncomment-Region" (comment-region
(region-beginning) (region-end) '(4)) t]
"----"
["Build-Lookup-Table-for-Dir" (cperl-write-tags nil nil t t) t]
"----"
["Prompt-&-Insert-Needed-Spaces" cperl-find-bad-style t]
"----"
["Enable-Debugging"
(gdbsrc-mode 1)
:active t
:included (and buffer-file-name
(boundp 'gdbsrc-mode) (not gdbsrc-mode))]
["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
'("Compile"
["Compile-Program" compile t]
;; InfoDock sometimes uses a command other than next-error to parse
;; errors, so the key binding is used instead.
["To-Next-Error" (call-interactively (key-binding "\C-x`"))
:active t
:keys "C-x `"]
)
infodock-debug-menu
infodock-edit-menu
infodock-go-menu
(cons "Highlight" infodock-highlighter-menu)
'("Indent-&-Mark"
["Align-Construct" cperl-lineup (cperl-use-region-p)]
["Indent-Expression" cperl-indent-exp t]
["Indent-Function" (progn (mark-defun)
(call-interactively
'cperl-indent-region)) t]
("Set-Indent-Style"
["GNU" (cperl-set-style "GNU") t]
["C++" (cperl-set-style "C++") t]
["FSF" (cperl-set-style "FSF") t]
["BSD" (cperl-set-style "BSD") t]
["Whitesmith" (cperl-set-style "Whitesmith") t]
)
["Mark-Expression" mark-sexp t]
["Mark-Function" mark-defun t]
"----"
["Beautify-Regexp" cperl-beautify-regexp
cperl-use-syntax-table-text-property]
["Beautify-Regexp-Grouping" cperl-beautify-level
cperl-use-syntax-table-text-property]
["Contract-Regexp-Grouping" cperl-contract-level
cperl-use-syntax-table-text-property]
["Fill-Comment-Paragraph" cperl-fill-paragraph t]
"----"
["Highlight-Hard-to-Parse-Areas" cperl-find-pods-heres t])
'("Jump-to"
["Identifier-Def" find-tag t]
["Set-Def-Lookup-Table" visit-tags-table t]
"----"
["Function-Beginning" beginning-of-defun t]
["Function-End" end-of-defun t]
["Line-Number" goto-line t])
(infodock-options-menu)
(infodock-software-menu)))
(id-menubar-set 'perl-mode 'id-menubar-perl)
(id-menubar-set 'cperl-mode 'id-menubar-perl)
(defconst id-menubar-python
(list
'("Python"
["Help" describe-mode t]
["Help-Python-Process" (describe-function 'py-shell) t]
"----"
["Comment-Region" comment-region t]
["Uncomment-Region" (comment-region
(region-beginning) (region-end) '(4)) t]
"----"
["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
'("Compile"
["Compile-Program" compile t]
;; InfoDock sometimes uses a command other than next-error to parse
;; errors, so the key binding is used instead.
["To-Next-Error" (call-interactively (key-binding "\C-x`"))
:active t
:keys "C-x `"]
)
infodock-debug-menu
infodock-edit-menu
infodock-go-menu
(cons "Highlight" infodock-highlighter-menu)
'("Indent-&-Mark"
["Indent-Block" (progn
(py-mark-block)
(call-interactively 'py-indent-region)) t]
["Indent-Class" (progn
(py-mark-def-or-class 1)
(call-interactively 'py-indent-region)) t]
["Indent-Def" (progn
(py-mark-def-or-class)
(call-interactively 'py-indent-region)) t]
["Indent-Region" indent-region t]
["Mark-Block" py-mark-block t]
["Mark-Class" (py-mark-def-or-class 1) t]
["Mark-Def" py-mark-def-or-class t]
["Mark-Expression" mark-sexp t])
'("Jump-to"
["Identifier-Def" find-tag t]
["Set-Def-Lookup-Table" visit-tags-table t]
"----"
["Def-Beginning" py-beginning-of-def-or-class t]
["Def-End" py-end-of-def-or-class t]
["Line-Number" goto-line t])
(infodock-options-menu)
(infodock-software-menu)))
(id-menubar-set 'python-mode 'id-menubar-python)
(defconst id-menubar-rmail
(list
'("Rmail"
["Help" describe-mode t]
["Manual" (id-info "(rmail)Top") t]
"----"
["Get-New-Mail" rmail-get-new-mail t]
"----"
["Wipe-Away-Folder" rmail-wipe t]
["Wipe-Away-Summary" rmail-wipe-summary t]
["Quit" (id-tool-quit 'rmail-quit) t]
)
'("Folder"
["Get-New-Mail" rmail-get-new-mail t]
"----"
["Open" rmail-input t]
"----"
["Search-Bodies" rmail-search t]
["Search-Subjects" rmail-search-for-subject t]
"----"
["Expunge" rmail-expunge t]
["Expunge-and-Save" rmail-expunge-and-save t]
["Expunge-Duplicates" id-maildup-expunge-rmail t]
["Kill-this-Subject" rmail-kill-subject t]
"----"
["To-First-Msg" rmail-first-message t]
["To-Final-Msg" rmail-last-message t]
)
infodock-go-menu
'["Jump-to-Msg" rmail-show-message t]
'("Label"
["Add" rmail-add-label t]
["Delete" rmail-kill-label t]
"----"
["Summarize-by-Labels" rmail-summary-by-labels t]
"----"
["To-Next-Labeled-Msg" rmail-next-labeled-message t]
["To-Prev-Labeled-Msg" rmail-previous-labeled-message t]
)
'("Message"
["Pretty-Print" id-rmail-pretty-print-message t]
["Print" id-rmail-print-message t]
"----"
["Delete-Forward" rmail-delete-forward t]
["Delete-Backward" rmail-delete-backward t]
["Undelete" rmail-undelete-previous-message t]
"----"
["Compose" rmail-mail t]
["Continue-Composing" rmail-continue t]
["Forward" rmail-forward t]
["Resend" rmail-resend t]
["Reply" rmail-reply t]
["Retry-Bounced-Msg" rmail-retry-failure t]
"----"
["Edit" rmail-edit-current-message t]
"----"
["Save-as-Rmail" rmail-output-to-rmail-file t]
["Save-as-Mail" rmail-output t]
"----"
["Toggle-Header" rmail-toggle-header t]
)
'("Move"
["Jump-to" rmail-show-message t]
["To-Beginning" rmail-beginning-of-message t]
["To-End" end-of-buffer t]
"----"
["Next-Undeleted" rmail-next-undeleted-message t]
["Next-Any" rmail-next-message t]
["Next-Same-Subject" rmail-next-same-subject t]
"----"
["Prev-Undeleted" rmail-previous-undeleted-message t]
["Prev-Any" rmail-previous-message t]
["Prev-Same-Subject" rmail-previous-same-subject t]
)
(infodock-options-menu)
'("Sort"
["by-Author" rmail-sort-by-author t]
["by-Date" rmail-sort-by-date t]
["by-Lines" rmail-sort-by-lines t]
["by-Recipient" rmail-sort-by-recipient t]
["by-Subject" rmail-sort-by-subject t]
)
'("Summary"
["Create" rmail-summary t]
["by-Addresses" rmail-summary-by-recipients t]
["by-Labels" rmail-summary-by-labels t]
["by-Regexp" rmail-summary-by-regexp t]
["by-Topic" rmail-summary-by-topic t]
)
))
(id-menubar-set 'rmail-mode 'id-menubar-rmail)
(defconst id-menubar-rmail-edit
(list
'("Rmail-Edit"
["Help" describe-mode t]
["Manual" (id-info "(rmail)Rmail Editing") t]
"----"
["Abort-Msg-Edit" rmail-abort-edit t]
["Finish-Msg-Edit" rmail-cease-edit t]
)
'["Abort-Msg-Edit" rmail-abort-edit t]
infodock-edit-menu
'["Finish-Msg-Edit" rmail-cease-edit t]
infodock-go-menu
(infodock-options-menu)
infodock-replace-menu
infodock-search-menu
))
(id-menubar-set 'rmail-edit-mode 'id-menubar-rmail-edit)
(defconst id-menubar-rmail-summary
(list
'("Rmail-Summary"
["Help" describe-mode t]
["Manual" (id-info "(rmail)Rmail Summary") t]
"----"
["Get-New-Mail" rmail-summary-get-new-mail t]
"----"
["Wipe-Away-Summary" rmail-summary-wipe t]
["Wipe-Away-Folder" rmail-summary-wipe-folder t]
["Quit" (id-tool-quit 'rmail-summary-quit) t]
)
'("Folder"
["Get-New-Mail" rmail-summary-get-new-mail t]
"----"
["Open" rmail-summary-input t]
"----"
["Search" rmail-summary-search t]
"----"
["Expunge" rmail-summary-expunge t]
["Expunge-and-Save" rmail-summary-expunge-and-save t]
"----"
["To-First-Msg" rmail-summary-first-message t]
["To-Final-Msg" rmail-summary-last-message t]
)
infodock-go-menu
'["Jump-to-Msg" rmail-summary-goto-msg t]
'("Label"
["Add" rmail-summary-add-label t]
["Delete" rmail-summary-kill-label t]
"----"
["Summarize-by-Labels" rmail-summary-by-labels t]
"----"
["To-Next-Labeled-Msg" rmail-summary-next-labeled-message t]
["To-Prev-Labeled-Msg" rmail-summary-previous-labeled-message t]
)
'("Message"
["Pretty-Print" id-rmail-pretty-print-message t]
["Print" id-rmail-print-message t]
"----"
["Delete-Forward" rmail-summary-delete-forward t]
["Delete-Backward" rmail-summary-delete-backward t]
["Undelete" rmail-summary-undelete t]
["Undelete-Many" rmail-summary-undelete-many t]
"----"
["Compose" rmail-summary-mail t]
["Continue-Composing" rmail-summary-continue t]
["Forward" rmail-summary-forward t]
["Reply" rmail-summary-reply t]
["Retry-Bounced-Msg" rmail-summary-retry-failure t]
"----"
["Edit" rmail-summary-edit-current-message t]
"----"
["Save-as-Rmail" rmail-summary-output-to-rmail-file t]
["Save-as-Mail" rmail-summary-output t]
"----"
["Toggle-Header" rmail-summary-toggle-header t]
)
'("Move"
["Jump-to" rmail-summary-goto-msg t]
["To-Beginning" rmail-summary-beginning-of-message t]
"----"
["Next-Undeleted" rmail-summary-next-msg t]
["Next-Any" rmail-summary-next-all t]
"----"
["Prev-Undeleted" rmail-summary-previous-msg t]
["Prev-Any" rmail-summary-previous-all t]
)
(infodock-options-menu)
'("Sort"
["by-Author" rmail-summary-sort-by-author t]
["by-Date" rmail-summary-sort-by-date t]
["by-Lines" rmail-summary-sort-by-lines t]
["by-Recipient" rmail-summary-sort-by-recipient t]
["by-Subject" rmail-summary-sort-by-subject t]
)
'("Summary"
["Create" rmail-summary-summary t]
["by-Addresses" rmail-summary-by-recipients t]
["by-Labels" rmail-summary-by-labels t]
["by-Regexp" rmail-summary-by-regexp t]
["by-Topic" rmail-summary-by-topic t]
)
))
(id-menubar-set 'rmail-summary-mode 'id-menubar-rmail-summary)
(defconst id-menubar-shell
(list
'("Shell"
["Help" describe-mode t]
["Manual" (id-info "(xemacs)Shell") t]
"----"
["Complete-an-Arg" comint-dynamic-complete t]
"----"
["New" new-shell t]
"----"
["Show-History" comint-dynamic-list-input-ring t]
"----"
["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
'("Execute"
["Kill-Subjob" comint-interrupt-subjob t]
["Send-EOF-to-Subjob" comint-send-eof t]
["Send-QUIT-to-Subjob" comint-quit-subjob t]
["Stop-Subjob" comint-stop-subjob t]
)
infodock-go-menu
'("I/O"
["Erase-Input" comint-kill-input t]
["Erase-Prior-Output" comint-kill-output t]
["To-Output-Start" comint-show-output t]
["To-Output-End" comint-show-maximum-output t]
["Redo-Prev-Command" comint-previous-matching-input-from-input t]
["Redo-Next-Command" comint-next-matching-input-from-input t]
)
(infodock-options-menu)
))
(id-menubar-set 'shell-mode 'id-menubar-shell)
(defconst id-menubar-text (id-menubar-edit "Text" "(xemacs)Text"))
(id-menubar-set 'text-mode 'id-menubar-text)
(defconst id-menubar-tcl
(list
'("Tcl"
["Help" describe-mode t]
["Help-Tcl-Process" (let ((major-mode 'inferior-tcl-mode)
(mode-name "Inferior Tcl")
(minor-mode-alist nil))
(describe-mode))
(fboundp 'inferior-tcl-mode)]
"----"
["Comment-Region" comment-region t]
["Uncomment-Region" (comment-region
(region-beginning) (region-end) '(4)) t]
"----"
["Enable-Debugging"
(gdbsrc-mode 1)
:active t
:included (and buffer-file-name
(boundp 'gdbsrc-mode) (not gdbsrc-mode))]
["Quit" (id-tool-quit '(kill-buffer nil)) t]
)
'("Compile"
["Compile-Program" compile t]
;; InfoDock sometimes uses a command other than next-error to parse
;; errors, so the key binding is used instead.
["To-Next-Error" (call-interactively (key-binding "\C-x`"))
:active t
:keys "C-x `"]
)
infodock-debug-menu
infodock-edit-menu
infodock-go-menu
(cons "Highlight" infodock-highlighter-menu)
'("Indent-&-Mark"
["Indent-Function" tcl-indent-defun t]
["Indent-Region" indent-region t]
["Mark-Expression" mark-sexp t]
["Mark-Function" tcl-mark-defun t])
'("Jump-to"
["Identifier-Def" find-tag t]
["Set-Def-Lookup-Table" visit-tags-table t]
"----"
["Function-Beginning" tcl-beginning-of-defun t]
["Function-End" tcl-end-of-defun t]
["Line-Number" goto-line t])
(infodock-options-menu)
(infodock-software-menu)))
(id-menubar-set 'tcl-mode 'id-menubar-tcl)
(defconst id-menubar-ups
(list
'("Process-Manager"
["Help" describe-mode t]
"----"
["Show-Command-Pathnames" (progn (setq ups-show-command-paths
(not ups-show-command-paths))
(ups-build-process-list))
:style toggle :selected ups-show-command-paths]
"----"
["Quit" (id-tool-quit 'ups-quit) t]
)
'("Execute"
["Redisplay-Process-List" ups-build-process-list t]
["Redisplay-Next-Format" ups-next-arg t]
["Send-All-Signals" ups-issue-signals t]
["Unmark-Process" ups-mark-unmark t]
)
infodock-go-menu
(infodock-options-menu)
'("Signal"
["Continue-from-Stop" ups-mark-cont t]
["Hangup-Process" ups-mark-hangup t]
["Interrupt-Process" ups-mark-int t]
["Kill-Process" ups-mark-kill t]
["Lower-Process-Priority" ups-mark-nice t]
["Quit-Process" ups-mark-quit t]
["Signal-Alarm-Time" ups-mark-alarm t]
["Signal-Bus-Error" ups-mark-bus t]
["Signal-Segmentation-Violation" ups-mark-segv t]
["Stop-Process" ups-mark-stop t]
["Terminate-Process" ups-mark-term t]
)
))
(id-menubar-set 'ups-mode 'id-menubar-ups)
(defconst id-menubar-waisd
(list
'("WAIS"
["Help" waisd-help t]
"----"
["To-Best-Match-Line" waisd-best-line t]
"----"
["Quit" (id-tool-quit 'waisd-exit) t]
)
infodock-go-menu
(infodock-options-menu)
))
(id-menubar-set 'waisd-mode 'id-menubar-waisd)
(defun id-menubar-waisq ()
(list
'("WAIS"
["Help" wais-help t]
"----"
["Quit" (id-tool-quit 'wais-exit) t])
infodock-go-menu
(let ((b (buffer-name)))
(cond ((string-match ": Find Documents On" b)
(list
"Question"
'["Create-Question" wais-create-question t]
(cons
"Select-Question"
(mapcar
(function
(lambda (ques)
(vector ques (list 'display-question ques) t)))
(all-questions)))
'["Submit-Question" wais-query t]
))
((string-match ": Similar To" b)
'("Relevance"
["Remove-Relevance-Docs" wais-delete-reldocs t])
)
((string-match ": On Sources" b)
(list
(cons
"Data-Sources"
(mapcar
(function
(lambda (source)
(vector source (list 'wais-add-source source) t)))
(mapcar 'car (all-sources))))
'["Remove-All-Sources" wais-delete-sources t]
))
((string-match ": Results" b)
(list
"Results"
'["Retrieve-Doc" wais-edit t]
'["To-Best-Match-Line" waisq-best-line t]
'["Save-Doc" wais-save-document t]
(vector
(format "Set-Max-Doc-Matches (= %d)" *wais-maximum-result-documents*)
'(setq *wais-maximum-result-documents*
(read-number (format
"Max doc matches per question (current = %d): "
*wais-maximum-result-documents*)
t))
t)
(vector
(format "Toggle-Multiple-Doc-Buffers (= %s)"
(if *wais-multiple-document-buffers* "many" "one"))
'(progn
(setq *wais-multiple-document-buffers*
(not *wais-multiple-document-buffers*))
(message (concat "Now using one buffer "
(if *wais-multiple-document-buffers*
"per document."
"for all documents."))))
t)
))
))
(infodock-options-menu)
))
(id-menubar-set 'waisq-mode 'id-menubar-waisq)
;;; ************************************************************************
;;; Private functions
;;; ************************************************************************
(or (fboundp 'new-buffer-name)
(defun new-buffer-name (name)
(if (get-buffer name)
(let ((num 1)
(form (concat name "<%d>")))
(while (get-buffer (setq name (format form num)))
(setq num (1+ num)))))
name))
;;; ************************************************************************
;;; Private variables
;;; ************************************************************************
;;!emacs
;;
;; FILE: id-menus.el
;; SUMMARY: Standard InfoDock menubar.
;; USAGE: XEmacs Lisp Library
;;
;; AUTHOR: Bob Weiner
;; ORG: BeOpen.com
;;
;; Copyright (C) 1992-1999 BeOpen.com
;; Licensed under the GNU General Public License, version of your choice.
;;
;; This file is part of InfoDock.
;;
;; ORIG-DATE: 13-Aug-92 at 12:42:50
;; LAST-MOD: 23-Jun-16 at 10:39:49 by Bob Weiner
;; We're provide'ing at the top to avoid infinite require loops later on.
(provide 'id-menus)
;; Setup for debugging on error at an early stage within the
;; startup cycle (this is the first file loaded on `before-init-hook')
;; if the -debug-init command-line option has been given. Do not
;; remove this. -- Bob Weiner, 06/10/1999
(if (member "-debug-init" (cdr command-line-args))
(setq debug-on-error t))
;; Do all of this only once at startup
;; but don't do it if using -no-autoloads or -batch. -sb
(unless (featurep 'id-faces)
(unless (not (and infodock-xemacs-flag (window-system)))
(require 'id-x-toolbar)
;;
;; Set the toolbar colors at run-time as soon as possible.
(when (and (boundp 'id-toolbar-foreground-color)
(fboundp 'customize-set-variable))
(customize-set-variable
'id-toolbar-foreground-color
(or (and (featurep 'x)
(x-get-resource "foregroundToolBarColor" "ForegroundToolBarColor"
'string))
id-toolbar-foreground-color))
(customize-set-variable
'id-toolbar-background-color
(or (color-name (or (face-background 'default) "wheat"))
id-toolbar-background-color)))
;; Setup initial toolbar
;; Initialize to prior toolbar and then select the next one after
;; id-set-toolbar-colors to ensure that most of the initialization time
;; within the calls to `id-set-toolbar-colors' is spent looking at the
;; proper toolbar. This is all necessary since the default toolbar
;; does not update properly when its colors change.
(id-select-toolbar 2))
(cond
;; Setup gray and white color scheme and other defaults for HP OpenView
((and infodock-xemacs-flag
(or (eq system-type 'hpux)
(equal (color-name (face-background 'default)) "gray92"))
(null noninteractive))
;; Setting this to 'transparent did not work for some reason. -- BW
(setq display-time-display-time-background "#c0c0c0")
;; Position toolbar to the top and make it Motif gray
(when (and infodock-xemacs-flag (window-system))
(id-set-toolbar-colors "black" "#c0c0c0")
(id-select-toolbar)
(id-set-toolbar-position 'top))
;; Select Motif/Microsoft Windows cut & paste keybindings
(setq id-mswindows-keys-flag t)
;; Select Motif/Microsoft Windows style DEL keypad behavior
(setq delete-key-deletes-forward t)
;; Don't turn on font lock twice in Java mode
(setq jde-use-font-lock nil)
)
((and infodock-xemacs-flag (window-system))
(id-set-toolbar-colors)
(id-select-toolbar))))
(defvar put-buffer-names-in-file-menu t
"*Boolean flag that determines whether or not buffer names are shown on the InfoDock and File menus.")
(defvar id-hyperbole-p (featurep 'hyperbole-autoloads)
"Don't touch this.
Non-nil if Hyperbole is present.")
(defgroup id-menus nil
"InfoDock menubar customizations."
:prefix "id-"
:tag "Menus"
:group 'infodock)
(defconst id-all-configurable-menus
'(Abbreviations BeOpen-Support
Buffer Case Cscope Directory Display Edit Fill&Justify File
Frame Go Help Highlighter Hyperbole Indent InfoDock Key Kill Mark Menubar
Options Pretty-Printing Rectangle Region Replace Search
Software Spell-Check Tool Version-Control Web Window X-Selection
XEmacs-Lisp)
"List of InfoDock menu symbols which may be hidden from use by the user.")
;; Don't do this if -batch or -no-autoloads or when byte-compiling. -sb
(when (and (fboundp 'customize-set-variable)
(not noninteractive))
(customize-set-variable 'menubar-configuration
(copy-sequence id-all-configurable-menus)))
;; This is a per-session variable that should not be made a custom option.
(defvar id-tool-mode-frame-alist nil
"Association list of (TOOL-MAJOR-MODE . TOOL-FRAME-NAME-SYMBOL) pairs.")
(or (fboundp 'keywordp)
(defun keywordp (object)
"T if OBJECT is a keyword."
(and (symbolp object) (eq ?: (aref (symbol-name object) 0)))))
(or (fboundp 'font-name)
(defalias 'font-name 'x-font-name))
;;; ************************************************************************
;;; User settable Tool and Tool Manual Section Display Commands
;;; ************************************************************************
(defvar id-tool-calculator
(function (lambda () (id-tool '(calc nil t t) 'Calculator 'calc-mode 1)))
"*Function to invoke Calculator tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-calculator'.")
(defvar id-man-calculator
(function (lambda () (id-info "(calc)")))
"*Function to display Calculator tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-calculator'.")
(defvar id-tool-calendar
(function (lambda () (id-tool 'calendar 'Calendar 'calendar-mode 1)))
"*Function to invoke Calendar tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-calendar'.")
(defvar id-man-calendar
(function (lambda () (id-info "(xemacs)Calendar/Diary")))
"*Function to display Calendar tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-calendar'.")
(defvar id-tool-compiler
(function (lambda () (id-tool 'id-compile 'Compilation 'compilation-mode 1)))
"*Function to invoke Compiler tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-compiler'.")
(defvar id-man-compiler
(function (lambda () (id-info "(infodock)Compilation")))
"*Function to display Compiler tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-compiler'.")
(defvar id-default-debugger 'idgdbsrc
"*Command (a symbol) used to invoke a debugger from a menu or toolbar.")
(defvar id-tool-debugger 'iddebug
"*Function to invoke Debugger tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-debugger'.")
(defvar id-man-debugger
(function (lambda () (id-info "(infodock)Debugging")))
"*Function to display Debugger tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-debugger'.")
(defvar id-tool-directory-editor
(function (lambda () (id-tool 'dired 'Directory-Editor 'dired-mode)))
"*Function to invoke Directory-Editor tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-directory-editor'.")
(defvar id-man-directory-editor
(function (lambda () (id-info "(xemacs)Dired")))
"*Function to display Directory-Editor tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-directory-editor'.")
(defvar id-man-editor
(function (lambda () (id-info "(infodock)Edit Menu")))
"*Function to display Editor manual.
A string value is executed as a shell command to run an external program.")
(defvar id-tool-full-text-retriever
(function (lambda () (id-tool 'wais 'Full-Text-Retriever 'waisq-mode 1)))
"*Function to invoke Full-Text-Retriever tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-full-text-retriever'.")
(defvar id-man-full-text-retriever 'wais-help
"*Function to display Full-Text-Retriever tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-full-text-retriever'.")
(defvar id-tool-info-browser
(function (lambda () (id-info nil id-tool-visible-flag)))
"*Function to invoke Info-Browser tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-info-browser'.")
(defvar id-man-info-browser
(function (lambda () (id-info "(info)")))
"*Function to display Info-Browser tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-info-browser'.")
(defvar id-tool-load-manager
(function (lambda () (id-tool '(id-term "top" "top")
'Load-Manager 'term-mode 1)))
"*Function to invoke Load-Manager tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-load-manager'.")
(defvar id-man-load-manager
(function (lambda () (id-info "(top.1)*")))
"*Function to display Load-Manager tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-load-manager'.")
(defvar id-tool-mail-composer
(function (lambda () (id-tool 'mail 'Mail-Composer 'mail-mode)))
"*Function to invoke Mail-Composer tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-mail-composer'.")
(defvar id-man-mail-composer
(function (lambda () (id-info "(Rmail)Rmail Reply")))
"*Function to display Mail-Composer tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-mail-composer'.")
(defvar id-tool-mail-read-file
(function (lambda () (id-tool 'rmail 'Mail-Reader 'rmail-mode)))
"*Function to invoke Mail-Read-File tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-mail-read-file'.")
(defvar id-man-mail-read-file
(function (lambda () (id-info "(Rmail)Rmail Files")))
"*Function to display Mail-Read-File tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-mail-read-file'.")
(defvar id-tool-mail-reader
(function (lambda () (let ((id-tool-visible-flag 'visible)
(mjr-mode 'rmail-mode))
(id-read-mail))))
"*Function to invoke Mail-Reader tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-mail-reader'.")
(defvar id-man-mail-reader
(function (lambda () (id-info "(Rmail)Top")))
"*Function to display Mail-Reader tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-mail-reader'.")
(defvar id-tool-man-page-browser
(function (lambda ()
(setq sm-notify
(if id-tool-new-frame-flag 'bully 'friendly))
(id-tool 'manual-entry 'Man-Page-Browser 'sm-manual-mode)))
"*Function to invoke Man-Page-Browser tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-man-page-browser'.")
(defvar id-man-man-page-browser
(function (lambda () (id-info "(xemacs)Documentation")))
"*Function to display Man-Page-Browser tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-man-page-browser'.")
(defvar id-tool-netnews-composer
(function (lambda () (id-tool 'message-news 'NetNews-Composer
'message-mode 1)))
"*Function to invoke NetNews-Composer tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-netnews-composer'.")
(defvar id-man-netnews-composer
(function (lambda () (id-info "(gnus)Composing Messages")))
"*Function to display NetNews-Composer tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-netnews-composer'.")
(defvar id-tool-netnews-reader
(function (lambda () (id-tool 'gnus 'NetNews-Reader 'gnus-group-mode 1)))
"*Function to invoke NetNews-Reader tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-netnews-reader'.")
(defvar id-man-netnews-reader
(function (lambda () (id-info "(gnus)")))
"*Function to display NetNews-Reader tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-netnews-reader'.")
(defvar id-tool-oo-browser
(function (lambda () (id-tool 'oo-browser 'OO-Browser 'br-mode 1)))
"*Function to invoke OO-Browser tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-oo-browser'.")
(defvar id-man-oo-browser
(function (lambda () (id-info "(oo-browser)Top")))
"*Function to display OO-Browser tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-oo-browser'.")
(defvar id-tool-outliner
(function (lambda ()
(id-tool 'kfile:find 'Hyperbole-Outliner 'kotl-mode nil)))
"*Function to invoke Outliner tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-outliner'.")
(defvar id-man-outliner
(function (lambda () (id-info "(hyperbole)Koutliner")))
"*Function to display Outliner tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-outliner'.")
(defvar id-tool-page-composer
(function (lambda ()
(require 'alpha-page)
(id-tool 'page 'Page-Composer 'mail-mode 1)))
"*Function to invoke Page-Composer tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-page-composer'.")
(defvar id-man-page-composer
(function (lambda () (id-info "(infodock)Page-Composer")))
"*Function to display Page-Composer tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-page-composer'.")
(defvar id-tool-process-manager
(function (lambda () (id-tool 'ups 'Process-Manager 'ups-mode 1)))
"*Function to invoke Process-Manager tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-process-manager'.")
(defvar id-man-process-manager
(function (lambda ()
(let ((major-mode 'ups-mode)
(mode-name "Ups"))
(require 'ups)
(describe-mode))))
"*Function to display Process-Manager tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-process-manager'.")
(defvar id-tool-rolo
(function (lambda () (id-tool-invoke 'rolo-fgrep)))
"*Function which runs a string search in the Rolo tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-rolo'.")
(defvar id-man-rolo
(function (lambda () (id-info "(hyperbole)Rolo")))
"*Function to display Rolo tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-rolo'.")
(defvar id-tool-ansi-terminal
(function (lambda ()
(id-tool
(lambda ()
(call-interactively 'term)
(message "Type C-c <cmd keys> to issue InfoDock cmds in this buffer."))
'ANSI-Terminal 'term-mode)))
"*Function to invoke an ANSI/VT100-style display application.
A string value is used as the ANSI display application to run.
See also the documentation for `id-man-ansi-terminal'.")
(defvar id-man-ansi-terminal
(function (lambda () (id-info "(term)Top")))
"*Function to display ANSI-Terminal tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-ansi-terminal'.")
(defvar id-tool-same-shell
(function (lambda () (id-tool 'shell 'Shell 'shell-mode)))
"*Function to invoke or redisplay the Shell tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-same-shell'.")
(defvar id-man-same-shell
(function (lambda () (id-info "(xemacs)Shell")))
"*Function to display the Shell tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-same-shell'.")
(defvar id-tool-new-shell
(function (lambda ()
(let ((id-tool-visible-flag 'visible))
(id-tool 'new-shell 'Shell 'shell-mode))))
"*Function to invoke New-Shell tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-same-shell'.")
(defvar id-tool-secure-shell
(function (lambda () (id-tool 'ssh 'Secure-Shell 'ssh-mode)))
"*Function to invoke a Secure Shell tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-secure-shell'.")
(defvar id-man-secure-shell
(function (lambda () (describe-function 'ssh)))
"*Function to display documentation for the Secure Shell tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-secure-shell'.")
(defvar id-tool-speedbar
(function (lambda ()
(let ((id-tool-new-frame-flag nil))
(id-tool 'speedbar 'Speedbar 'speedbar-mode))))
"*Function to invoke the Speedbar directory and file navigator.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-speedbar'.")
(defvar id-man-speedbar
(function (lambda () (require 'speedbar)
(describe-function 'speedbar-mode)))
"*Function to display documentation for the Speedbar directory and file navigator.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-speedbar'.")
(defvar id-tool-spell-checker 'ispell-region-or-buffer
"*Function to invoke Spell Checker tool on a region or buffer.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-spell-checker'.")
(defvar id-man-spell-checker
(function (lambda () (id-info "(ispell)Top")))
"*Function to display Spell Checker manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-spell-checker'.")
(defvar id-tool-world-wide-web
(function (lambda () (id-tool 'w3 'WWW 'w3-mode)))
"*Function to invoke World-Wide-Web tool.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-man-world-wide-web'.")
(defvar id-man-world-wide-web
(function (lambda () (id-info "(w3)Top")))
"*Function to display World-Wide-Web tool manual.
A string value is executed as a shell command to run an external program.
See also the documentation for `id-tool-world-wide-web'.")
;;; ************************************************************************
;;; User settable Menubar Type, Fonts, Colors, and Frame per Tool Settings
;;; ************************************************************************
(defcustom infodock-categorize-buffers nil
"*If non-nil, the buffer list on the Jump menu is categorized by major mode.
By default or when this is nil, the last `buffers-menu-max-size' used buffers
are listed in their order of most recent use."
:type 'boolean
:group 'id-menus)
(defcustom infodock-menubar-type 'menubar-infodock
"*Current type of per frame menubar.
Any of the following symbols are valid values:
menubar-infodock (default) - menubar of global InfoDock commands
menubar-modes - unique menubar for each major mode
menubar-simple - PC-type menubar with a simple set of commands
menubar-xemacs - XEmacs editor menubar."
:type '(choice (const menubar-infodock)
(const menubar-modes)
(const menubar-simple)
(const menubar-xemacs))
:group 'id-menus)
(defvar infodock-previous-menubar-type infodock-menubar-type
"Prior type of per frame menubar.
Used when toggling from one type of menubar to another.")
(defvar id-default-font nil
"Default font setting for new frames if a valid font value.")
(defcustom id-add-left-mode-menu-flag t
"*Non-nil means the left-most menu from the current non-mode-specific menubar type will be prepended to mode menubars."
:type 'boolean
:group 'id-menus)
(defcustom id-minor-mode-flag nil
"*Non-nil means Mode/Minor menu items affect only the current buffer.
Nil (default) means they affect all current and future buffers with the same
major mode as the current buffer."
:type 'boolean
:group 'id-menus)
(defcustom id-site-file-menu-path "/alt/BeOpen.com/"
"*Pathname to the root of a site directory of files to place on the menubar or nil.
If the pathname does not exist at the local site, it is ignored.
This must end with a directory separator character."
:type 'string
:initialize 'custom-initialize-default
:set (lambda (symbol value)
(if (and (stringp value) (not (eq id-site-file-menu-path value)))
(progn (setq id-site-file-menu-path
(file-name-as-directory value))
(id-add-site-file-menu t))
(setq id-site-file-menu-path (file-name-as-directory value))))
:group 'id-menus)
(defcustom id-tool-new-frame-flag t
"*If non-nil, Tool menu items are launched within new frames.
Otherwise, the current frame is used."
:type 'boolean
:initialize 'custom-initialize-default
:set (lambda (symbol value)
(if value (id-tool-new-frame)
(id-tool-this-frame)))
:group 'id-menus)
(defcustom id-tool-names-flag nil
"*Non-nil means show command names next to InfoDock Tool menu entries."
:type 'boolean
:initialize 'custom-initialize-default
:set (lambda (symbol value)
(if value
(id-toggle-tool-command-names 1)
(id-toggle-tool-command-names 0)))
:group 'id-menus)
(defvar id-good-fonts
'(
("Courier-Bold"
["8" "-adobe-courier-bold-r-*-*-*-80-75-75-*-*-*-*"]
["10" "-adobe-courier-bold-r-*-*-*-100-75-75-*-*-*-*"]
["12" "-adobe-courier-bold-r-*-*-*-120-75-75-*-*-*-*"]
["14" "-adobe-courier-bold-r-*-*-*-140-75-75-*-*-*-*"]
["18" "-adobe-courier-bold-r-*-*-*-180-75-75-*-*-*-*"]
["24" "-adobe-courier-bold-r-*-*-*-240-75-75-*-*-*-*"])
"----"
("Courier-Medium"
["8" "-adobe-courier-medium-r-*-*-*-80-75-75-*-*-*-*"]
["10" "-adobe-courier-medium-r-*-*-*-100-75-75-*-*-*-*"]
["12" "-adobe-courier-medium-r-*-*-*-120-75-75-*-*-*-*"]
["14" "-adobe-courier-medium-r-*-*-*-140-75-75-*-*-*-*"]
["18" "-adobe-courier-medium-r-*-*-*-180-75-75-*-*-*-*"]
["24" "-adobe-courier-medium-r-*-*-*-240-75-75-*-*-*-*"])
"----"
("Fixed-Bold"
["12" "-misc-fixed-bold-r-*-*-*-120-75-75-*-*-*-*"]
["14" "-misc-fixed-bold-r-*-*-*-140-75-75-*-*-*-*"])
"----"
("Fixed-Medium"
["8" "-misc-fixed-medium-r-*-*-*-80-75-75-*-*-*-*"]
["9" "-misc-fixed-medium-r-*-*-*-90-75-75-*-*-*-*"]
["10" "-misc-fixed-medium-r-*-*-*-100-75-75-*-*-*-*"]
["12" "-misc-fixed-medium-r-*-*-*-120-75-75-*-*-*-*"]
["13" "-misc-fixed-medium-r-*-*-*-130-75-75-*-*-*-*"]
["14" "-misc-fixed-medium-r-*-*-*-140-75-75-*-*-*-*"]
["20" "-misc-fixed-medium-r-*-*-*-200-75-75-*-*-*-*"])
"----"
("Lucida"
["12" "lucidasanstypewriter-12"]
["14-bold" "lucidasanstypewriter-bold-14"]
["24-bold" "lucidasanstypewriter-bold-24"])
"----"
"5x8"
"6x9"
"6x10"
["7x10" "vshd"]
"7x13"
["7x13bold" "terminal-bold"]
"7x14"
["7x14bold" "vtbold"]
"8x16"
"9x15"
"9x15bold"
"10x20"
"12x24"
)
"*List of monospace fonts suitable for use by InfoDock, organized into a menu structure.
Entries may be of any of the following forms:
\"window-system-specific-name-for-font\"
[\"menu-display-name-for-font\" \"window-system-specific-name-for-font\"]
(\"name-of-submenu-of-fonts\" <entry> ... <entry>)")
(defvar id-good-colors
'("black" "blue" "dark goldenrod" "dark green" "dark orchid" "deep pink"
"DodgerBlue3" "firebrick1" "forest green" "gray55" "green"
"IndianRed4" "light salmon" "LightSalmon3" "medium violet red"
"medium sea green" "MistyRose4" "navy blue" "orange" "OrangeRed2"
"pink" "purple" "purple4" "red" "slate grey" "tomato3" "turquoise4"
"wheat" "wheat3" "white" "yellow" )
"*Good colors for contrast against wheat background and black foreground.")
(defun menubar-infodock ()
"Set frame menubars to the default InfoDock menubar of global commands."
(interactive)
;;
;; Flag that InfoDock global menubars are on.
(if (not (eq infodock-menubar-type 'menubar-infodock))
(setq infodock-previous-menubar-type infodock-menubar-type))
(setq infodock-menubar-type 'menubar-infodock
activate-menubar-hook nil
default-menubar infodock-menubar)
;;
;; For new versions of Emacs 19, turn off mode-specific menubars.
(if (boundp 'inhibit-local-menu-bar-menus)
(setq inhibit-local-menu-bar-menus t))
;;
(set-menubar infodock-menubar)
;; Reset all buffers with local menubars to default.
(id-reset-local-menubars)
;; Add site-local menu of files, if appropriate.
(id-add-site-file-menu nil))
(defvar id-site-file-menu-cache nil
"Saves site file menu to avert rebuilding each time menus are reloaded.
The format is (id-site-file-menu-path . menu).")
(defun id-add-site-file-menu (force-update-flag)
"Add site-specific menu of files to the menubar if appropriate.
Each file is copied before it is displayed to prevent multiple users from
overwriting the source files."
(interactive "P")
(let (menu-path)
(if (and (stringp id-site-file-menu-path)
(setq menu-path (list (file-name-nondirectory
(directory-file-name
id-site-file-menu-path))))
(file-readable-p id-site-file-menu-path)
(or force-update-flag
(not (car (find-menu-item current-menubar menu-path)))))
(condition-case ()
(let (menu)
(require 'id-docmenu)
(if (and (consp id-site-file-menu-cache)
(equal (car id-site-file-menu-cache)
id-site-file-menu-path))
;; Use cached menu value.
(setq menu (cdr id-site-file-menu-cache))
;; Build menu.
;; Add an empty dummy menu right away to give the user
;; quick feedback in case menu building takes a while.
(add-submenu nil menu-path)
(sit-for 0.01)
(setq menu (id-docmenu-create id-site-file-menu-path))
(setq menu
(nconc
(list (car menu)
'["Rebuild-Menu" (id-add-site-file-menu t) t]
"----")
(cdr menu)))
(setq id-site-file-menu-cache
(cons id-site-file-menu-path menu)))
(add-submenu nil menu)
(setq infodock-menubar current-menubar
default-menubar current-menubar))
(error nil)))))
(defun menubar-modes ()
"Set up a major mode-specific menubar for each buffer."
(interactive)
(require 'id-menubars)
;; Make sure Hyperbole menu is expanded
(if id-hyperbole-p (id-hyperbole-menu-filter nil))
;; Flag that mode-specific menubars are on.
(if (not (eq infodock-menubar-type 'menubar-modes))
(setq infodock-previous-menubar-type infodock-menubar-type))
(setq infodock-menubar-type 'menubar-modes
activate-menubar-hook nil)
;; Leave default-value of default-menubar as is since we use this to
;; generate the left menu of mode-specific menubars.
;;
;; Turn on mode-specific menubars.
;;
;; For new versions of Emacs 19, turn on mode-specific menubars.
(if (boundp 'inhibit-local-menu-bar-menus)
(setq inhibit-local-menu-bar-menus nil))
;;
;; Give user quick feedback that the operation is working by changing
;; the current buffer's menubar first.
(id-set-mode-menubar) (sit-for 0.01)
;;
(let ((obuf (current-buffer)))
(unwind-protect
(progn
;;
;; Change all default menubars to mode-specific menubars, wherever
;; possible.
(mapcar (function
(lambda (buf)
(set-buffer buf)
(id-set-mode-menubar)))
;; We already did the first (current) buffer.
(cdr (buffer-list))))
(set-buffer obuf))))
(defun menubar-simple ()
"Set frame menubars to the simple menubar for InfoDock novices."
(interactive)
(if (not (eq infodock-menubar-type 'menubar-simple))
(setq infodock-previous-menubar-type infodock-menubar-type))
(setq infodock-menubar-type 'menubar-simple)
(require 'mb-simple)
(setq default-menubar simple-menubar
activate-menubar-hook nil)
;;
;; For new versions of Emacs 19, turn off mode-specific menubars.
(if (boundp 'inhibit-local-menu-bar-menus)
(setq inhibit-local-menu-bar-menus t))
;;
(set-menubar default-menubar)
;;
;; Reset all buffers with local menubars to simple menubars.
(id-reset-local-menubars)
;; Setup font handling, from "x-font-menu.el".
(reset-device-font-menus))
(defun menubar-xemacs ()
"Set frame menubars to the XEmacs editor menubar."
(interactive)
(if (not (eq infodock-menubar-type 'menubar-xemacs))
(setq infodock-previous-menubar-type infodock-menubar-type))
(setq infodock-menubar-type 'menubar-xemacs)
(if (and (featurep 'menubar-items)
(boundp 'xemacs-menubar)
(find-menu-item xemacs-menubar '("Apps")))
(setq default-menubar xemacs-menubar)
(require 'id-x-menubar)
(setq xemacs-menubar default-menubar))
(setq activate-menubar-hook nil)
;;
;; For new versions of Emacs 19, turn off mode-specific menubars.
(if (boundp 'inhibit-local-menu-bar-menus)
(setq inhibit-local-menu-bar-menus t))
;;
(set-menubar default-menubar)
;;
;; Reset all buffers with local menubars to XEmacs menubars.
(id-reset-local-menubars)
;; Setup font handling, from "x-font-menu.el".
(reset-device-font-menus))
(defun id-reset-local-menubars ()
"Reset all buffers with local menubars to use the default-menubar."
(let ((obuf (current-buffer)))
(unwind-protect
(mapcar (function
(lambda (buf)
(if (assq 'current-menubar (buffer-local-variables buf))
(progn (set-buffer buf)
(kill-local-variable 'current-menubar)
(set-menubar-dirty-flag)))))
(buffer-list))
(set-buffer obuf))))
;;; ************************************************************************
;;; InfoDock Menubar Menus
;;; ************************************************************************
(defun infodock-buffer-menu ()
(list
"%_Buffer"
:config 'Buffer
'["Manual" (id-info "(infodock)Buffer Menu") t]
'["Mode-Manual" (id-info "(infodock)Modes") t]
"----"
'["Next-Buffer" bury-buffer t]
'["Prev-Buffer" id-unbury-buffer t]
'["Switch-to" select-buffer t]
"----"
'["Create (No File)" id-create-buffer t]
'["View" view-buffer t]
'["View-This-Buffer" view-mode t]
"----"
'["Save" save-buffer
:active (buffer-modified-p)]
'["Save-Some-Buffers" save-some-buffers t]
'["Save-as (Write)" write-file t]
"----"
'["Print-Line-Numbers" ps-print-region-or-buffer-with-line-numbers
:active (fboundp 'ps-print-region-or-buffer-with-line-numbers)]
'["Pretty-Print" ps-print-region-or-buffer
:active (fboundp 'ps-print-region-or-buffer)]
'["Print" print-region-or-buffer
:active (fboundp 'print-region-or-buffer)]
"----"
'["Bury (Hide)" bury-buffer t]
'["Close" id-delete-buffer t]
'["Close-with-Window" id-delete-buffer-and-window t]
"----"
'["List-All" buffer-menu t]
'["List-Dirs-Only" id-dired-menu t]
'["List-Files-Only" (buffer-menu t) t]
"----"
'["Mail-Region-or-Buffer" mail-region-or-buffer t]
'["Rename" rename-buffer t]
'["Spell-Check" ispell-region-or-buffer t]
"----"
'["Compare" ediff-buffers t]
'["Insert-File" insert-file t]
'["Narrow-to-Region" narrow-to-region (region-exists-p)]
'["Revert" revert-buffer
:active (or buffer-file-name revert-buffer-function)]
'["Widen-to-Whole-Buffer" widen
(or (/= (point-min) 1) (/= (point-max) (1+ (buffer-size))))]
"----"
'["Save-Buffer-List" (emc-save) t]
'["Restore-Buffer-List" (emc-restore) t]
))
;;;
;;; This must precede the definition of infodock-display-menu.
(defconst infodock-frame-menu
'("%_Frame"
:config Frame
["Manual" (id-info "(infodock)Frame Menu") t]
"----"
["Create" id-create-frame t]
["Delete (Close)" id-delete-frame
:active (not (eq (next-frame (selected-frame) 'nomini 'window-system)
(selected-frame)))]
["Delete-All-Others" delete-other-frames t]
["Print" id-print-frame (eq (device-type) 'x)]
"----"
["Iconify" iconify-frame t]
["Lower" lower-frame t]
["Next" other-frame t]
["Previous" (other-frame -1)
:active t :keys "C-z p"]
["Raise" raise-frame t]
["Redisplay" (redraw-frame (selected-frame)) t]
"----"
["Name?" (message "Frame name: \"%s\"" (frame-name)) t]
["Size?" id-display-frame-size t]))
;;;
;;; This must precede the definition of infodock-display-menu.
(defconst infodock-window-menu
'("%_Window"
:config Window
["Manual" (id-info "(xemacs)Windows") t]
"----"
["Create" split-window-vertically t]
["Delete (Close)" delete-window (not (one-window-p))]
["Delete-Other-Windows" delete-other-windows (not (one-window-p))]
["Next" other-window (not (one-window-p))]
["Previous" (other-window -1) (not (one-window-p))]
"----"
["Split-Stacked" split-window-vertically t]
["Split-Side-by-Side" split-window-horizontally t]
"----"
["Compare"
(let ((buf1 (current-buffer))
(buf2 (window-buffer (next-window))))
(if (eq buf1 buf2)
(if (one-window-p t)
(error "(Window/Compare): Two windows are required for a comparison.")
(error "(Window/Compare): The same buffer is shown in both windows."))
(ediff-buffers buf1 buf2)))
(not (one-window-p))]
"----"
["Balance" balance-windows (not (one-window-p))]
["Grow"
(shrink-window
(let ((arg))
(while (not (integerp
(setq arg (read-minibuffer
"Number of lines to grow window: "
)))))
(- arg)))
(not (one-window-p))]
["Resize" resize-window (not (one-window-p))]
["Shrink"
(shrink-window
(let ((arg))
(while (not (integerp
(setq arg (read-minibuffer
"Number of lines to shrink window: "
)))))
arg))
(not (one-window-p))]
"----"
["Delete-Configuration" wconfig-delete-by-name
(if (boundp 'wconfig-names) wconfig-names)]
["Restore-Configuration" wconfig-restore-by-name
(if (boundp 'wconfig-names) wconfig-names)]
["Save-Configuration" wconfig-add-by-name t]))
(defconst infodock-display-menu
(list
"%_Display"
:config 'Display
'["Manual" (id-info "(infodock)Display Menu") t]
"----"
'["At-Window-Top" (recenter 0)
:active t :keys "M-0 C-l"]
'["At-Window-Bottom" (recenter -1)
:active t :keys "M- -1 C-l"]
'["Window-in-New-Frame" id-display-window-in-new-frame t]
"----"
infodock-frame-menu
infodock-window-menu
"----"
'["Current-Directory?"
(message "\"%s\" is the current dir." default-directory) t]
'["Current-Line?" what-line t]
'["Current-Page?" what-page t]
'["Current-Position?" what-cursor-position t]
"----"
'["Count-Lines-Chars"
(cond ((and zmacs-region-rectangular-p (region-active-p))
(call-interactively 'count-lines-rectangle))
((region-active-p)
(call-interactively 'count-lines-region))
(t (call-interactively 'count-lines-buffer))) t]
'["Count-Words"
(cond ((and zmacs-region-rectangular-p (region-active-p))
(call-interactively 'count-words-rectangle))
((region-active-p)
(call-interactively 'count-words-region))
(t (call-interactively 'count-words-buffer))) t]
"----"
'["Insert-Executable-Path" (let ((current-prefix-arg 1))
(call-interactively 'which)) t]
'["Which-Executable" which t]
"----"
'["Edit-Faces" edit-faces t]
'["List-Faces" list-faces-display t]
"----"
'["Messages"
(if (fboundp 'show-message-log)
(call-interactively 'show-message-log)
(view-lossage)) t]
'["Subprocesses" list-processes t]
"----"
'["Iconify-All-Frames" iconify-emacs t]))
(defconst infodock-rectangle-menu
(list "Rectangle"
:config 'Rectangle
:filter 'id-rectangle-menu-filter
["Manual" (id-info "(xemacs)Rectangles") t]
"----"
["Select-Rectangles" id-toggle-rectangle-region
:style toggle :selected mouse-track-rectangle-p]
["Toggle-Selection" toggle-region
:style toggle :selected (region-exists-p)]
"----"
["Replace-Regexp" replace-regexp-rectangle t]
["Replace-String" replace-string-rectangle t]
"----"
["Clear" clear-rectangle t]
["Copy" copy-rectangle t]
["Copy-to-Register" copy-rectangle-to-register t]
["Delete" delete-rectangle t]
["Kill" kill-rectangle t]
["Open" open-rectangle t]
["Yank" yank-rectangle t]
["Yank-from-Register" insert-register t]
"----"
["Spell-Check" ispell-rectangle t]
"----"
["Compute-Product" multiply-column t]
["Compute-Sum" sum-column t]
"----"
["Count-Lines-Chars"
(count-lines-rectangle (region-beginning) (region-end)) t]
["Count-Words" count-words-rectangle t]
"----"
["Capitalize" capitalize-rectangle t]
["Downcase" downcase-rectangle t]
["Upcase" upcase-rectangle t]
"----"
["Indent" indent-rectangle t]
))
;;; This must precede the definition of infodock-x-menu.
(defconst infodock-x-edit-menu
'(["X-Cut" kill-primary-selection
:active (or (and zmacs-regions zmacs-region-active-p)
(selection-owner-p))]
["X-Copy" copy-primary-selection
:active (or (and zmacs-regions zmacs-region-active-p)
(selection-owner-p))]
["X-Paste" (funcall mouse-yank-function)
:active (or (selection-exists-p 'PRIMARY)
(selection-exists-p 'CLIPBOARD))]
"--:shadowEtchedInDash"
["X-Delete" delete-primary-selection
:active (or (and zmacs-regions zmacs-region-active-p)
(selection-owner-p))]
["X-Select" (progn (toggle-region)
(activate-region-as-selection)) t]))
;;; This must precede the definition of infodock-region-menu.
(defconst infodock-x-menu
(append
'("X-Selection"
:config X-Selection
["Manual" (id-info "(xemacs)Using X Selections") t]
"----")
infodock-x-edit-menu))
;;; This must precede the definition of infodock-region--menu.
(defconst infodock-more-region-commands-menu
'("More-Commands"
["Comment" comment-region t]
["Uncomment" (let ((current-prefix-arg -4))
(call-interactively 'comment-region)) t]
"----"
["Evaluate-Lisp" eval-region t]
"----"
["Compute-Product" multiply-region t]
["Compute-Sum" sum-region t]
"----"
["Count-Lines-Chars"
(count-lines-region (region-beginning) (region-end)) t]
["Count-Words"
count-words-region t]
"----"
["Capitalize" capitalize-region t]
["Downcase" downcase-region t]
["Upcase" upcase-region t]
"----"
["Fill" (if (fboundp 'fill-region-and-align-all)
(fill-region-and-align-all nil)
(fill-region (region-beginning)
(region-end) nil))
t]
["Indent" indent-region t]
["Justify" (if (fboundp 'fill-region-and-align-all)
(fill-region-and-align-all t)
(fill-region (region-beginning)
(region-end) t))
t]
"----"
["Narrow-to" narrow-to-region (region-exists-p)]
["Widen" widen
(or (/= (point-min) 1) (/= (point-max) (1+ (buffer-size))))]
"----"
["Spaces-to-Tabs" tabify t]
["Tabs-to-Spaces" untabify t]
))
;;; This must precede the definition of infodock-edit-menu.
(defconst infodock-region-menu
(list "Region"
:config 'Region
:filter 'id-region-menu-filter
["Manual" (id-info "(xemacs)Using Region") t]
"----"
infodock-more-region-commands-menu
"----"
["Select-Rectangles" id-toggle-rectangle-region
:style toggle :selected mouse-track-rectangle-p]
["Toggle-Selection" toggle-region
:style toggle :selected (region-exists-p)]
"----"
["Mail" mail-with-region t]
"----"
["Replace-Regexp" replace-region t]
["Replace-String" replace-string-region
:keys "C-u M-r"
:active t]
"----"
["Copy" kill-ring-save t]
["Kill (Cut)" (call-interactively
(if (fboundp 'completion-kill-region)
'completion-kill-region 'kill-region))
:keys "C-w"
:active t]
["Yank (Paste)" (if (eq last-command 'yank)
(call-interactively 'yank-pop)
(call-interactively 'yank))
:keys "C-y"
:active (not (zerop (length kill-ring)))]
infodock-x-menu
"----"
["Pretty-Print" (progn (call-interactively 'ps-print-region)
(message "Region sent to %s printer"
(or (getenv "PRINTER") "default")))
t]
["Print" (progn (call-interactively 'print-region)
(message "Region sent to %s printer"
(or (getenv "PRINTER") "default")))
t]
"----"
["Shell-Command" shell-command-on-region t]
"----"
["Spell-Check" ispell-region t]
"----"
["Save-as (Write)" write-region t]
"----"
'("Abbreviations"
["Define-Global-Abbrev" add-global-abbrev t]
["Define-Mode-Abbrev" add-mode-abbrev t]
["Expand-All-Region-Abbrevs"
(expand-region-abbrevs (region-start) (region-end) t) t]
["Query-Expand-Region-Abbrevs" expand-region-abbrevs t]))
"Menu popped up when a region is selected and not in rectangle selection mode.")
;;; This must precede the definition of infodock-edit-menu.
(defconst infodock-replace-menu
'("Replace"
:config Replace
["Manual" (id-info "(xemacs)Replace") t]
"----"
["Replace-Regexp-in-Region" replace-region (region-exists-p)]
["Replace-String-in-Region" replace-string-region (region-exists-p)]
"----"
["Replace-Regexp-to-End" replace-regexp t]
["Replace-String-to-End" replace-string t]
"----"
["Query-Replace-Regexp-to-End" query-replace-regexp t]
["Query-Replace-String-to-End" query-replace t]
"----"
["Case-Preserving"
(progn (setq case-replace (not (and case-replace case-fold-search)))
(if case-replace (setq case-fold-search t)))
:style toggle :selected (and case-replace case-fold-search)]
))
;;; This must precede the definition of infodock-edit-menu.
(defconst infodock-search-menu
'("Search"
:config Search
["Manual" (id-info "(xemacs)Search") t]
"----"
["Search-Forward-String" isearch-forward t]
["Search-Reverse-String" isearch-backward t]
["Search-Dir-Trees-String"
(progn (require 'igrep) (call-interactively 'fgrep-find))
t]
["Search-Files-String" fgrep t]
"----"
["Search-Forward-Regexp" isearch-forward-regexp t]
["Search-Reverse-Regexp" isearch-backward-regexp t]
["Search-Dir-Trees-Regexp"
(progn (require 'igrep) (call-interactively 'igrep-find))
t]
["Search-Files-Regexp" igrep t]
"----"
["Case-Sensitive" (setq case-fold-search (not case-fold-search))
:style toggle :selected (not case-fold-search)]
))
;;; This must precede the definition of infodock-software-menu.
(defconst id-debug-commands-menu
'("----"
["Display-Current-Line" id-debug-refresh
(or (and (boundp 'current-gdb-buffer) current-gdb-buffer)
(fboundp 'gud-refresh))]
["Print-Expr-at-Point" id-debug-print
(or (and (boundp 'current-gdb-buffer) current-gdb-buffer)
(fboundp 'gud-print))]
;; These next two idems will invoke a new debugger if necessary
;; so they are always enabled.
["Toggle-Break-Here" id-debug-toggle-breakpoint t]
["Toggle-One-Time-Break" (id-debug-set-breakpoint t)
:active t
:keys "C-u C-x SPC"]))
;;; This must precede the load of "menus-otl".
(defconst infodock-debug-menu
`("Debug"
["Manual" (id-info "(infodock)Debugging") t]
"----"
["Enable-Debugging"
(gdbsrc-mode 1)
:active t
:included (and buffer-file-name
(boundp 'gdbsrc-mode) (not gdbsrc-mode))]
"----"
["Invoke-Default" iddebug
:active (symbolp id-default-debugger)
:suffix (format "(%s)" id-default-debugger)]
"----"
["Invoke-DBX" (id-debug 'dbx) t]
["Invoke-GDB-or-WDB" (id-debug 'idgdbsrc) t]
["Invoke-SDB" (id-debug 'sdb) t]
["Invoke-XDB" (id-debug 'xdb) t]
,@ id-debug-commands-menu))
(require 'menus-otl)
(defconst infodock-edit-menu
(append
(list
"%_Edit"
:config 'Edit
'["Manual" (id-info "(infodock)Edit Menu") t]
'["X-Selection-Manual" (id-info "(xemacs)Using X Selections") t]
["----" nil
:included (or (eq major-mode 'outline-mode)
(and (boundp 'outline-minor-mode) outline-minor-mode))
:active nil]
id-edit-outline-menu
"----"
'["Undo" advertised-undo
:active (and (not (eq buffer-undo-list t))
(or buffer-undo-list pending-undo-list))
:suffix (if (or (eq last-command 'undo)
(eq last-command 'advertised-undo))
"More" "")]
["Redo" redo
:included (fboundp 'redo)
:active (not (or (eq buffer-undo-list t)
(eq last-buffer-undo-list nil)
(not (or (eq last-buffer-undo-list buffer-undo-list)
(and (null (car-safe buffer-undo-list))
(eq last-buffer-undo-list
(cdr-safe buffer-undo-list)))))
(or (eq buffer-undo-list pending-undo-list)
(eq (cdr buffer-undo-list) pending-undo-list))))
:suffix (if (eq last-command 'redo) "More" "")]
"----"
'["Yank" yank (and kill-ring t)]
'["Yank-Previous" yank-pop (eq last-command 'yank)]
"----")
infodock-x-edit-menu
(list
"----"
'["Insert-File" insert-file t]
"----"
infodock-rectangle-menu
infodock-region-menu
infodock-replace-menu
infodock-search-menu
"----"
'("Spell-Check"
:config Spell-Check
["Manual" (id-info "(ispell)") t]
"----"
["Buffer" ispell-buffer t]
["Region" ispell-region (region-exists-p)]
["Word" ispell-word t]
"----"
["Auto-Spell-Mode" (id-toggle-minor-mode 'flyspell-mode)
:style toggle :selected (if (boundp 'flyspell-mode) flyspell-mode)]
)
"----"
'("Abbreviations"
:config Abbreviations
["Manual" (id-info "(xemacs)Abbrevs") t]
"----"
["Define-Global-Abbrev" add-global-abbrev t]
["Define-Global-Expansion" inverse-add-global-abbrev t]
["Define-Mode-Abbrev" add-mode-abbrev t]
["Define-Mode-Expansion" inverse-add-mode-abbrev t]
"----"
["Expand-Dynamic-Abbrev" dabbrev-expand t]
["Complete-Dynamic-Abbrev" dabbrev-completion t]
"----"
["Expand-Abbrev-Before-Point" expand-abbrev t]
["Expand-All-Region-Abbrevs"
(expand-region-abbrevs (region-start) (region-end) t) (region-exists-p)]
["Query-Expand-Region-Abbrevs" expand-region-abbrevs (region-exists-p)]
["Undo-Last-Expansion" unexpand-abbrev t]
"----"
["Edit-Abbrevs" edit-abbrevs t]
["Read-Abbrevs-File" read-abbrev-file t]
["Write-Abbrevs-File" write-abbrev-file t]
"----"
["Delete-All-Abbrevs" kill-all-abbrevs t]
"----"
["Auto-Abbrev-Mode" (id-toggle-minor-mode 'abbrev-mode)
:style toggle :selected abbrev-mode]
)
'("Case"
:config Case
["Manual" (id-info "(xemacs)Case") t]
"----"
["Capitalize-Region" capitalize-region (region-exists-p)]
["Capitalize-Word" capitalize-word t]
["Downcase-Region" downcase-region (region-exists-p)]
["Downcase-Word" downcase-word t]
["Upcase-Region" upcase-region (region-exists-p)]
["Upcase-Word" upcase-word t]
)
'("Fill&Justify"
:config Fill&Justify
["Manual" (id-info "(xemacs)Filling") t]
"----"
["Fill-Paragraph" (if (fboundp 'fill-paragraph-and-align)
(fill-paragraph-and-align nil)
(fill-paragraph nil))
:active t
:keys "M-j"]
["Fill-Region" (if (fboundp 'fill-region-and-align-all)
(fill-region-and-align-all nil)
(fill-region (region-beginning)
(region-end) nil))
:active (region-exists-p)
:keys "C-x C-j"]
["Justify-Paragraph" (if (fboundp 'fill-paragraph-and-align)
(fill-paragraph-and-align t)
(fill-paragraph t))
:active t
:keys "C-u M-j"]
["Justify-Region" (if (fboundp 'fill-region-and-align-all)
(fill-region-and-align-all t)
(fill-region (region-beginning)
(region-end) t))
:active (region-exists-p)
:keys "C-u C-x C-j"]
["Set-Fill-Prefix" set-fill-prefix t]
["Set-Fill-Column" set-fill-column t]
"----"
["Auto-Fill-Mode" (id-toggle-minor-mode 'auto-fill-mode)
:style toggle :selected auto-fill-function]
["Auto-Justify-Mode" (id-toggle-minor-mode 'auto-justify-mode)
:style toggle :selected (if (boundp 'auto-justify-mode)
auto-justify-mode)]
)
'("Indent"
:config Indent
["Manual" (id-info "(xemacs)Indentation") t]
"----"
["Buffer" (indent-region (point-min) (point-max)
(prefix-numeric-value
current-prefix-arg))
t]
["Line" indent-for-tab-command t]
["Line-to-Left-Margin" (indent-to-left-margin) t]
["Line-to-Column" indent-to t]
["Line-to-Prev-Line" indent-relative t]
["Region" indent-region (region-exists-p)]
["Region-Rigidly" id-indent-region-rigidly (region-exists-p)]
["Region-to-Column" id-indent-region-to-column (region-exists-p)]
["Sexpression" indent-sexp t]
"----"
["Indent-with-Tabs"
(message "Tab characters will %sbe used within this buffer."
(if (setq indent-tabs-mode (not indent-tabs-mode))
"" "not "))
:style toggle :selected indent-tabs-mode]
)
'("Kill"
:config Kill
["Manual" (id-info "(xemacs)Killing") t]
"----"
["Paragraph" kill-paragraph t]
["Rectangle" kill-rectangle (region-exists-p)]
["Region" kill-region (region-exists-p)]
["Rest-of-Line" kill-line t]
["Sentence" kill-sentence t]
["Sexpression" kill-sexp t]
["Whole-Buffer" (kill-region (point-min) (point-max)) t]
["Whole-Line" (progn (beginning-of-line) (kill-line 1)) t]
["Word" kill-word t]
)
'("Mark"
:config Mark
["Manual" (id-info "(xemacs)Mark") t]
"----"
["Exchange-with-Point" exchange-point-and-mark t]
["Pop-to-Prior-Mark" (set-mark-command (or current-prefix-arg 1))
:active t
:keys "C-u M-SPC"]
["Set" set-mark-command
:active t
:keys "M-SPC"]
["Whole-Buffer" mark-whole-buffer t]
)
"----"
'["Remove-PC-Returns" id-delete-returns t]
"----"
'["Spaces-to-Tabs" (tabify (point-min) (point-max)) t]
'["Tabs-to-Spaces" (untabify (point-min) (point-max)) t])))
;; This must come before infodock-file-menu
;;;
(defconst infodock-directory-menu
'("%_Directory"
:config Directory
["Manual" (id-info "(xemacs)Dired") t]
"----"
["Browse (Dired)" dired t]
["Browse-Home-Dir" (dired "~") t]
["Create" (shell-command
(format "mkdir %s"
(id-get-directory-name "create" nil))) t]
["Current?"
(message "\"%s\" is the current dir." default-directory) t]
["Delete" (shell-command
(format "rmdir %s"
(id-get-directory-name "delete" nil))) t]
["Edit (Dired)" dired t]
["List-Direds" id-dired-menu t]
["Rename" (shell-command
(format "mv %s %s"
(id-get-directory-name "rename" nil)
(id-get-directory-name "rename to" nil)
))
t]
["Set" (setq default-directory
(read-directory-name
"Set current dir to: " nil nil t nil)) t]
))
;;;
(defconst infodock-file-menu
(list
"%_File"
:config 'File
'["Manual" (id-info "(infodock)File Menu") t]
"----"
infodock-directory-menu
"----"
'["New" (switch-to-buffer
(generate-new-buffer "Untitled")) t]
'["Open-File" find-file t]
"----"
'["Delete (Permanently)" delete-file t]
'["Mail" mail-file t]
'["Print" (progn (call-interactively 'print-file)
(message "File sent to %s printer"
(or (getenv "PRINTER") "default")))
t]
'["Rename"
(let ((path (or (buffer-file-name) default-directory)))
(rename-file path (read-file-name
(format "Rename %s to: "
(file-name-nondirectory path)))))
t]
'["Save" save-buffer
:active (buffer-modified-p)]
'["Save-as (Write)" write-file t]
'["View" view-file t]
"----"
'["Close" id-delete-buffer t]
'["Close-with-Window" id-delete-buffer-and-window t]
"----"
'["Find-Alternate" find-alternate-file t]
'["Find-New-Frame" find-file-new-frame t]
'["Find-Other-Window" find-file-other-window t]
'["Find-Read-Only" find-file-read-only t]
"----"
'["Compare" ediff-files t]
'["Insert" insert-file t]
'["List" dired t]
'["Revert" revert-buffer t]
))
(defconst infodock-go-menu
`("%_Go"
:config Go
:filter id-buffers-menu-filter
"--:shadowEtchedInDash"
["Alphabetize-Buffers"
(setq sort-buffers-menu-p (not sort-buffers-menu-p))
:style toggle
:selected sort-buffers-menu-p
:active (not infodock-categorize-buffers)]
["Buffer-Submenus"
(setq complex-buffers-menu-p (not complex-buffers-menu-p))
:style toggle
:selected (and complex-buffers-menu-p (not infodock-categorize-buffers))
:active (not infodock-categorize-buffers)]
["Categorize-by-Mode"
(setq infodock-categorize-buffers (not infodock-categorize-buffers))
:style toggle
:selected infodock-categorize-buffers]
["Set-Buffer-Menu-Size"
(progn
(setq buffers-menu-max-size
(read-number
(format
"Buffer menu max length (current = %d; 0 means unlimited): "
(or buffers-menu-max-size 0))))
(if (eq buffers-menu-max-size 0)
(setq buffers-menu-max-size nil)))
t]))
;; Defines infodock-hyperbole-menu
;; (load "hui-menu")
(if (and id-hyperbole-p
(or noninteractive (not (boundp 'emacs-version))
(not (fboundp 'infodock-hyperbole-menu))))
(defun infodock-hyperbole-menu ()
'("%_Hyperbole"
:config Hyperbole
:filter id-hyperbole-menu-filter)))
(defconst infodock-key-menu
'("%_Key"
:config Key
["Manual" (id-info "(infodock)Key Menu") t]
"---"
["Windows-Mac-Motif-Keys"
CUA-mode
:style toggle
:selected (and (boundp 'CUA-mode) CUA-mode)
:active (fboundp 'CUA-mode)]
"----"
["Explain-Key-Binding" Info-goto-emacs-key-command-node t]
["Show-Key-Binding" describe-key t]
["Summarize-All-Keys" make-command-summary t]
"----"
["Set-Globally" global-set-key t]
["Set-in-Current-Mode" local-set-key t]
["Set-in-Named-Mode" id-define-key t]
"----"
["Unset-Globally" global-unset-key t]
["Unset-in-Current-Mode" local-unset-key t]
"----"
"----"
["Keyboard-Macro-Manual" (id-info "(xemacs)Keyboard Macros") t]
"----"
["Define-Keyboard-Macro" start-kbd-macro (not defining-kbd-macro)]
["End-Macro-Definition" end-kbd-macro defining-kbd-macro]
["Execute-Current-Macro" id-execute-current-kbd-macro
(and last-kbd-macro (not executing-kbd-macro))]
"----"
["Name-Current-Macro" name-last-kbd-macro
(and last-kbd-macro
(not executing-kbd-macro)
(not defining-kbd-macro))]
["Execute-Named-Macro" id-execute-kbd-macro
(not executing-kbd-macro)]
"----"
["Query-User-in-Macro" kbd-macro-query
(or defining-kbd-macro executing-kbd-macro)]
["Show-Macro-Definition" id-display-kbd-macro
(not executing-kbd-macro)]
))
(defun id-toggle-file-headers (&optional arg)
"Toggle insertion of file headers into newly created buffers with attached files.
With prefix ARG, if positive, turn on file headers, otherwise turn them off."
(interactive "P")
(setq id-file-headers-flag
(if arg (> (prefix-numeric-value arg) 0)
(not id-file-headers-flag)))
(if id-file-headers-flag
(progn (add-hook 'find-file-hooks 'hdr-new)
(add-hook 'write-file-hooks 'hdr))
(remove-hook 'find-file-hooks 'hdr-new)
(remove-hook 'write-file-hooks 'hdr))
(if (interactive-p)
(message "File headers will %sbe inserted."
(if id-file-headers-flag "" "not "))))
;;;
;;; This must precede the definition of infodock-menu.
(defcustom id-file-headers-flag t
"When non-nil, file headers are inserted into new files
and updated when files are saved."
:type 'boolean
:set (lambda (symbol value)
(id-toggle-file-headers (if value 1 0)))
:group 'id-menus)
(defconst id-menubar-types
'(
["InfoDock-Menubar" menubar-infodock
:style radio :selected (eq infodock-menubar-type 'menubar-infodock)]
["Simple-Menubar" menubar-simple
:style radio :selected (eq infodock-menubar-type 'menubar-simple)]
["XEmacs-Menubar" menubar-xemacs
:style radio :selected (eq infodock-menubar-type 'menubar-xemacs)]
)
"List of menu entries that invoke different InfoDock menubar types.")
;;;
;;; This must precede the definition of infodock-menu.
(defconst infodock-support-menu
'("BeOpen-Support"
:config BeOpen-Support
["Ask-Question"
(hmail:compose infodock-help-address '(hact 'hyp-config)
"" "Ask your question in the subject line.")
t]
["Report-Bug"
(hmail:compose infodock-bug-address '(hact 'hyp-config)
"" "Describe your bug in the subject line.")
t]
["Request-Feature"
(hmail:compose infodock-feature-address '(hact 'hyp-config)
"" "Describe your feature request in the subject line.")
t]))
;;;
;;; This must precede the definition of infodock-menu.
(defconst infodock-help-menu
'("%_Help"
:config Help
["Help-Manual" (id-info "(xemacs)Help") t]
"----"
["About" (id-credits) t]
["Copyright" (id-splash-buffer) t]
["Version?" (message (infodock-version)) t]
["What-is-New?" (beopen-display-file
(locate-data-file "ID-NEWS")) t]
"----"
["Info-Browser" info t]
["Info-Go-to-Node" Info-goto-node t]
"----"
["Apropos" hyper-apropos t]
["Configuration" describe-installation t]
("Customization"
["File-Headers" (id-info "(infodock)File Headers") t]
["Init-File-Examples" (id-info "(xemacs)Init Examples") t]
["Options" (id-info "(infodock)Options") t]
["Programming-Menus" (id-info "(xemacs)Menu Customization") t]
["Setting-Keys" (id-info "(infodock)Setting Keys") t]
["Setting-Tools" (id-info "(infodock)Setting Tools") t]
["Setting-Variables" (id-info "(infodock)Setting Variables") t]
)
("Glossaries"
["Hyperbole " (id-info "(hyperbole)Glossary") t]
["InfoDock" (id-info "(infodock)Glossary") t]
["OO-Browser" (id-info "(oo-browser)Glossary") t]
["XEmacs" (id-info "(xemacs)Glossary") t]
)
("Quick-Help"
["For-Current-Mode" describe-mode t]
["For-Function" describe-function t]
["For-Internet-Domain" what-domain t]
["For-Key" describe-key t]
["For-Mouse-Bindings" describe-pointer t]
["For-Variable" describe-variable t]
"----"
["List-All-by-Keyword" hyper-apropos t]
["List-Cmds-by-Keyword" command-apropos t]
["Where-is-Command?" where-is t]
"----"
["Last-Keystrokes" view-lossage t]
)
("Reference-Help"
["For-Command" Info-goto-emacs-command-node t]
["For-Key" Info-goto-emacs-key-command-node t]
["For-Pkg-Categories" finder-by-keyword t]
["For-XElisp-Function" Info-elisp-ref t]
"----"
["Global-Key-Bindings" make-command-summary t]
["Local-Key-Bindings" describe-bindings t]
["Mouse-Smart-Keys"
(id-view-file
(locate-data-file "hkey-help.txt"))
(locate-data-file "hkey-help.txt")]
["Mouse-Summary" (id-info "(infodock)Mouse Operation") t]
"----"
["Card-Catalog" (id-view-doc-library
(locate-file "doc-index.otl" Info-directory-list)) t]
["Document-List" (id-view-doc-library
(locate-file "doc-summary.otl" Info-directory-list)) t]
"----"
["Roadmap" (id-view-file
(locate-data-file "ID-ROADMAP")) t]
)
("Tutorials"
["Calculator" calc-tutorial (fboundp 'calc-tutorial)]
["Hyperbole" (id-view-file
(expand-file-name
"DEMO" hyperb:dir)) t]
["Info" Info-help t]
["Outliner" kotl-mode:example t]
["XEmacs" help-with-tutorial t]
)
"----"
("XEmacs"
["Copyright" describe-copying t]
["FAQ" (id-info "(XEmacs-faq)") t]
["Manual" (id-info "(xemacs)") t]
["New-Features" view-emacs-news t]
["Warranty" describe-no-warranty t]
)
"----"
["NetNews-FAQ" find-faq t]
["UNIX-Man-Apropos" unix-apropos t]
["UNIX-Man-Page" manual-entry t]
))
(defconst infodock-menu
(append
(list "%_InfoDock"
:config 'InfoDock
'["About" (id-credits) t]
'["Manual" (id-info "(infodock)") t]
'["Menu-Manual" (id-info "(infodock)InfoDock Menu") t]
"----")
id-menubar-types
(list
"----"
["New" (switch-to-buffer
(generate-new-buffer "Untitled")) t]
["Open-File" find-file t]
["Open-File-New-Frame" find-file-new-frame t]
["Open-File-Other-Window" find-file-other-window t]
"----"
["Save " save-buffer
:active (buffer-modified-p)
:suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
["Save-as (Write)" write-file t]
"----"
'["Print-Line-Numbers " ps-print-region-or-buffer-with-line-numbers
:active (fboundp 'ps-print-region-or-buffer-with-line-numbers)
:suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
["Pretty-Print " ps-print-region-or-buffer
:active (fboundp 'ps-print-region-or-buffer)
:suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
["Print " print-region-or-buffer
:active (fboundp 'print-region-or-buffer)
:suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
"-----"
["Close " id-delete-buffer
:active t
:suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
["Revert " revert-buffer
:active (or buffer-file-name revert-buffer-function)
:suffix (if put-buffer-names-in-file-menu (buffer-name) "")]
"----"
["Delete-This-Frame" id-delete-frame
:active (not (eq (next-frame (selected-frame) 'nomini 'window-system)
(selected-frame)))]
["New-Frame" id-create-frame t]
"----"
infodock-support-menu
infodock-help-menu
"----"
'["Unhide-All-Menus"
(progn
(set-menubar-dirty-flag)
(customize-set-variable 'menubar-configuration
(copy-sequence id-all-configurable-menus)))
:active (/= (length menubar-configuration)
(length id-all-configurable-menus))])
(list
"----"
'["Load" (load-user-init-file (user-login-name))
:included user-init-file
:active t
:suffix user-init-file]
'["Reinitialize-Menus" (id-load-menus t) t]
'["Reinitialize-Mouse-Keys" infodock-set-mouse-bindings t]
'["Reload-Menus" id-load-menus t]
"----"
'["Iconify-All-Frames" iconify-emacs t]
'["Quit-InfoDock" save-buffers-kill-emacs t]
)))
;;;
;;; This must precede the definition of infodock-options-menu.
(defvar id-face-all-frames-flag t
"*If true, menu-based color and face changes affect all frames, otherwise, just the current frame.
The default is true.")
(defun id-face-settings (title face-attr-function settings-list)
"Return an XEmacs menu with TITLE and items which invoke set FACE-ATTR-FUNCTION on each element of SETTINGS-LIST.
With `id-face-all-frames-flag' non-nil, affect face in all frames rather than
the current frame only."
(cons title
(mapcar
(function
(lambda (color-item)
(let ((color color-item)
(menu-str color-item)
(set-function (intern-soft
(concat "set-"
(symbol-name face-attr-function))))
(inverse-function
(if (eq face-attr-function 'face-background)
'face-foreground 'face-background)))
(if (listp color-item)
(setq color (car (cdr color-item))
menu-str (car color-item)))
(vector menu-str
`(if (equal (color-name (,inverse-function 'default))
,color)
(error "Frame and Text colors may not be the same.")
(if (eq ',face-attr-function 'face-background)
(if id-face-all-frames-flag
(mapc (lambda (f)
(set-frame-property
f 'background-mode nil))
(frame-list))
(set-frame-property
(selected-frame) 'background-mode nil)))
; (if id-face-all-frames-flag
; ;; Remove any frame-specfic specifiers
; (mapcar
; #'(lambda (frame)
; (remove-specifier
; (,face-attr-function 'default) frame))
; (frame-list)))
(,set-function
'default ,color
(if id-face-all-frames-flag
nil
(or (and current-mouse-event
(event-frame current-mouse-event))
(selected-frame)))
nil (if id-face-all-frames-flag 'remove-all))
(if (eq ',set-function 'set-face-background)
(let ((id-light-background-color ,color)
(id-dark-background-color ,color))
(id-set-faces))))
:style 'radio
:selected `(let ((attr (,face-attr-function
'default)))
(and attr
(equal ,color (color-name attr))))
:active `(valid-color-name-p ,color)
))))
settings-list)))
;;; This must precede the definition of infodock-options-menu.
(defvar id-font-all-frames-flag t
"*If true, menu-based font changes affect all frames, otherwise, just the current frame.
The default is true.")
(defun id-font-menu (font-list)
(let (font menu-str)
(mapcar
(function
(lambda (item)
(cond ((stringp item)
(setq menu-str item
font item)
(id-font-menu-entry menu-str font))
((vectorp item)
(setq menu-str (elt item 0)
font (elt item 1))
(id-font-menu-entry menu-str font))
((listp item)
(cons (car item) (id-font-menu (cdr item)))))))
font-list)))
;;; This must precede the definition of infodock-options-menu.
(defun id-font-menu-entry (menu-str font)
(if (and (stringp menu-str) (>= (length menu-str) 2)
(string-equal (substring menu-str 0 2) "--"))
menu-str ;; menu item separator
(vector menu-str
`(progn
(id-set-default-font
,font
(if id-font-all-frames-flag
nil
(or (and current-mouse-event (event-frame current-mouse-event))
(selected-frame))))
(id-synchronize-face-fonts id-font-all-frames-flag))
:style 'radio
:selected `(let ((curr-font (face-font 'default)))
(and curr-font
(equal (font-name curr-font)
,font))))))
;;; This must precede the definition of infodock-options-menu.
;;; A menu title string must be added by each user of this menu.")
(defconst infodock-highlighter-menu
'(
:config Highlighter
["Manual" (id-info "(infodock)Syntax Highlighting") t]
"----"
["Dark-Frames" (id-toggle-frame-backgrounds nil)
:style toggle :selected (and (boundp 'id-dark-background-flag)
id-dark-background-flag)]
["Textured-Backgrounds" (id-toggle-frame-backgrounds t)
:style toggle
:selected (and (boundp 'id-background-pixmap-flag)
id-background-pixmap-flag)]
["Highlight-Buffer" ; This option can't be saved
font-lock-mode
:style toggle
:selected (and (boundp 'font-lock-mode) font-lock-mode)]
["Highlight-Mode" ; This option can't be saved
(id-toggle-minor-mode 'font-lock-mode)
:style toggle
:selected (let ((hook-sym
(intern (concat (symbol-name major-mode) "-hook"))))
(and (boundp hook-sym) (listp (symbol-value hook-sym))
(memq 'turn-on-font-lock (symbol-value hook-sym))
t))]
"----"
["Highlight-Less" ; This option can't be saved
(progn
(require 'font-lock)
(font-lock-use-default-minimal-decoration)
(when font-lock-mode
(turn-off-font-lock))
(turn-on-font-lock)
(customize-set-variable 'font-lock-maximum-decoration
font-lock-maximum-decoration))
:style radio
:selected (if (and (boundp 'font-lock-mode) font-lock-mode)
(not font-lock-maximum-decoration))]
["Highlight-More"
(progn
(require 'font-lock)
(font-lock-use-default-maximal-decoration)
(when font-lock-mode
(turn-off-font-lock))
(turn-on-font-lock)
(customize-set-variable 'font-lock-maximum-decoration
font-lock-maximum-decoration))
:style radio
:selected (if (and (boundp 'font-lock-mode) font-lock-mode)
font-lock-maximum-decoration)]
"----"
["Auto-Syntax-Highlight"
(progn
(id-toggle-auto-syntax-highlight)
(customize-set-variable 'font-lock-auto-fontify
font-lock-auto-fontify))
:style toggle
:selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify)]
"----"
["Edit-Faces" edit-faces t]
)
"Language syntax highlighting menu.
A menu title string must be added by each user of this menu.")
;;; This must precede the definition of infodock-options-menu.
(defconst infodock-mode-menu
'("Mode"
["Manual" (id-info "(infodock)Modes") t]
"----"
("Programming-A-M"
["Manual" (id-info "(infodock)Programming") t]
"----"
["Ada" ada-mode t]
["Assembly" asm-mode t]
["Awk" awk-mode t]
["C" c-mode t]
["C++" c++-mode t]
["C-Shell" csh-mode t]
["Change-Log" change-log-mode t]
["Cobol" cobol-mode t]
["Eiffel" eiffel-mode t]
["Fortran90" f90-mode t]
["Fortran" fortran-mode t]
["Hex-Dump" hexl-mode t]
["Java" java-mode t]
["Ksh" ksh-mode t]
["Lisp" lisp-mode t]
["Lisp-Interaction" lisp-interaction-mode t]
["M4" m4-mode t]
["Makefile" makefile-mode t]
["Miranda" miranda-mode t]
["Modula3" modula-2-mode t]
)
("Programming-N-Z"
["Objective-C" objc-mode t]
["Pascal" pascal-mode t]
["Perl" perl-mode t]
["Postscript" postscript-mode t]
["Prolog" prolog-mode t]
["Python" python-mode t]
["Rexx" rexx-mode t]
["Scheme" scheme-mode t]
["Simula" simula-mode t]
["Smalltalk" smalltalk-mode t]
["SQL" sql-mode t]
["Tcl" tcl-mode t]
["Verilog" verilog-mode t]
["VRML" vrml-mode t]
["XEmacs-Lisp" emacs-lisp-mode t]
["Xrdb" xrdb-mode t]
)
("Text-Editing"
["Manual" (id-info "(infodock)Text") t]
"----"
["Bib" bib-mode t]
["Bibtex" bibtex-mode t]
["Emacs Outline" outline-mode t]
["HTML" html-mode t]
["Hyperbole Koutline" kotl-mode t]
["Indented-Text" indented-text-mode t]
["Latex" latex-mode t]
["Nroff" nroff-mode t]
["Picture" picture-mode t]
["Scribe" scribe-mode t]
["TeX" tex-mode t]
["Texinfo" texinfo-mode t]
["Text" text-mode t]
["Wordstar" wordstar-mode t]
)
"----"
("Minor"
["Manual" (id-info "(infodock)Minor Modes") t]
"----"
["Abbrev" (id-toggle-minor-mode 'abbrev-mode)
:style toggle :selected abbrev-mode]
["Adaptive-Fill"
(progn (require 'filladapt) (id-toggle-minor-mode 'filladapt-mode))
:style toggle :selected (and (featurep 'filladapt) filladapt-mode)]
["Auto-Fill" (id-toggle-minor-mode 'auto-fill-mode)
:style toggle :selected auto-fill-function]
["Auto-Justify" (id-toggle-minor-mode 'auto-justify-mode)
:style toggle :selected (if (boundp 'auto-justify-mode)
auto-justify-mode)]
["Auto-Scroll-Horizontally" (id-toggle-minor-mode 'auto-show-mode)
:style toggle :selected (if (boundp 'auto-show-mode) auto-show-mode)]
["Auto-Spell" (id-toggle-minor-mode 'flyspell-mode)
:style toggle :selected (if (boundp 'flyspell-mode) flyspell-mode)]
["Line-Numbers" (id-toggle-minor-mode 'setnu-mode)
:style toggle :selected (if (boundp 'setnu-mode) setnu-mode)]
["Line&Col-Number" (id-toggle-minor-mode 'lc-minor-mode)
:style toggle :selected (and (boundp 'lc-minor-mode) lc-minor-mode)]
["Outline" (id-toggle-minor-mode 'outline-minor-mode)
:style toggle :selected selective-display]
["Overwrite" (id-toggle-minor-mode 'overwrite-mode)
:style toggle :selected (and (boundp 'overwrite-mode) overwrite-mode)]
["Syntax-Highlight" (id-toggle-minor-mode 'font-lock-mode)
:style toggle :selected (and (boundp 'font-lock-mode) font-lock-mode)]
"----"
["Current-Buffer-Only" id-toggle-minor-mode-flag
:style toggle :selected id-minor-mode-flag]
)))
(defun infodock-options-menu ()
(delq
nil
(list
"%_Options"
:config 'Options
'["Manual" (id-info "(infodock)Options Menu") t]
"----"
'["Save-Options" id-save-options-settings t]
'["Set-Variable" customize-variable t]
"----"
'["Unhide-All-Menus"
(progn
(set-menubar-dirty-flag)
(customize-set-variable 'menubar-configuration
(copy-sequence id-all-configurable-menus)))
:active (/= (length menubar-configuration)
(length id-all-configurable-menus))]
"----"
'("Buffer"
["Manual" (id-info "(infodock)Buffer Options") t]
"----"
["Adaptive-Fill" ; This option can't be saved
(progn
(require 'filladapt)
(filladapt-mode))
:style toggle :selected (and (featurep 'filladapt) filladapt-mode)]
["Auto-Fill" ; This option can't be saved
auto-fill-mode
:style toggle :selected auto-fill-function]
["Auto-Spell"
flyspell-mode
:style toggle
:selected flyspell-mode
:active (fboundp 'flyspell-mode)]
["Case-Preserving-Replace" ; This option won't be saved
(progn
(setq case-replace (not (and case-replace case-fold-search)))
(when case-replace
(setq case-fold-search t)))
:style toggle :selected (and case-replace case-fold-search)]
["Case-Sensitive-Search" ; This option won't be saved
(setq case-fold-search (not case-fold-search))
:style toggle :selected (not case-fold-search)]
["Insert-Tab-Characters" ; This option won't be saved
(progn
(setq indent-tabs-mode (not indent-tabs-mode))
(message "Tab characters will %sbe used within this buffer."
(if indent-tabs-mode "" "not ")))
:style toggle :selected indent-tabs-mode]
["Line-Numbers" ; This option won't be saved
setnu-mode
:style toggle
:selected (if (boundp 'setnu-mode) setnu-mode)]
["Line&Col-Number" ; This option won't be saved
lc-minor-mode
:style toggle
:selected (and (boundp 'lc-minor-mode) lc-minor-mode)]
["Overwrite-Mode" ; This option won't be saved
(progn
(call-interactively 'overwrite-mode)
(message "Insertion will %soverwrite successive characters."
(if overwrite-mode "" "not ")))
:style toggle :selected (and (boundp 'overwrite-mode) overwrite-mode)]
["Read-only" ; This option can't be saved
(progn (call-interactively 'toggle-read-only)
(message "%s is now %s." (buffer-name)
(if buffer-read-only "read-only" "editable")))
:style toggle :selected buffer-read-only]
["Truncate-Lines" ; This option won't be saved
(progn
(setq truncate-lines (not truncate-lines))
(setq truncate-partial-width-windows truncate-lines)
(message "Buffer lines longer than the right margin will %s."
(if truncate-lines "be truncated" "wrap")))
:style toggle :selected truncate-lines]
)
(list
"Display"
["Manual" (id-info "(infodock)Display Options") t]
"----"
'["Display-Mail-Subjects" ; This option can't be saved
id-toggle-mail-subjects
:style toggle :selected (if (featurep 'reportmail)
display-time-announce-mail)]
'["Display-Time-&-Mail" toggle-display-time
:style toggle :selected (memq 'display-time-string global-mode-string)]
;;
;; As of InfoDock V4, highlighting the modeline of the selected window
;; no longer works because it does not change the background color of
;; any glyphs displayed in the modeline.
;; '["Highlight-Current-Modeline" hilit-win
;; :style toggle :selected (and (boundp 'hilit-win-flag) hilit-win-flag)]
;;
'["Keep-Region-Active"
(customize-set-variable 'zmacs-regions (not zmacs-regions))
:style toggle :selected zmacs-regions]
"----"
'["First-Column-Number-is-One" ; Obsolete
(customize-set-variable 'column-number-start-at-one
(not column-number-start-at-one))
:style toggle :selected (and (boundp 'column-number-start-at-one)
(equal column-number-start-at-one 1))
:active (boundp 'column-number-start-at-one)]
'["Line&Col-Number-All-Buffers" ; #### I don't get the point -slb
lc-toggle-all
:style toggle
:selected (and (boundp 'lc-minor-mode) (default-value 'lc-minor-mode))]
"----"
'["Dark-Frames"
(progn
(customize-set-variable 'id-dark-background-flag
(not id-dark-background-flag))
(id-set-faces))
:style toggle :selected (and (boundp 'id-dark-background-flag)
id-dark-background-flag)]
'["Textured-Backgrounds" (id-toggle-frame-backgrounds t)
:style toggle
:selected (and (boundp 'id-background-pixmap-flag)
id-background-pixmap-flag)]
'["Set-Frame-Height" ; This option can't be saved
(set-frame-height
nil (abs (read-number
(format "Frame is %d lines, new number of lines: "
(frame-height)))))
t]
'["Set-Frame-Width" ; This option can't be saved
(set-frame-width
nil (abs (read-number
(format "Frame is %d columns, new number of columns: "
(frame-width)))))
t]
'["Set-New-Frames-Min-Height"
(customize-set-variable
'frame-min-height
(abs
(read-number
(format "Minimum new frame height is %d lines, new number of lines: "
frame-min-height))))
t]
'["Set-New-Frames-Min-Width"
(customize-set-variable
'frame-min-width
(abs (read-number
(format
"Minimum new frame width is %d columns, new number of columns: "
frame-min-width))))
t]
"----"
'["Dedicate-Window-to-Buffer" ; This option can't be saved
id-toggle-dedicate-window
:style toggle :selected (window-dedicated-p nil)]
)
'("Emulation"
["Manual" (id-info "(infodock)Emulation Options") t]
["VIPER-Manual"
(id-info "(viper)Top")
:active (featurep 'viper-autoloads)]
"----"
["CRiSP" ; #### This option can't be saved
(progn
(unless (featurep 'crisp)
(require 'crisp))
(crisp-mode))
:style toggle
:selected (and (featurep 'crisp) crisp-mode-enabled)
:active (featurep 'crisp-autoloads)]
["Toggle-Vi" ; #### This option can't be saved
(call-interactively 'id-toggle-vi)
:style toggle
:selected (and (featurep 'viper) viper-mode)
:active (featurep 'viper-autoloads)]
["Windows-Mac-Motif-Keys"
CUA-mode
:style toggle
:selected (and (boundp 'CUA-mode) CUA-mode)
:active (fboundp 'CUA-mode)]
["WordStar" ; #### This option can't be saved
wordstar-mode
:active (fboundp 'wordstar-mode)]
)
(delq nil
(list
"Face"
["Manual" (id-info "(infodock)Face Options") t]
"----"
["Set-for-All-Frames"
(setq id-face-all-frames-flag (not id-face-all-frames-flag))
:style toggle
:selected id-face-all-frames-flag
:active t]
;; The three next menu items should now work properly when there are
;; frame-local specifiers. -- BW, 06/20/1999
["Synchronize-Face-Fonts" ; This option can't be saved
(id-synchronize-face-fonts id-font-all-frames-flag)
:active (fboundp 'id-synchronize-face-fonts)]
"----" "----"
(if infodock-xemacs-flag (id-face-settings "Frame-Color" 'face-background id-good-colors))
(if infodock-xemacs-flag (id-face-settings "Text-Color" 'face-foreground id-good-colors))
"----"
'["Edit-Faces" edit-faces t]
))
'("File-Header"
["Set-Email-Address"
(let ((address (read-string "Set your e-mail to: "
(or (and (boundp 'hdr-email) hdr-email)
(and (boundp 'user-mail-address) user-mail-address)))))
(customize-set-variable 'user-mail-address address)
(customize-set-variable 'hdr-email address)
(customize-set-variable 'add-log-mailing-address address)) t]
["Set-First-&-Last-Name"
(customize-set-variable
'hdr-author (read-string "Set your first and last name: "
(and (boundp 'hdr-author) hdr-author))) t]
["Set-Organization"
(customize-set-variable
'hdr-organization (read-string "Set your organization to: "
(and (boundp 'hdr-organization) hdr-organization))) t]
"----"
["Set-File-Header-Directory"
(customize-set-variable
'hdr-basename (expand-file-name
"file-hdr."
(read-directory-name "Set directory of file headers: "
(and (boundp 'hdr-basename)
(file-name-directory hdr-basename))))) t]
)
(append
'("Font"
["Manual" (id-info "(infodock)Font Options") t]
"----"
["Set-for-All-Frames" ; This option can't be saved
(setq id-font-all-frames-flag (not id-font-all-frames-flag))
:style toggle
:selected id-font-all-frames-flag]
["Synchronize-Face-Fonts" ; This option can't be saved
(id-synchronize-face-fonts id-font-all-frames-flag)
:active (fboundp 'id-synchronize-face-fonts)]
"----" "----")
(id-font-menu id-good-fonts)) ; This option can't be saved
(list
"Global"
'["Manual" (id-info "(infodock)Global Options") t]
"----"
'["Auto-Adaptive-Fill"
(progn
(require 'filladapt)
(message
"Adaptive filling will %sbe used whenever filling is performed."
(customize-set-variable 'filladapt-mode
(not (default-value filladapt-mode)))
(if filladapt-mode
""
"not ")))
:style toggle
:selected (and (featurep 'filladapt) (default-value filladapt-mode))]
["Auto-Delete-Selection"
(if (memq 'pending-delete-pre-hook pre-command-hook)
(progn
(turn-off-pending-delete)
(message
"Deletion or insertion keys will not replace the highlighted region.")
(customize-set-variable 'id-pc-regions nil))
(turn-on-pending-delete)
(message
"Deletion or insertion keys will now replace the highlighted region.")
(customize-set-variable 'id-pc-regions t))
:style toggle
:selected (memq 'pending-delete-pre-hook pre-command-hook)
:active (featurep 'pc-autoloads)]
'["Auto-File-(De)compression" ; #### this isn't right
(progn (call-interactively 'toggle-auto-compression)
(message
"Compressed files will %sbe decompressed on read and compressed on write."
(if (rassq 'jka-compr-handler file-name-handler-alist)
"" "not ")))
:style toggle :selected (rassq 'jka-compr-handler
file-name-handler-alist)]
["Auto-Scroll-Horizontally"
(progn
(call-interactively 'id-toggle-auto-scroll)
(message
"Buffers will %sautomatically scroll horizontally if lines are truncated."
(if auto-show-mode "" "not ")))
:style toggle :selected (if (boundp 'auto-show-mode) auto-show-mode)]
'["File-Headers"
(progn
(customize-set-variable 'id-file-headers-flag
(not id-file-headers-flag))
(message "File headers will %sbe added to newly created files."
(if id-file-headers-flag "" "not ")))
:style toggle :selected id-file-headers-flag]
'["Insert-Tab-Characters"
(progn
(customize-set-variable 'indent-tabs-mode
(not indent-tabs-mode))
(message "Tab characters will %sbe used within new buffers."
(if indent-tabs-mode
"" "not "))
(customize-set-variable 'id-indent-tabs-mode indent-tabs-mode))
:style toggle :selected indent-tabs-mode]
'["Require-Final-Newline"
(progn
(customize-set-variable 'require-final-newline
(not require-final-newline))
(message "Final newlines will %sbe added to saved files."
(if require-final-newline
""
"not ")))
:style toggle :selected require-final-newline]
["Select-Help-Window"
(progn
(customize-set-variable 'help-selects-help-window
(not help-selects-help-window))
(if help-selects-help-window
(message "Help selects help window")
(message "Help does not select help window")))
:style toggle :selected help-selects-help-window]
'["Teach-Extended-Commands"
(progn
(customize-set-variable 'teach-extended-commands-p
(not teach-extended-commands-p))
(message
"Key bindings for commands invoked by name will %sbe shown."
(if teach-extended-commands-p
""
"not ")))
:style toggle :selected teach-extended-commands-p]
'["Visible-Bell"
(progn
(customize-set-variable 'visible-bell (not visible-bell))
(if visible-bell
(message
"A visual flash of the selected frame indicates a bell sound.")
(message "An audible beep indicates a bell sound.")))
:style toggle :selected visible-bell]
)
(cons "Highlighter" infodock-highlighter-menu)
(if id-hyperbole-p
'("Hyperbole"
:filter id-hyperbole-options-menu-filter
["Manual" (id-info "(infodock)Hyperbole Options") t]
"----"))
'("JDE"
:included (eq major-mode 'jde-mode)
["Autocode-Settings" jde-show-autocode-options t]
["Compile-Settings" jde-show-compile-options t]
["Debug-Settings" jde-show-debug-options t]
["Project-Settings" jde-show-project-options t]
["Run-Settings" jde-show-run-options t]
"----"
["Save-Project" jde-save-project t])
'("Menubar"
:config Menubar
:filter id-menubar-options-menu-filter)
infodock-mode-menu
'("Mouse"
["Manual" (id-info "(infodock)Mouse Options") t]
"----"
["Avoid-Text"
;; Warping the mouse is evil. I wash my hands of this code. -slb
(progn
(if (and mouse-avoidance-mode (not (eq mouse-avoidance-mode 'none)))
(customize-set-variable 'mouse-avoidance-mode 'none)
(customize-set-variable 'mouse-avoidance-mode 'banish))
(mouse-avoidance-mode (or mouse-avoidance-mode 'none)))
:style toggle
:selected (and (boundp 'mouse-avoidance-mode)
mouse-avoidance-mode
(not (eq mouse-avoidance-mode 'none))
(window-system))
:active (and (boundp 'mouse-avoidance-mode)
(window-system))]
["Mouse-Paste-at-Text-Cursor"
(customize-set-variable 'mouse-yank-at-point
(not mouse-yank-at-point))
:style toggle :selected mouse-yank-at-point]
["Mouse-Paste-on-Middle-Key" ; #### FIXME
hmouse-toggle-bindings
:style toggle
:selected (if (boundp 'hmouse-bindings-flag)
(not hmouse-bindings-flag))])
'("OO-Browser"
:included (eq major-mode 'br-mode)
["Concept-Manual" (id-info "(oo-browser)Options") t]
["Menu-Manual" (id-info "(oo-browser)Options Menu") t]
"----"
["Keep-Viewed-Classes" br-toggle-keep-viewed
:style toggle :selected br-keep-viewed-classes
:active t :keys "M-0 v"]
["Graphical-Descendant-Features" br-tree-features-toggle
:style toggle :selected br-show-features]
["List-Protocols-with-Classes" (br-protocols 0)
:style toggle :selected (if (br-protocol-support-p)
br-protocols-with-classes-flag)
:active (br-protocol-support-p) :keys "M-0 P"]
["Show-Inherited-Features"
(setq br-inherited-features-flag
(not br-inherited-features-flag))
:style toggle :selected br-inherited-features-flag
:active t :keys "M-0 f"]
["Use-Vi-as-Editor"
(if br-editor-cmd
(br-setup-internal)
(br-setup-external))
:style toggle :selected br-editor-cmd :active t]
["3-Button-Mouse"
(if (= hyperb:mouse-buttons 3)
(br-two-button-mouse) (br-three-button-mouse))
:style toggle :selected (= hyperb:mouse-buttons 3) :active t])
'("Perl"
:included (eq major-mode 'perl-mode)
["Auto-Help" cperl-toggle-help
:style toggle :selected cperl-help]
["Auto-Newline" cperl-toggle-auto-newline
:style toggle :selected cperl-auto-newline]
["Electric-Keywords" cperl-toggle-abbrev
:style toggle :selected abbrev-mode]
["Electric-Parens" cperl-toggle-electric
:style toggle :selected cperl-electric-parens])
'("Pretty-Printing"
:config Pretty-Printing
:filter id-pretty-printing-menu-filter)
'("Tool"
["Manual" (id-info "(infodock)Tool Options") t]
"----"
["New-Frame-Per-Tool" id-toggle-dedicated-tool-frames
:style toggle
:selected id-tool-new-frame-flag
:active (not (eq (device-type) 'tty))]
["Show-Tool-Menu-Commands"
(customize-set-variable 'id-tool-names-flag (not id-tool-names-flag))
:style toggle :selected id-tool-names-flag]
["Update-Tool-Menu-Commands" id-tool-menu-set-command-names
id-tool-names-flag]
)
'("Toolbar"
["Manual" (id-info "(infodock)Toolbar Options") t]
"----"
["Show" id-toolbar
:style toggle
:selected (and (featurep 'toolbar) (id-toolbar-visible-p))
:active (featurep 'toolbar)]
["At-Bottom"
(progn
(id-set-toolbar-position 'bottom)
(customize-set-variable 'id-default-toolbar-position 'bottom))
:style radio
:selected (if (featurep 'toolbar) (eq (default-toolbar-position)
'bottom))
:active (if (featurep 'toolbar) (specifier-instance default-toolbar))]
["At-Left"
(progn
(id-set-toolbar-position 'left)
(customize-set-variable 'id-default-toolbar-position 'left))
:style radio
:selected (if (featurep 'toolbar) (eq (default-toolbar-position) 'left))
:active (if (featurep 'toolbar) (specifier-instance default-toolbar))]
["At-Right"
(progn
(id-set-toolbar-position 'right)
(customize-set-variable 'id-default-toolbar-position 'right))
:style radio
:selected (if (featurep 'toolbar) (eq (default-toolbar-position) 'right))
:active (if (featurep 'toolbar) (specifier-instance default-toolbar))]
["At-Top"
(progn
(id-set-toolbar-position 'top)
(customize-set-variable 'id-default-toolbar-position 'top))
:style radio
:selected (if (featurep 'toolbar) (eq (default-toolbar-position) 'top))
:active (if (featurep 'toolbar) (specifier-instance default-toolbar))])
(infodock-version-control-options-menu)
(if id-hyperbole-p
'("Web"
:config Web
:filter id-web-options-menu-filter))
'("XEmacs-Lisp"
["Manual" (id-info "(infodock)XEmacs Lisp Options") t]
"----"
["Debug-on-Error" ; The option can't be saved
toggle-error-debugging
:style toggle :selected debug-on-error])
)))
;;; This must precede the definition of infodock-software-menu.
(defconst infodock-xemacs-lisp-menu
'("%_XEmacs-Lisp"
:config XEmacs-Lisp
["Debugging-Manual" (id-info "(lispref)Edebug") t]
["Eval-Manual" (id-info "(xemacs)Lisp Eval") t]
["Intro-Manual" (id-info "(elisp-intro)Top") t]
["Reference-Manual" (id-info "(lispref)Top") t]
"----"
["Compile-Current-Buffer" byte-compile-now
(memq major-mode '(emacs-lisp-mode lisp-interaction-mode))]
["Compile-Directory" byte-recompile-directory t]
["Compile-File" byte-compile-file t]
"----"
["Load-Current-File"
(load-file (if (equal (substring buffer-file-name -1) "c")
buffer-file-name
(concat buffer-file-name "c")))
(if buffer-file-name (eq major-mode 'emacs-lisp-mode))]
["Load-Library" load-library t]
"----"
["Eval-Current-Buffer" eval-buffer
(memq major-mode '(emacs-lisp-mode lisp-interaction-mode))]
["Eval-Preceding-Sexp" eval-last-sexp t]
["Eval-Region" eval-region (region-exists-p)]
["Eval-Sexp-and-Insert" eval-print-last-sexp t]
["Eval-User-Expression" eval-expression t]
"----"
["Check-Parentheses" check-parentheses t]
["Debug-Current-Function" edebug-defun t]
["Disassemble-Function" disassemble t]
["Toggle-Debug-on-Error" toggle-error-debugging t]
"----"
["Lookup-Definition" find-tag t]
["Lookup-in-Manual" lispref-search t]
"----"
["List-Library-Duplicates" elisp-duplicates t]
["List-Matching-Libraries" elisp-matches t]
))
;;; This definition must precede the invocation of infodock-tool-menu.
(defun id-tool-name (id-tool-menu-name)
"Given ID-TOOL-MENU-NAME, append the name of the command it invokes and return as a string.
Return ID-TOOL-MENU-NAME if command cannot be determined or if
`id-tool-names-flag' is nil."
(let ((id-tool (symbol-value
(intern-soft (concat "id-tool-"
(downcase id-tool-menu-name)))))
tool-name)
(setq tool-name
(cond ((null id-tool-names-flag) nil)
((stringp id-tool) (format "\"%s\"" id-tool))
((symbolp id-tool) (format "(%s)" (symbol-name id-tool)))
((functionp id-tool)
(let ((tool) sym-list sublist)
(if (not (compiled-function-p id-tool))
(setq tool (or (nth 1 (car (cdr (assq 'id-tool
id-tool))))
(car (assq 'id-info id-tool))))
(setq sym-list
(mapcar 'identity
(compiled-function-constants id-tool)))
(cond ((setq sublist (memq 'id-tool sym-list))
(setq tool (car (cdr sublist))))
((memq 'id-info sym-list)
(setq tool 'id-info))))
(cond ((and tool (symbolp tool))
(format "(%s)" (symbol-name tool)))
((and tool (listp tool))
(format "(%s)" (symbol-name (car tool))))
;; Can't determine tool name, return nil
(t nil))))
(t ;; sexp
(if (symbolp (car id-tool))
(symbol-name (car id-tool))))))
(if tool-name
(format "%s %s" id-tool-menu-name tool-name)
id-tool-menu-name)))
(defun infodock-tool-menu ()
(delq nil
(list
"%_Tool"
:config 'Tool
'["Manual" (id-info "(infodock)Tool Menu") t]
"----"
(vector (id-tool-name "Speedbar")
'(id-tool-invoke id-tool-speedbar) t)
"----"
(vector (id-tool-name "Spell-Checker")
'(id-tool-invoke id-tool-spell-checker) t)
"----"
(vector (id-tool-name "ANSI-Terminal")
'(id-tool-invoke id-tool-ansi-terminal) t)
(vector (id-tool-name "New-Shell")
'(id-tool-invoke id-tool-new-shell) t)
(vector (id-tool-name "Same-Shell")
'(id-tool-invoke id-tool-same-shell) t)
(vector (id-tool-name "Secure-Shell")
'(id-tool-invoke id-tool-secure-shell) t)
"----"
(vector (id-tool-name "Calculator")
'(id-tool-invoke id-tool-calculator) t)
(vector (id-tool-name "Calendar")
'(id-tool-invoke id-tool-calendar) t)
(vector (id-tool-name "Directory-Editor")
'(id-tool-invoke id-tool-directory-editor) t)
(vector (id-tool-name "Full-Text-Retriever")
'(id-tool-invoke id-tool-full-text-retriever) t)
(vector (id-tool-name "Info-Browser")
'(id-tool-invoke id-tool-info-browser) t)
(vector (id-tool-name "Load-Manager")
'(id-tool-invoke id-tool-load-manager) t)
(vector (id-tool-name "Mail-Composer")
'(id-tool-invoke id-tool-mail-composer) t)
(vector (id-tool-name "Mail-Reader")
'(id-tool-invoke id-tool-mail-reader) t)
(vector (id-tool-name "Mail-Read-File")
'(let ((current-prefix-arg '(4)))
(id-tool-invoke id-tool-mail-read-file)) t)
(vector (id-tool-name "Man-Page-Browser")
'(id-tool-invoke id-tool-man-page-browser) t)
(vector (id-tool-name "NetNews-Composer")
'(id-tool-invoke id-tool-netnews-composer) t)
(vector (id-tool-name "NetNews-Reader")
'(id-tool-invoke id-tool-netnews-reader) t)
(vector (id-tool-name "Outliner")
'(id-tool-invoke id-tool-outliner) t)
(and (boundp 'pgr-server) (stringp pgr-server)
(vector (id-tool-name "Page-Composer")
'(id-tool-invoke id-tool-page-composer) t))
(vector (id-tool-name "Process-Manager")
'(id-tool-invoke id-tool-process-manager) t)
(if id-hyperbole-p
(if (boundp 'infodock-wrolo-menu)
infodock-wrolo-menu
'["Initialize-Rolo-Menu"
(progn
;; This will load hui-menu.el which contains the full
;; Hyperbole menu, including the rolo menu.
(require 'hsite) (id-load-menus t))
t]))
"----"
(vector (id-tool-name "World-Wide-Web")
'(id-tool-invoke id-tool-world-wide-web) t)
"----"
(delq
nil
(list
"Tool-Manuals"
'["Speedbar" (id-tool-invoke id-man-speedbar) t]
"----"
'["Spell-Checker" (id-tool-invoke id-man-spell-checker) t]
"----"
'["ANSI-Terminal" (id-tool-invoke id-man-ansi-terminal) t]
'["Same-Shell" (id-tool-invoke id-man-same-shell) t]
'["Secure-Shell" (id-tool-invoke id-man-secure-shell) t]
"----"
'["Calculator" (id-tool-invoke id-man-calculator) t]
'["Calendar" (id-tool-invoke id-man-calendar) t]
'["Directory-Editor" (id-tool-invoke id-man-directory-editor) t]
'["Full-Text-Retriever"
(id-tool-invoke id-man-full-text-retriever) t]
'["Info-Browser" (id-tool-invoke id-man-info-browser) t]
'["Load-Manager" (id-tool-invoke id-man-load-manager) t]
'["Mail-Composer" (id-tool-invoke id-man-mail-composer) t]
'["Mail-Reader" (id-tool-invoke id-man-mail-reader) t]
'["Mail-Read-File" (id-tool-invoke id-man-mail-read-file) t]
'["Man-Page-Browser" (id-tool-invoke id-man-man-page-browser) t]
'["NetNews-Composer" (id-tool-invoke id-man-netnews-composer) t]
'["NetNews-Reader" (id-tool-invoke id-man-netnews-reader) t]
'["Outliner" (id-tool-invoke id-man-outliner) t]
(and (boundp 'pgr-server) (stringp pgr-server)
'["Page-Composer" (id-tool-invoke id-man-page-composer) t])
'["Process-Manager" (id-tool-invoke id-man-process-manager) t]
'["Rolo" (id-tool-invoke id-man-rolo) t]
"----"
'["World-Wide-Web" (id-tool-invoke id-man-world-wide-web) t]
)))))
;;; This must precede the definition of infodock-web-menu.
(defconst id-ns-bookmarks-menu-items
'("--:shadowEtchedInDash"
["Alphabetize-Bookmarks"
(setq id-ns-bookmarks-sort-flag (not id-ns-bookmarks-sort-flag)
id-ns-bookmarks-menu nil)
:style toggle
:selected id-ns-bookmarks-sort-flag]
["Reload-Bookmarks" (setq id-ns-bookmarks-menu nil) t]
["Set-Bookmarks-Menu-Size"
(progn
(setq id-ns-bookmarks-menu-max-size
(read-number
(format
"Bookmarks menu max length (current = %d; 0 means unlimited): "
(or id-ns-bookmarks-menu-max-size 0))))
(if (eq id-ns-bookmarks-menu-max-size 0)
(setq id-ns-bookmarks-menu-max-size nil))
(setq id-ns-bookmarks-menu nil))
t]))
(defconst infodock-web-menu
`("%_Web"
:config Web
:filter id-ns-bookmarks-menu-filter
["Manual" (id-info "(infodock)Web Menu") t]
"----"
["Browse-Current-Link" id-browse-web-link t]
["Browse-Specific-URL" (id-browse-web-link t) t]
["Find-Regexp-in-Bookmarks" id-ns-bookmarks-grep t]
["Find-String-in-Bookmarks" id-ns-bookmarks-fgrep t]
"----"
"----"
"Netscape-Bookmarks:"
"--:shadowEtchedInDash"))
;;; ************************************************************************
;;; Specialty Menus
;;; ************************************************************************
(defconst infodock-cscope-menu
'("%_Cscope"
:config Cscope
["Set-Project-Directory" cscope-query-path-prefix t]
"----"
["Next-Occurrence" cscope-next-occurrence t]
"----"
["All-Functions/Classes" cscope-find-all t]
["Functions-Called-by" cscope-find-functions-called t]
["Functions-that-Call" cscope-find-functions-calling t]
"----"
["Id-Definition" cscope-find-global-definition t]
["Id-References" cscope-find-c-symbol t]
"----"
["Egrep-Regexp" cscope-find-egrep-pattern t]
["Grep-Regexp" cscope-find-grep-pattern t]
["Text-String" cscope-find-text-string t]
"----"
["Filename-Matches" cscope-find-file t]
["Files-that-Include" cscope-find-files-including t]
"----"
["Rebuild-Program-Database" cscope-admin-rebuild-db t]
["Toggle-Case-Sensitivity" cscope-admin-toggle-case t]
"----"
["Quit" cscope-admin-quit-and-kill-buffer t]
)
"Requires `cscope' C/C++ analysis program, originally from AT&T, to work.")
(defconst infodock-modeline-frame-menu
'("Frame Commands"
["Create" id-create-frame t]
["Delete" id-delete-frame
:active (not (eq (next-frame (selected-frame) 'nomini 'window-system)
(selected-frame)))]
["Delete-All-Others" delete-other-frames t]
["Iconify" iconify-frame t]
["Lower" lower-frame t]
["Raise" raise-frame t]
))
(defconst infodock-modeline-menu
'("Display Commands"
["Close-Buffer" id-delete-buffer t]
["Close-Buffer-and-Window" id-delete-buffer-and-window t]
["Display-Window-in-New-Frame" id-display-window-in-new-frame t]
"----"
["Balance-Windows" balance-windows t]
["Delete-Window" delete-window (not (one-window-p t))]
["Delete-Other-Windows" delete-other-windows (not (one-window-p t))]
["Split-Window-Stacked" split-window-vertically t]
["Split-Window-Side-by-Side" split-window-horizontally t]
"----"
["Hide-Toolbar" id-toolbar
:style toggle
:selected (and (featurep 'toolbar) (not (id-toolbar-visible-p)))
:active (featurep 'toolbar)]
"----"
["Line-Numbers" setnu-mode
:style toggle :selected (if (boundp 'setnu-mode) setnu-mode)]
["Line&Col-Number" lc-minor-mode
:style toggle
:selected (and (boundp 'lc-minor-mode) lc-minor-mode)]
"----"
["Create-Frame" id-create-frame t]
["Delete-Frame" id-delete-frame t]
["Delete-All-Other-Frames" delete-other-frames t]
["Iconify-Frame" (iconify-frame) t]
["Iconify-InfoDock" iconify-emacs t]
["Lower-Frame" lower-frame t]
["Other-Frame" other-frame t]
["Raise-Frame" raise-frame t]
))
(defun id-popup-context-menu (&rest args)
"Popup a menu for the major mode of the buffer that the mouse is over.
Has the side-effect of setting point to the window that the mouse is over."
(interactive "_")
(let* ((toolbar-p (event-over-toolbar-p current-mouse-event))
(wind (if (not toolbar-p) (event-window current-mouse-event)))
region-window)
(if toolbar-p
(id-popup-toolbar-menu)
(setq region-window (selected-region-window))
(cond ((if region-window (eq region-window wind))
(if wind (select-window wind))
(id-popup-selection-menu))
(t
;; If we reach here and a region is selected, it must be
;; in some other window than the one in which the mouse event
;; occurred, so deselect the region before switching to the
;; mouse event window.
(if region-window (zmacs-deactivate-region))
(if wind (select-window wind))
(let* ((menu-sym (id-popup-menu-symbol)))
(cond (menu-sym
(if (fboundp menu-sym)
(id-popup-titled-menu (funcall menu-sym))
(id-popup-titled-menu menu-sym)))
((and (boundp 'mode-popup-menu) mode-popup-menu)
(id-popup-titled-menu mode-popup-menu))
(t
(ding)
(message "No popup menu defined for this mode.")))))))))
(defun id-popup-menu-symbol ()
"Return the first found menu symbol for this buffer's minor modes or major mode.
Allow first matching minor-mode popup menu to take precedence over the major
mode's popup menu. Nil is returned if no matching symbol is found."
(let ((menu-sym) md-name menu-name)
(mapcar
(function (lambda (mode)
(unless menu-sym
(setq md-name (symbol-name mode))
(setq menu-name (concat "id-popup-"
(if (> (length md-name) 5)
(substring md-name 0 -5)
md-name)
"-menu"))
(setq menu-sym (intern-soft menu-name)))))
;; Allow first matching minor-mode popup menu to take precedence over
;; the major mode's popup menu. This returns an ordered list of minor
;; modes followed by the major mode.
(nconc
(delq
nil
(mapcar
(function (lambda (sexp)
(and sexp (symbolp sexp)
(boundp sexp) (symbol-value sexp)
sexp)))
(mapcar 'car minor-mode-alist)))
(list major-mode)))
menu-sym))
(defun id-popup-frame-menu ()
"Popup a menu of frame commands. Click on one to select it."
(interactive)
(popup-menu infodock-modeline-frame-menu))
(defun id-popup-modeline-menu (event)
(interactive "e")
;; Work around bug that sometimes causes this command to be bound to button3
;; globally (we don't know why), rather than just within the modeline-map.
;; Bob Weiner, 6/23/97.
(if (not (event-over-modeline-p event))
(id-popup-context-menu)
(let ((window (and (event-over-modeline-p event) (event-window event))))
;; Don't select the minibuffer window.
(if (eq window (minibuffer-window (event-frame event)))
(setq window (previous-window window)))
(select-window window)
(let ((popup-menu-titles t))
(popup-menu (cons (format "Window of %S:"
(buffer-name (window-buffer window)))
(cdr infodock-modeline-menu)))))))
(defun id-popup-titled-menu (menu)
"Popup MENU (a menu or menu symbol) with a prepended title derived from its name."
(if (symbolp menu) (setq menu (symbol-value menu)))
(let* ((title (car menu))
(titled-menu
(append
(list (concat (upcase title) " MENU"));; display name as title
(cdr menu)))
(popup-menu-titles t))
(popup-menu titled-menu)))
;;; ************************************************************************
;;; Frame and Window Handling
;;; ************************************************************************
(defun id-shuffle-frame ()
"Toggle frame location in pile.
If on top, sends to bottom, and vice versa."
(interactive)
(let ((frame (selected-frame)))
(if (frame-totally-visible-p frame)
(lower-frame frame)
(raise-frame frame))))
(defun selected-region-window ()
"Return window of user selected region or rectangle, if any.
If `zmacs-regions' is nil, this function always returns nil."
(if (and zmacs-regions zmacs-region-active-p)
(if zmacs-region-rectangular-p
(selected-window)
(get-buffer-window (extent-object zmacs-region-extent)))))
;;; ************************************************************************
;;; Menu Manipulation Functions - from XEmacs menubar.el
;;; ************************************************************************
(require (if hyperb:xemacs-p 'menubar 'menu-bar))
;;; ************************************************************************
;;; Popup Menu Functions - adapted from XEmacs menubar-items.el
;;; ************************************************************************
(defconst default-popup-menu
(append
'("Default"
["Undo" advertised-undo
:active (and (not (eq buffer-undo-list t))
(or buffer-undo-list pending-undo-list))
:suffix (if (or (eq last-command 'undo)
(eq last-command 'advertised-undo))
"More" "")]
"----")
infodock-x-edit-menu
'("----"
["Select-Block" mark-paragraph t]
["Split-Window" (split-window) t]
["Unsplit-Window" delete-other-windows t])))
(defvar global-popup-menu nil
"The global popup menu. This is present in all modes.
See the function `popup-menu' for a description of menu syntax.")
(defvar mode-popup-menu nil
"The mode-specific popup menu. Automatically buffer local.
This is appended to the default items in `global-popup-menu'.
See the function `popup-menu' for a description of menu syntax.")
(make-variable-buffer-local 'mode-popup-menu)
;; This simple menu is superceded by any mode-specific popup menu.
(setq-default mode-popup-menu default-popup-menu)
(defvar activate-popup-menu-hook nil
"Function or functions run before a mode-specific popup menu is made visible.
These functions are called with no arguments, and should interrogate and
modify the value of `global-popup-menu' or `mode-popup-menu' as desired.
Note: this hook is only run if you use `popup-mode-menu' for activating the
global and mode-specific commands; if you have your own binding for button3,
this hook won't be run.")
(defun popup-mode-menu ()
"Pop up a menu of global and mode-specific commands.
The menu is computed by combining `global-popup-menu' and `mode-popup-menu'."
(interactive "@_")
(run-hooks 'activate-popup-menu-hook)
(popup-menu
(cond ((and global-popup-menu mode-popup-menu)
(check-menu-syntax mode-popup-menu)
(let ((title (car mode-popup-menu))
(items (cdr mode-popup-menu)))
(append global-popup-menu
'("---" "---")
(if popup-menu-titles (list title))
(if popup-menu-titles '("---" "---"))
items)))
(t
(or mode-popup-menu
global-popup-menu
(error "No menu here."))))))
;;; ************************************************************************
;;; Support Functions and Variables
;;; ************************************************************************
(defvar c-mode-hook nil)
(defvar c++-mode-hook nil)
(defvar lisp-mode-hook nil)
(defvar emacs-lisp-mode-hook nil)
(defun id-add-dynamic-menubar-items (menubar)
"Return mode-specific MENUBAR with left-most menu added and a button that toggles the type of menubar at the right."
(append
(if id-add-left-mode-menu-flag
;; Prepend the left-most menu from the current non-mode-specific
;; menubar type.
(list (car (default-value 'default-menubar))))
menubar
(list nil
(cond ((eq infodock-previous-menubar-type 'menubar-simple)
'["Simple-%_Menubar" menubar-simple t])
((eq infodock-previous-menubar-type 'menubar-xemacs)
'["XEmacs-%_Menubar" menubar-xemacs t])
(t
'["InfoDock-%_Menubar" menubar-infodock t])))))
(eval-when-compile (require 'hact))
(defun id-browse-web-link (url)
"Display within a web browser a file, URL or relative link at point or prompt for one if a prefix arg is given.
The variable, `browse-url-browser-function,' controls which web browser is
used for browsing.
Also works properly if point is on a dired file entry or a delimited
pathname.
When called from a program, prompts for the url to use if the URL argument
is t.
If called interactively without a prefix argument when there is no valid
reference at point, beeps and informs user of the problem.
Returns t if attempted to display the reference or nil otherwise."
(interactive
(list (if current-prefix-arg (read-string "URL to browse: "))))
(require 'hsite)
(require 'hsys-w3)
(if (and url (not (stringp url)))
(setq url (read-string "URL to browse: ")))
(cond
((stringp url)
(setq url (or (hpath:www-p url) (hpath:is-p url))))
((eq major-mode 'dired-mode)
(setq url (dired-get-filename)))
((setq url (hpath:www-at-p)))
((setq url (hpath:at-p)))
((setq url (hpath:remote-p buffer-file-name)))
(t (setq url (concat "file://" buffer-file-name))))
(cond ((stringp url)
(cond ((hpath:remote-p url)
(if (string-match "/\\([^@]+@\\)?\\([^:]+\\):/?\\(.*\\)\\'" url)
(setq url (format "ftp://%s%s/%s"
(if (and (match-string 1 url)
(not (string-equal
(match-string 1 url)
"anonymous@")))
(match-string 1 url)
"")
(match-string 2 url)
(match-string 3 url)))))
((hpath:www-p url)
nil)
(t (setq url (concat "file://" (expand-file-name url)))))
(hact 'www-url url)
t)
((interactive-p)
(message
"(id-browse-web-link): No URL or readable html file at point to browse")
(beep)
nil)))
(defvar id-buffer-menubar-symbol nil
"Cached buffer-local menubar symbol, used by mode-menubars.")
(make-variable-buffer-local 'id-buffer-menubar-symbol)
(defvar id-c-style-global-flag t
"*When nil, C/C++ Set-Indent-Style menu sets style for current buffer, else sets it for all buffers (default).")
(defun id-c-styles-menu ()
"Return C/C++/Java Set-Indent-Style menu."
(require 'cc-mode) ;; Defines c-style-alist, used herein.
(c-initialize-cc-mode)
(append
'("Set-Indent-Style"
["For-All-Buffers"
(setq id-c-style-global-flag (not id-c-style-global-flag))
:style toggle :selected id-c-style-global-flag]
"----"
)
(mapcar
(function (lambda (style)
(vector (capitalize style)
(list 'id-c-set-style style 'id-c-style-global-flag)
:style 'radio
:selected (list 'string-equal (downcase style)
'c-indentation-style))))
(mapcar 'car c-style-alist))))
(defun id-c-set-style (style global-flag)
"Set C-code indentation STYLE in current buffer or globally if GLOBAL-FLAG is non-nil."
(if (not global-flag)
(c-set-style style)
;; Use this style in newly created buffers.
(setq-default c-file-style style)
;; Set this style in existing buffers.
(let ((mode major-mode))
(save-excursion
(mapcar
(function (lambda (buf)
(set-buffer buf)
(if (eq major-mode mode) (c-set-style style))))
(buffer-list))))))
(defun id-create-frame ()
"Create and display a new frame."
(interactive)
(select-frame
(make-frame
(delq nil
(nconc
(if (> frame-min-width 0) (list 'width frame-min-width))
(if (> frame-min-height 0) (list 'height frame-min-height)))))))
(defun id-credits ()
"Display file of InfoDock credits with graphics."
(beopen-display-file (locate-data-file "ID-CREDITS")))
(defun id-display-frame-size ()
(interactive)
(message
"Frame \"%s\" - Width: %d; Height: %d (New Frames - Min Width: %d; Min Height: %d)"
(frame-name) (frame-width) (frame-height) frame-min-width frame-min-height))
(defun id-splash-buffer ()
"Redisplay InfoDock splash screen."
(interactive)
(let ((buffer (get-buffer-create "*Splash*")))
(set-buffer buffer)
(erase-buffer buffer)
(startup-splash-frame)
(pop-to-buffer buffer)
(delete-other-windows)))
(defvar beopen-banner-keymap
(let ((map (make-sparse-keymap)))
(define-key map 'button1 'beopen-home-page)
(define-key map 'button2 'beopen-home-page)
(define-key map '(return) 'beopen-home-page)
map)
"Keymap used when on the BeOpen.com banner glyph.")
(defun beopen-home-page ()
"Visit http://www.BeOpen.com."
(interactive)
(require 'hsys-w3) (require 'hact)
(hact 'www-url "http://www.beopen.com"))
(defun beopen-display-file (file)
"Display a text FILE with the BeOpen.com banner prepended."
(id-view-file file)
(if (or (not (fboundp 'make-glyph))
(let ((extent (next-extent (current-buffer))))
(and extent (extent-property extent 'beopen-banner))))
;; Either image support is unavailable or the image has already been
;; inserted, so don't reinsert it.
nil
(let* ((beopen-banner
(make-glyph (vector 'xpm
:file
(locate-data-file "beopen-banner.xpm"))))
(buffer-read-only)
extent)
(insert "\n")
(goto-char (point-min))
;; This will bug out if no spaces are required to center the image
;; So insert a dummy character
(insert "\n")
(indent-to (startup-center-spaces beopen-banner))
(insert "\n\n")
(setq extent (make-extent (- (point) 3) (- (point) 2)))
(set-extent-end-glyph extent beopen-banner)
(set-extent-property extent 'beopen-banner t)
(set-extent-property extent 'help-echo "Click to visit http://www.BeOpen.com.")
(set-extent-property extent 'keymap beopen-banner-keymap))
(goto-char (point-min))
(skip-syntax-forward "-")
(set-window-start (selected-window) 1)
(set-buffer-modified-p nil)))
(defun id-compile ()
"Invoke a compilation command in the background.
Under X, uses a dialog box to choose between invoking prior compilation
command or editing the command."
(interactive)
(require 'compile)
(if (eq (device-type) 'tty)
(call-interactively 'compile)
(popup-dialog-box
`(, (concat "Current command: " compile-command)
["Execute" (compile compile-command) t]
["Edit-Command" compile t]
["Hide-Compilation-Frame"
(let ((frame (get-frame-for-mode 'compilation-mode)))
(if (equal (frame-name frame) "Compilation")
(make-frame-invisible frame))) t]
nil
["Cancel" (message "Quit") t]))))
(defun id-create-buffer (buffer-name)
"Create a new buffer or switch to an existing one with BUFFER-NAME."
(interactive "BCreate buffer: ")
(switch-to-buffer (get-buffer-create buffer-name)))
;; This alias allows quick invocation of the debugger by typing {M-x idd RET}
;; to minimize keystrokes prior to the user binding it to a key. Use this
;; name whenever calling it interactively in menus so that a key binding, if
;; any, appears.
(defalias 'iddebug 'id-debug)
(defun id-debug (&optional cmd)
"Invoke a debugger using optional Lisp CMD (default is the value of `id-default-debugger')."
(interactive)
(or cmd (setq cmd id-default-debugger))
(let ((id-tool-visible-flag 'visible)
(mode (cond ((memq cmd '(perldb perl5db))
'perldb-mode)
((memq cmd '(idgdbsrc gdb gdbsrc))
'gdbsrc)
(t 'gud-mode))))
(id-tool cmd (if (eq cmd 'idgdbsrc)
'IDgdbsrc
(intern (capitalize (symbol-name cmd))))
mode 1)))
(defun id-define-key (keymap key definition)
"In KEYMAP, bind KEY to command or other DEFINITION."
(interactive
(let ((keymap-names) key keymap-sym keymap sym-name)
(setq key (read-key-sequence "Key to set: "))
(mapatoms
(function (lambda (sym)
(setq sym-name (symbol-name sym))
(if (string-match "-mode-map$" sym-name)
(setq keymap-names
(cons (cons sym-name nil) keymap-names))))))
(setq keymap-sym (intern-soft
(completing-read
(format "Set {%s} in keymap: " (key-description key))
keymap-names))
keymap (symbol-value keymap-sym))
(if (and (fboundp 'events-to-keys) (vectorp key))
(setq key (events-to-keys key)))
(list keymap key
(read-command
(format "Set {%s} in `%s' to invoke: "
(key-description key) keymap-sym)))))
(define-key keymap key definition))
(defun id-delete-buffer ()
"Delete the current buffer, handling id-edit server frames properly."
(interactive)
(if (and (boundp 'server-buffer-clients) server-buffer-clients)
;; If this buffer is the result of an edit request from an external
;; application, signal that edit is done and delete frame.
(let ((buf (current-buffer)))
(server-edit) (kill-buffer buf))
(kill-buffer nil)))
(defun id-delete-buffer-and-window ()
"Delete the current buffer, handling id-edit server frames properly."
(interactive)
(if (and (boundp 'server-buffer-clients) server-buffer-clients)
;; If this buffer is the result of an edit request from an external
;; application, signal that edit is done and delete frame.
(let ((buf (current-buffer)))
(server-edit) (kill-buffer buf))
(kill-buffer nil)
(delete-window)))
(defun id-delete-frame ()
"Delete the selected frame, handling id-edit server frames properly."
(interactive)
(if (and (boundp 'server-buffer-clients) server-buffer-clients)
;; If this buffer is the result of an edit request from an external
;; application, signal that edit is done and delete frame.
(server-edit)
;; Otherwise, just delete frame.
(delete-frame)))
;;; This routine does not support coding-systems.
;;; #### FIXME, this won't work on Microsoft Windows, or with Mule.
(defun id-delete-returns ()
"Remove carriage returns inserted by Microsoft operating systems."
(interactive "*")
(save-excursion
(goto-char (point-min))
(let ((found (search-forward "\r" nil t)))
(goto-char (point-min))
(while (search-forward "\r" nil t)
(replace-match ""))
(if (interactive-p)
(if found
(message "All ^M characters have been removed from the buffer.")
(message "There are no ^M characters in the buffer."))))))
(defun id-dired-menu ()
"Display a buffer menu of only directory buffers in dired-mode."
(interactive)
(buffer-menu nil)
(setq buffer-read-only nil)
(delete-non-matching-lines " Dired ")
(setq buffer-read-only t))
(defun id-display-kbd-macro (symbol)
"Display SYMBOL's keyboard macro definition and any associated key bindings.
Nil value for symbol displays current keyboard macro."
(interactive "CDisplay kbd macro named (RETURN for current macro): ")
(let ((buf-name "*Keyboard Macro*"))
(with-output-to-temp-buffer buf-name
(set-buffer (get-buffer buf-name))
;; Insert last keyboard macro.
(insert-kbd-macro (or symbol (intern "")) t))))
(defun id-execute-current-kbd-macro (count)
"Execute current keyboard macro COUNT times. 0 means until error."
(interactive "nRepeat count for current macro (0 = until error): ")
(call-last-kbd-macro count))
(defun id-execute-kbd-macro (symbol count)
"Execute keyboard macro with SYMBOL name repeat COUNT times. 0 means until error."
(interactive
"SName of macro to execute: \nnRepeat count (0 = until error): ")
(execute-kbd-macro symbol count))
(defun id-function-menu-filter (menu-items)
"\"Functions\" menu filter for use in code editing buffers."
(save-current-buffer
(let ((func-menu-items (id-function-menu t 'full)))
;; id-function-menu returns 't if no functions are found.
(if (eq func-menu-items t)
menu-items
(append menu-items func-menu-items)))))
(defun id-get-directory-name (action-str must-match)
"Prompt with ACTION-STR to get MUST-MATCH (t or nil) directory name."
(read-file-name
(format "Directory to %s: " action-str)
nil default-directory must-match))
(defun id-get-mode-menubar (menubar-symbol)
"Return menubar named by MENUBAR-SYMBOL or nil if none."
(cond ((fboundp menubar-symbol)
(funcall menubar-symbol))
((boundp menubar-symbol)
(symbol-value menubar-symbol))))
(defun id-hyperbole-options-menu-filter (menu-items)
(require 'hui-menu)
(if (not (fboundp 'infodock-hyperbole-menu))
(load "hui-menu"))
(append menu-items hui-menu-options))
(defun id-hyperbole-menu-filter (menu-items)
(require 'hui-menu)
(if (not (fboundp 'infodock-hyperbole-menu))
(load "hui-menu"))
;; Remove "Hyperbole" title and :config Hyperbole entries since
;; these will be prepended to the filter result.
(nthcdr 3 (infodock-hyperbole-menu)))
(defun id-indent-region-rigidly (&optional cols)
"Indent the current region optional COLS further or prompt for COLS."
(interactive)
(or (integerp cols)
(while (not (integerp
(setq cols (read-expression
"Indent region how many additional columns: "))))
(beep)))
(setq cols (abs cols))
(indent-code-rigidly (region-beginning) (region-end) cols))
(defun id-indent-region-to-column (&optional col)
"Indent the current region to optional COL or prompt for column."
(interactive)
(or (integerp col)
(while (not (integerp
(setq col (read-expression
"Indent region to column (0 for leftmost): "))))
(beep)))
(setq col (abs col))
(replace-regexp-region "^[ \t]+" "" nil t)
(indent-region (region-beginning) (region-end) col))
(defun id-info (node &optional visible-flag)
"Display NODE in Info-Browser Tool.
NODE must be of the form `(file)nodename'.
Optional VISIBLE-FLAG (default = visible) gives the display state for tool.
See the documentation for `id-tool-visible-flag' for valid values."
;; If in the OO-Browser and Info will be displayed in this frame, ensure it
;; is displayed in the Viewer window.
(and (not id-tool-new-frame-flag)
(fboundp 'br-in-browser)
(br-in-browser)
(br-to-view-window))
(let ((id-tool-visible-flag (or visible-flag 'visible)))
(id-tool `(progn
;; Ensure Info reader has been loaded.
(info)
;; Go to specific node.
(if ,node (Info-goto-node ,node)))
'Info-Browser 'Info-mode 1)))
(defun id-initialize-hyperbole-menu ()
"Initialize the menubar menu for the Hyperbole information management system."
(interactive)
;; This will load hui-menu.el which contains the full Hyperbole menu.
(require 'hsite)
(id-load-menus t))
(defun id-load-menus (&optional no-load)
"Reload InfoDock menus from disk and update all existing frame menubars.
With optional NO-LOAD non-nil, update frame menubars to default but skip
reloading of menus."
(interactive "P")
(let ((obuf (current-buffer)))
(unwind-protect
(let ((default-menu-bufs
(delq nil (mapcar
(function
(lambda (buf)
(set-buffer buf)
;; Remove any cached mode-specific menubar.
(setq id-buffer-menubar-symbol nil)
(if (or (car (find-menu-item current-menubar
'("Tool")))
(car (find-menu-item current-menubar
'("Options"))))
buf)))
(buffer-list)))))
(if no-load
nil
(if (featurep 'generic-sc)
(load "generic-sc"))
(if (featurep 'mb-simple)
(load "mb-simple"))
(if (featurep 'id-x-menubar)
(load "id-x-menubar"))
(if (featurep 'jumpmenu)
(load "jumpmenu"))
;; Reinitialize infodock-hyperbole-menu.
(if (featurep 'hui-menu)
(load "hui-menu"))
;; Reinitialize koutliner menus.
(if (featurep 'kmenu)
(load "kmenu"))
;; Reinitialize OO-Browser menus.
(if (featurep 'br-menu)
(load "br-menu"))
;; This resets default menubar.
(load "id-menus")
(load "id-popup")
(if (featurep 'id-menubars)
(load "id-menubars")))
;;
;; Reset default menubar.
(setq infodock-menubar (infodock-menubar))
(infodock-initialize-menubar)
;;
;; Reset all buffers with copies of default menubars to new default.
(mapcar (function
(lambda (buf)
(if (assq 'current-menubar (buffer-local-variables buf))
(progn (set-buffer buf)
(set-buffer-menubar default-menubar)))))
default-menu-bufs))
(set-buffer obuf))))
;; Ensure these have a value, even if not loaded.
(defun id-menu-item-invalid ()
(interactive)
(beep)
(message "This menu item is not yet implemented."))
(defun id-menubar-options-menu-filter (menu-options)
"Set the Options/Menubar menu to reflect user-specified non-hidden menus."
(let* ((menu-items1
(append
'(
["Manual" (id-info "(infodock)Menubar Options") t]
"----")
id-menubar-types
'("----")
'(["Add-Left-Menu-to-Mode-Menubars"
(progn
(customize-set-variable 'id-add-left-mode-menu-flag
(not id-add-left-mode-menu-flag))
(if (eq infodock-menubar-type 'menubar-modes)
;; Regenerate all menubars with the new setting.
(menubar-modes)))
:style toggle
:selected id-add-left-mode-menu-flag
:active t]
"----")
(mapcar
(lambda (menu-sym)
(vector
(concat "Hide-" (symbol-name menu-sym) "-Menu")
`(progn
(set-menubar-dirty-flag)
(if (memq ',menu-sym menubar-configuration)
(customize-set-variable 'menubar-configuration
(delq ',menu-sym
menubar-configuration))
(customize-set-variable 'menubar-configuration
(cons ',menu-sym
menubar-configuration))))
:style 'toggle
:selected `(not (memq ',menu-sym
menubar-configuration))))
id-all-configurable-menus)))
(middle (/ (length menu-items1) 2))
(menu-items2 (list "----" (cons "More" (nthcdr middle menu-items1)))))
(setcdr (nthcdr (1- middle) menu-items1) menu-items2)
menu-items1))
(defun id-display-window-in-new-frame ()
"Delete the selected window and display its buffer in a newly selected frame.
The window is deleted only if there are two or more windows in the selected
frame."
(interactive)
(let ((buffer (current-buffer)))
(or (one-window-p t)
(delete-window))
(id-create-frame)
(switch-to-buffer buffer)))
(defun id-not-infodock-menubar (menubar)
"Return t if MENUBAR is non-nil and is not the global InfoDock menubar."
(if menubar
(not (car (find-menu-item menubar '("Key"))))))
(defun id-popup-menubar-menu ()
"Popup a menu containing the entire default InfoDock menubar."
(interactive)
(id-popup-titled-menu infodock-popup-menubar))
(defun id-popup-selection-menu ()
"Popup a region or rectangle selection menu based on the type of the selection."
(id-popup-titled-menu
(if zmacs-region-rectangular-p
infodock-rectangle-menu
infodock-region-menu)))
(defun id-pretty-printing-menu-filter (menu-options)
(if (featurep 'ps-print)
'(["Manual" (id-info "(infodock)Pretty-Printing Options") t]
"----"
["Color-Printing"
;; Synched from XEmacs 21.0 menubar
(cond (ps-print-color-p
(customize-set-variable 'ps-print-color-p nil)
;; I'm wondering whether all this muck is useful.
(and (boundp 'original-face-background)
original-face-background
(set-face-background 'default original-face-background)))
(t
(customize-set-variable 'ps-print-color-p t)
(setq original-face-background
(face-background-instance 'default))
(set-face-background 'default "white")))
:style toggle
:selected ps-print-color-p
:active (boundp 'ps-print-color-p)]
["Duplexing"
(customize-set-variable 'ps-spool-duplex
(not ps-spool-duplex))
:style toggle
:selected ps-spool-duplex
:active (boundp 'ps-spool-duplex)]
("Headers"
["Enable"
(customize-set-variable 'ps-print-header (not ps-print-header))
:style toggle
:selected (and (boundp 'ps-print-header) ps-print-header)
:active (boundp 'ps-print-header)]
["Box"
(customize-set-variable 'ps-print-header-frame
(not ps-print-header-frame))
:style toggle
:selected (and (boundp 'ps-print-header-frame) ps-print-header-frame)
:active (boundp 'ps-print-header-frame)]
["Page N of M"
(customize-set-variable 'ps-show-n-of-n (not ps-show-n-of-n))
:style toggle
:selected (and (boundp 'ps-show-n-of-n) ps-show-n-of-n)
:active (boundp 'ps-show-n-of-n)])
("Page-Size"
["Letter"
(customize-set-variable 'ps-paper-type 'ps-letter)
:style radio
:selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'ps-letter))
:active (boundp 'ps-paper-type)]
["Legal"
(customize-set-variable 'ps-paper-type 'ps-legal)
:style radio
:selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'ps-legal))
:active (boundp 'ps-paper-type)]
["A4"
(customize-set-variable 'ps-paper-type 'ps-a4)
:style radio
:selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'ps-a4))
:active (boundp 'ps-paper-type)]))
'(["Manual" (id-info "(infodock)Pretty-Printing Options") t]
"----"
["Initialize-Menu" (require 'ps-print) t])))
(defun id-print-buffer (buffer &optional print-function)
"Print BUFFER and tell user that buffer has been printed.
BUFFER may be a buffer or buffer name. Nil means current buffer.
Optional PRINT-FUNCTION is a function of no arguments that is used to print
the current buffer. It defaults to `print-buffer'."
(interactive "bName of buffer to print: ")
(cond ((null buffer) (setq buffer (current-buffer)))
((bufferp buffer))
((and (stringp buffer)
(get-buffer buffer)))
(t (error "(id-print-buffer): Invalid buffer: `%s'" buffer)))
(save-excursion
(set-buffer buffer)
(if (functionp print-function) (funcall print-function) (print-buffer))
(message "Buffer sent to %s printer" (or (getenv "PRINTER") "default"))))
(defun id-print-frame (&optional printer)
"Prompt for frame to click upon and to send to default or optional PRINTER."
(interactive "sPrint some frame on the Postscript printer named (RET for default): ")
(message
"When your cursor changes to a plus sign, click on a frame to print.")
(shell-command
(format
"xwd -frame | xpr -dev ps -portrait -gray 2 | lpr %s"
(if (and (stringp printer) (not (string-equal printer "")))
(concat "-P" printer)
"")))
(message "The beeps mean the frame has been sent to the %s printer."
(or (getenv "PRINTER") "default")))
(defun id-read-mail ()
"Invoke Rmail mail tool.
Warn how Rmail handles mail if user has no Rmail file."
(interactive)
(let ((frame-name-sym 'Mail-Reader))
(if (or (file-exists-p rmail-file-name)
;; Frame being made invisible...
(progn
(id-set-tool-mode-frame mjr-mode frame-name-sym)
(let ((frame (get-frame-for-mode 'rmail-mode)))
(and id-tool-new-frame-flag
(not (eq (device-type) 'tty))
(or (and id-tool-visible-flag
(not (eq id-tool-visible-flag 'visible))
(frame-visible-p frame))
(eq id-tool-visible-flag 'invisible)))))
(progn
(beep)
(yes-or-no-p
"Read new mail? This will move your mail and convert its format. ")))
(id-tool 'rmail frame-name-sym 'rmail-mode))))
(defun id-rectangle-menu-filter (menu-items)
"Determines activation of menu items on the Rectangle menu."
(if (or (and (not zmacs-regions) (region-exists-p))
(and zmacs-region-rectangular-p (selected-region-window)))
menu-items
'(["Manual" (id-info "(xemacs)Rectangles") t]
"----"
["Select-Rectangles" id-toggle-rectangle-region
:style toggle :selected mouse-track-rectangle-p]
"----"
["Yank" yank-rectangle t]
["Yank-from-Register" insert-register t])))
(defun id-region-menu-filter (menu-items)
"Determines activation of menu items on the Region menu."
(if (and (not (and zmacs-regions zmacs-region-rectangular-p))
(region-exists-p))
menu-items
'(["Manual" (id-info "(xemacs)Using Region") t]
"----"
["Select-Rectangles" id-toggle-rectangle-region t]
["Toggle-Selection" toggle-region t]
"----"
["Yank (Paste)" (if (eq last-command 'yank)
(call-interactively 'yank-pop)
(call-interactively 'yank))
:keys "C-y"
:active (not (zerop (length kill-ring)))]
)))
(defun id-rmail-pretty-print-message ()
"Pretty print the current message to the user's default printer and inform the user."
(interactive)
(save-window-excursion
(let (msgnum)
(cond ((eq major-mode 'rmail-summary-mode)
(rmail-summary-goto-msg nil nil t)
(setq msgnum (rmail-summary-message-number))
(set-buffer rmail-buffer)
(rmail-show-message msgnum))
((not (eq major-mode 'rmail-mode))
(error
"(id-rmail-pretty-print-message): Use within an Rmail buffer only.")))
(call-interactively 'ps-print-region-or-buffer)
(message "Message %d sent for pretty printing by the `%s' printer."
rmail-current-message
(or (getenv "PRINTER") "lpr")))))
(defun id-rmail-print-message ()
"Print the current message to the user's default printer and inform the user."
(interactive)
(save-window-excursion
(let (msgnum)
(cond ((eq major-mode 'rmail-summary-mode)
(rmail-summary-goto-msg nil nil t)
(setq msgnum (rmail-summary-message-number))
(set-buffer rmail-buffer)
(rmail-show-message msgnum))
((not (eq major-mode 'rmail-mode))
(error
"(id-rmail-print-message): Use within an Rmail buffer only.")))
(call-interactively 'print-region-or-buffer)
(message "Message %d sent for printing by the `%s' printer."
rmail-current-message
(or (getenv "PRINTER") "lpr")))))
(defun id-set-default-font (font &optional frame)
"Set default, modeline and all `site-default-faces' fonts to use FONT.
Optional FRAME specifies that faces should be updated in that frame only."
;;
(require 'site-frame)
(mapcar (function (lambda (face)
(if (setq face (find-face face))
(set-face-font face font frame
nil (if frame nil 'remove-all)))))
(append '(default modeline bold bold-italic italic message-headers
hm--html-help-face)
site-default-faces))
(if frame
nil
(setq id-default-font font)
(add-hook 'create-frame-hook 'id-set-frame-font)))
(defun id-set-buffer-menubar (menubar)
"Set the buffer-local menubar to be MENUBAR.
See `current-menubar' for a description of the syntax of a menubar.
Assumes MENUBAR validity has already been checked and that MENUBAR has been
copied so that it is not shared with any other buffer. In other words, use
the function cautiously for optimal performance. Use `set-buffer-menubar'
instead, when these assumptions do not hold."
(make-local-variable 'current-menubar)
(setq current-menubar menubar)
(set-menubar-dirty-flag))
(defun id-set-frame-font (frame)
"Set FRAME's default and modeline fonts to 'id-default-font'.
For use with `create-frame-hook'."
(if (and (framep frame)
(or (stringp id-default-font)
(font-specifier-p id-default-font)))
(id-set-default-font id-default-font frame)))
(defun id-set-mode-menubar ()
"Set mode-specific menubar for current buffer iff infodock-menubar-type = 'menubar-modes.
Used in major mode hooks to properly set the menubar for new buffers."
(if (eq infodock-menubar-type 'menubar-modes)
(let ((mode-menubar-sym (id-menubar-get-symbol)))
(if (and id-buffer-menubar-symbol
(eq id-buffer-menubar-symbol mode-menubar-sym))
(id-set-buffer-menubar
(id-add-dynamic-menubar-items
(id-get-mode-menubar id-buffer-menubar-symbol)))
(if mode-menubar-sym
(setq id-buffer-menubar-symbol mode-menubar-sym)
(setq id-buffer-menubar-symbol
(intern (format "id-generic-%s-menubar" major-mode)))
(set id-buffer-menubar-symbol
(id-menubar-edit mode-name "(infodock)Text")))
(set-buffer-menubar
(id-add-dynamic-menubar-items
(id-get-mode-menubar id-buffer-menubar-symbol)))))))
(defun id-menubar-get-symbol ()
"Return the first found menubar symbol for this buffer's minor modes or major mode.
Allow first matching minor-mode popup menu to take precedence over the major
mode's popup menu. Nil is returned if no matching symbol is found."
(car (delq
nil
(mapcar
'id-menubar-get
;; Allow first matching minor-mode popup menu to take precedence over
;; the major mode's menubar. This returns an ordered list of minor
;; modes followed by the major mode.
(nconc
(delq
nil
(mapcar
(function (lambda (sexp)
(and sexp (symbolp sexp)
(boundp sexp) (symbol-value sexp)
sexp)))
(mapcar 'car minor-mode-alist)))
(list major-mode))))))
(defun id-set-tool-mode-frame (mode frame-name-symbol)
"Setup to have buffers with major MODE displayed in a dedicated frame named FRAME-NAME-SYMBOL if `id-tool-new-frame-flag' is t."
;; Under InfoDock 3.7 or less, ttys support only one frame; in such
;; cases, don't set a special frame-name when on a tty or
;; get-frame-for-buffer will signal an error.
(if (and id-tool-new-frame-flag
(or (not (eq (device-type) 'tty))
(string-lessp "InfoDock 3.7" infodock-version)))
(progn (put mode 'frame-name frame-name-symbol)
(pushnew (cons mode frame-name-symbol) id-tool-mode-frame-alist))
(put mode 'frame-name nil)
(setq id-tool-mode-frame-alist (remassq mode id-tool-mode-frame-alist))))
(defun id-toggle-dedicate-window ()
"If selected window is not dedicated to a buffer, dedicate it to current buffer.
Otherwise, undedicate it."
(interactive)
(if (window-dedicated-p nil)
(progn (set-window-dedicated-p (selected-window) nil)
(message "Window no longer dedicated"))
(set-window-dedicated-p (selected-window) t)
(message "Window dedicated to \"%s\" buffer" (buffer-name))))
(defun id-toggle-mail-subjects ()
"Toggle the minibuffer display of subject lines from new incoming mail messages."
(interactive)
(if (and (featurep 'reportmail) display-time-announce-mail)
(setq display-time-announce-mail nil)
(require 'reportmail)
(setq display-time-announce-mail t))
(display-time))
(defvar id-minor-mode-variables
'(
(auto-fill-mode . auto-fill-function)
(outline-minor-mode . selective-display)
)
"Alist of (minor-mode-function . minor-mode-state-variable) pairs.
If no match for function or 2nd element of pair is nil, function symbol is
the same as variable for that minor mode.")
(defun id-toggle-auto-scroll ()
"Toggle horizontal auto-scrolling on or off in all buffers based on the current buffer setting.
The flag `auto-show-mode' determines whether this feature is on or off in
the current buffer. The variable `auto-show-shift-amount' sets the number of
characters left or right that the buffer is scrolled when point moves past
the first or last character of a truncated line."
(interactive)
(save-excursion
;; Force loading of auto-show code.
(if (not (boundp 'auto-show-mode)) (auto-show-mode 0))
(let ((scroll-mode (not auto-show-mode)))
(setq-default auto-show-mode scroll-mode)
(mapcar (function (lambda (buffer)
(set-buffer buffer)
(setq auto-show-mode scroll-mode)))
(buffer-list))
scroll-mode)))
(defun id-toggle-auto-syntax-highlight ()
"Toggle automatic fontifying of buffers as they are loaded."
(interactive)
(if (not (featurep 'font-lock))
(progn
(setq font-lock-auto-fontify t)
(require 'font-lock))
(setq font-lock-auto-fontify (not font-lock-auto-fontify)))
(if font-lock-auto-fontify
(message "Syntax highlighting is on by default for all supported modes.")
(message "Syntax highlighting is on only for modes that request it.")))
(defun id-toggle-dedicated-tool-frames ()
"Toggle between a new frame per tool or reuse of the current frame for tools."
(interactive)
(if id-tool-new-frame-flag
(id-tool-this-frame)
(id-tool-new-frame))
(customize-set-variable 'id-tool-new-frame-flag id-tool-new-frame-flag))
(defun id-toggle-frame-backgrounds (texture-flag)
"Toggle between light and dark backgrounds for InfoDock frames.
With prefix argument, TEXTURE-FLAG non-nil, toggle use of textured
backgrounds instead of background color."
(interactive "P")
(if texture-flag
(customize-set-variable 'id-background-pixmap-flag
(not id-background-pixmap-flag))
(customize-set-variable 'id-dark-background-flag
(not id-dark-background-flag)))
(id-set-faces))
(defun id-toggle-hyperbole-button-file (&optional event)
"Toggle between showing and hiding the directory local or personal HYPB file of Hyperbole buttons.
Takes optional EVENT as an argument so may be used as a value of
`toolbar-blank-release-function.'"
(interactive)
(require 'hsite)
(let ((local-button-file (expand-file-name hbmap:filename default-directory))
(user-button-file (expand-file-name hbmap:filename hbmap:dir-user))
button-file)
(if (file-readable-p local-button-file)
;; Directory-local button file exists.
(setq button-file local-button-file)
;; Use user's button file instead.
(setq button-file user-button-file))
(if (or (equal button-file buffer-file-name)
(equal user-button-file buffer-file-name))
(bury-buffer)
(find-file button-file))))
(defun id-toggle-minor-mode (minor-mode)
"Toggle MINOR-MODE on or off in all buffers with current major-mode.
Toggle is based on whether or not MINOR-MODE is on in current buffer."
(let ((hook (intern (concat (symbol-name major-mode) "-hook")))
(mode major-mode)
(toggle-to)
(toggle-from)
(off -1)
(on 1))
(if (or
;; minor mode is on in this buffer
(symbol-value
(or (cdr (assq minor-mode id-minor-mode-variables))
(and (boundp minor-mode) minor-mode)))
;; current major-mode hook turns on minor-mode
(and (boundp hook) (listp (symbol-value hook))
(memq minor-mode (symbol-value hook))))
;; set up to turn minor mode off
(setq toggle-to off
toggle-from on)
;; set up to turn minor mode on
(setq toggle-to on
toggle-from off))
(if id-minor-mode-flag
;; Toggle in this buffer only.
(funcall minor-mode toggle-to)
;; Toggle in all existing and future buffers with current major mode.
(remove-hook hook minor-mode)
(remove-hook hook `(lambda () (,minor-mode ,toggle-from)))
(add-hook hook `(lambda () (,minor-mode ,toggle-to)))
(save-excursion
(mapcar
(function (lambda (buf)
(set-buffer buf)
(if (eq major-mode mode)
(funcall minor-mode toggle-to))))
(buffer-list))))))
(defun id-toggle-minor-mode-flag (&optional arg)
"Toggle between minor mode settings for current buffer or all buffers with current major mode.
With prefix ARG, affect current buffer only if ARG is positive and common
buffers otherwise."
(interactive "P")
(setq id-minor-mode-flag
(if arg (> (prefix-numeric-value arg) 0)
(not id-minor-mode-flag)))
(if id-minor-mode-flag
(message "Mode/Minor menu items will affect only the current buffer.")
(message "Mode/Minor menu items will affect all buffers with the current major mode.")))
(defun id-toggle-rectangle-region ()
"Toggle between rectangle and regional mouse selections."
(interactive)
(setq mouse-track-rectangle-p (not mouse-track-rectangle-p))
(message "Rectangle selection is now %s."
(if mouse-track-rectangle-p "on" "off")))
(defun id-toggle-tool-command-names (&optional arg)
"Toggle between showing and hiding InfoDock Tool menu command names.
With prefix ARG, if positive, show command names, otherwise hide them."
(interactive "P")
(setq id-tool-names-flag
(if arg (> (prefix-numeric-value arg) 0)
(not id-tool-names-flag)))
(id-tool-menu-set-command-names)
(message "Commands run by the InfoDock Tool menu are%s shown."
(if id-tool-names-flag "" " not")))
(defun id-toggle-vi ()
"Toggle Vi emulation in all existing and future buffers of this session."
(interactive)
(if (and (featurep 'viper) viper-mode)
(progn
(viper-go-away)
(when (interactive-p)
(message "Vi keys are disabled; normal InfoDock keys are enabled.")))
(setq viper-mode t)
(viper-mode)
(when (interactive-p)
(message "Vi keys are enabled in all buffers."))))
(defvar id-tool-visible-flag t
"Value indicates whether to make InfoDock tools visible, invisible or to toggle their visibility (default).
Valid values are: 'visible, 'invisible or t, which toggles the display state
of tools. Nil value is valid but has no effect.")
(defun id-tool (sexp &optional frame-name-sym mjr-mode max-instances)
"Launch, continue or hide a tool by calling (id-tool-invoke SEXP).
FRAME-NAME-SYM indicates frame name to use for MJR-MODE of tool.
Optional 4th arg MAX-INSTANCES is the maximum number of instances allowed for
this tool. It defaults to 1. (The MAX-INSTANCES feature does not work; only
one instance of each tool is presently supported.)
The free variable `id-tool-visible-flag' displays, hides or toggles the
display state of the tool's frame depending on its value, if non-nil."
(require 'site-xemacs)
(id-set-tool-mode-frame mjr-mode frame-name-sym)
(let ((frame (get-frame-for-mode mjr-mode)))
(if (and (or (and id-tool-visible-flag
(not (eq id-tool-visible-flag 'visible))
(frame-visible-p frame))
(eq id-tool-visible-flag 'invisible))
;; Only make frame invisible if it is named for this tool.
(equal (frame-name frame) (symbol-name frame-name-sym)))
(make-frame-invisible frame)
(select-frame frame)
(make-frame-visible frame)
;; Force full display of frame before tool command is executed since
;; it might take a long time.
(sit-for 0.1)
;;
(id-tool-invoke sexp))))
(defun id-tool-invoke (sexp)
"Invoke an InfoDock or external tool using SEXP.
1. If SEXP is a function symbol, a lambda function or a built-in
function, the function is called (interactively if possible).
2. If SEXP is a string, it is executed as a shell command to run an
external program.
3. Otherwise, SEXP is simply evaluated."
(cond ((functionp sexp)
(if (commandp sexp)
(call-interactively sexp)
(funcall sexp)))
((stringp sexp)
(hact 'exec-window-cmd sexp))
(t (eval sexp))))
(defun id-tool-quit (sexp)
"Quit from an InfoDock tool, deleting its dedicated frame, if any."
(let* ((name-sym (get major-mode 'frame-name))
(frame (selected-frame))
(dedicated-frame
(and name-sym (equal (symbol-name name-sym) (frame-name)))))
(id-tool-invoke sexp)
(and dedicated-frame (eq frame (selected-frame))
(not (stringp sexp)) (delete-frame))))
(defun id-tool-new-frame ()
"Make each InfoDock tool launch within its own frame."
(setq id-tool-new-frame-flag t)
(if (not (memq (device-type) '(stream tty)))
(message "Each tool will be launched within its own frame.")))
(defun id-tool-this-frame ()
"Make each InfoDock tool launch within the selected frame."
(setq id-tool-new-frame-flag nil)
(id-undedicate-tool-frames)
(if (not (memq (device-type) '(stream tty)))
(message "Each tool will be launched within the selected frame.")))
(defun id-tool-menu-set-command-names ()
"Update the command names shown next to InfoDock Tool menu entries."
(interactive)
(if (id-not-infodock-menubar current-menubar)
nil
(add-submenu nil (infodock-tool-menu))))
(defun id-unbury-buffer ()
"Unbury the bottom buffer and display it. The inverse of bury-buffer."
(interactive)
(require 'cl)
(switch-to-buffer (car (last (buffer-list)))))
(defun id-undedicate-tool-frames ()
"Disable dedicated InfoDock tool frames."
(and (not id-tool-new-frame-flag)
(mapcar (function (lambda (mode-and-frame-name)
(put (car mode-and-frame-name)
'frame-name nil)))
id-tool-mode-frame-alist)
(setq id-tool-mode-frame-alist nil)))
(defun id-view-doc-library (file)
(id-view-file file)
(require 'hsite)
;; Highlight all doc-ids as hyper-buttons.
(if (fboundp 'hproperty:but-create-all)
(hproperty:but-create-all "[" "]" "-[0-9][0-9][0-9]\]$"))
(message "Middle click on a [document-id] to display that document."))
(defun id-view-file (file)
"Display a FILE in read-only mode."
(if id-tool-new-frame-flag
(progn (find-file-new-frame file)
(setq buffer-read-only t))
(view-file file)))
(defun id-web-options-menu-filter (menu-items)
(require 'hui-menu)
(if (not (fboundp 'infodock-hyperbole-menu))
(load "hui-menu"))
(append menu-items hui-menu-url-options))
;;; ************************************************************************
;;; The Go Menu - extended from original XEmacs Buffers menu in menubar.el
;;; ************************************************************************
(defvar buffers-menu-max-size 15
"*Maximum number of entries which may appear on the \"Go\" menu. (Default = 15).
If the value is 0 or nil, all buffers will be listed, but this may
also slow down menu responsiveness.")
(defvar complex-buffers-menu-p nil
"*If non-nil, the \"Go\" menu will include command submenus with each buffer entry.
If this is nil, each entry will simply switch to the named buffer.")
(defvar sort-buffers-menu-p nil
"*If non-nil, \"Go\" menu buffers are alphabetized.
The default is nil, which means list buffers in most recently used order.")
(defvar buffers-menu-switch-to-buffer-function 'switch-to-buffer
"*The function to call to select a buffer from the \"Go\" menu.
`Switch-to-buffer' is the default; `pop-to-buffer' is another possible
choice.")
(defun id-format-buffer-line (buffer)
"Returns a string to represent the given buffer in the Buffer menu.
Nil means the buffer shouldn't be listed. Returns nil for buffers which
begin with space and star. You can redefine this."
(setq buffer (buffer-name buffer))
(if (and (string-match "\\`[ *]" buffer)
(not (string-match
"\\`\\*\\(scratch\\|shell\\|compilation\\|Compile\\|perldb\\)\\|-\\(telnet\\|rsh\\)\\*\\'" buffer)))
nil
buffer))
(defun id-save-buffer (buffer)
(save-excursion
(set-buffer buffer)
(save-buffer)))
(defun id-write-file (buffer)
(save-excursion
(set-buffer buffer)
(write-file (read-file-name
(format "Write %s to file: "
(buffer-name (current-buffer)))))))
(defsubst id-build-buffer-submenu (buf-name)
(delq nil
(list buf-name
(vector "Delete (Close)" (list 'kill-buffer buf-name) t)
(vector "Edit"
(list buffers-menu-switch-to-buffer-function
buf-name)
t)
(if (eq buffers-menu-switch-to-buffer-function
'switch-to-buffer)
(vector "Edit-Other-Frame"
(list 'switch-to-buffer-other-frame
buf-name)
t)
nil)
(vector "Pretty-Print" 'ps-print-region-or-buffer t)
(vector "Print" (list 'id-print-buffer buf-name) t)
(let ((buf (get-buffer buf-name)))
(if (and buf
(buffer-modified-p buf)
(buffer-file-name buf))
(vector "Save" (list 'id-save-buffer buf-name) t)))
(vector "Save-as (Write)"
(list 'id-write-file buf-name) t))))
(defsubst id-build-buffer-list-internal (buffer-names)
(mapcar
(if complex-buffers-menu-p
'id-build-buffer-submenu
(function
(lambda (buf-name)
(vector buf-name
(list buffers-menu-switch-to-buffer-function buf-name)
t))))
buffer-names))
(defun id-buffers-menu-filter (buffer-menu)
"Set the Buffer Selection menu to reflect the current set of buffers.
Group buffers into submenus by major mode when `infodock-categorize-buffers'
is non-nil, otherwise, order from most recently used to least recently used."
(append
'(["Manual" (id-info "(infodock)Go Menu") t]
"----"
["To-Gdb-or-Source" gdbsrc-goto-gdb
:included (or (eq id-default-debugger 'idgdbsrc)
(boundp 'gdbsrc-associated-buffer))
:active t]
"----"
["To-Frame" id-popup-jump-to-frame (> (length (frame-list)) 1)]
("To-Function" :filter id-function-menu-filter)
["To-Line" goto-line t]
["To-Window" id-popup-jump-to-window (> (length (window-list)) 1)]
("Within-Buffer"
["Backward-Expression" backward-sexp t]
["Forward-Expression" forward-sexp t]
["To-Matching-Delimiter" id-to-matching-delimiter t]
"----"
["To-Function-Beginning"
(if (memq major-mode '(java-mode jde-mode))
(call-interactively 'id-java-beginning-of-defun)
(call-interactively 'beginning-of-defun))
:active t
:keys "C-M-a"
]
["To-Function-End"
(if (memq major-mode '(java-mode jde-mode))
(call-interactively 'id-java-end-of-defun)
(call-interactively 'end-of-defun))
:active t
:keys "C-M-e"
]
"----"
["Scroll-Backward" scroll-down t]
["Scroll-Forward" scroll-up t]
["Scroll-Left" scroll-left t]
["Scroll-Right" scroll-right t]
["To-Buffer-Beginning" beginning-of-buffer t]
["To-Buffer-End" end-of-buffer t])
"----"
"----"
"To-Buffer:"
"--:shadowEtchedInDash")
(if infodock-categorize-buffers
(append (cdr (id-menu-of-buffers)) buffer-menu)
(id-buffers-menu buffer-menu))))
(defun id-buffers-menu (buffer-menu)
"Set the Buffer Selection menu to reflect the current set of buffers.
Only a subset of the most-recently-used 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 `id-format-buffer-line'."
(let (built-menu
buffer-names)
(setq buffer-names
(delq nil (mapcar 'id-format-buffer-line (buffer-list))))
(if (and (integerp buffers-menu-max-size)
(> buffers-menu-max-size 0))
(if (> (length buffer-names) buffers-menu-max-size)
(setcdr (nthcdr (1- buffers-menu-max-size) buffer-names) nil)))
(if sort-buffers-menu-p
(setq buffer-names (sort buffer-names 'string-lessp)))
(setq built-menu (delq nil (id-build-buffer-list-internal buffer-names)))
(append built-menu buffer-menu)))
;;; ************************************************************************
;;; The Web Menu - Access to Netscape Bookmarked URLs
;;; ************************************************************************
(defvar id-ns-preferences-file
(concat "~" init-file-user "/.netscape/preferences")
"*Full path to the user's Netscape preferences file.")
(defvar id-ns-bookmarks-max-width 60
"Maximum number of characters to show in a Netscape bookmark menu name.")
(defvar id-ns-bookmarks-file nil
"Personal file name of Netscape bookmarks.
When nil, it is initialized by default when the bookmarks are read by
`id-ns-bookmarks-menu-filter'.")
(defvar id-ns-bookmarks-menu-max-size 23
"Maximum number of Netscape bookmark entries to show on the menu.
0 or nil means no limit.")
(defvar id-ns-bookmarks-sort-flag nil
"*If non-nil, the Netscape bookmarks menu is alphabetized.
The default is nil.")
(defun id-ns-bookmarks-fgrep (pattern &optional regexp-flag)
"Search for PATTERN within a user's Netscape bookmarks file and display formatted matches.
With optional prefix arg REGEXP-FLAG, do a regexp search instead of the
default string search."
(interactive
(list (read-string
(if current-prefix-arg
"Find regexp in Netscape Bookmarks: "
"Find string in Netscape Bookmarks: "))
current-prefix-arg))
(require 'wrolo)
(let* ((rolo-entry-regexp "^[ \t]+\<")
(bookmarks-file "~/.netscape/bookmarks.html")
(rolo-display-buffer "*NS-Bookmarks*")
(existing-bookmarks-buffer (get-file-buffer bookmarks-file))
(total-matches
(funcall (if regexp-flag 'rolo-grep 'rolo-fgrep)
pattern nil bookmarks-file)))
(if (not existing-bookmarks-buffer)
(kill-buffer (get-file-buffer bookmarks-file)))
(save-excursion
(set-buffer rolo-display-buffer)
(let (buffer-read-only)
(goto-char (point-min))
;; Replacements are done this way in segments because if we match to
;; strings that are to be displayed, when replace-match copies them
;; it drops the highlighting of the specific text matched.
(while (re-search-forward "^[ \t]+<DT><A HREF=\"" nil t)
(replace-match "" t)
(if (re-search-forward "\"[^\>]+>" nil t)
(replace-match "\n " t))
(if (search-forward "</A>" nil t) (replace-match "\n" t)))
(set-buffer-modified-p nil)))
(if (interactive-p)
(message "%s matching bookmark%s found."
(if (= total-matches 0) "No" total-matches)
(if (= total-matches 1) "" "s")))
total-matches))
(defun id-ns-bookmarks-grep (regexp)
"Search for REGEXP within a user's Netscape bookmarks file and display formatted matches."
(interactive "sFind regexp in Netscape Bookmarks: ")
(id-ns-bookmarks-fgrep regexp t))
(defun id-ns-bookmarks-menu-filter (menu)
"Return an unnamed menu of Netscape bookmarks."
(cond ((and (not id-ns-bookmarks-menu)
(stringp id-ns-bookmarks-file)
(not (file-readable-p id-ns-bookmarks-file)))
nil)
(id-ns-bookmarks-menu
(append menu id-ns-bookmarks-menu id-ns-bookmarks-menu-items))
(t
(save-excursion
(if id-ns-bookmarks-file
nil
(let* ((prefs id-ns-preferences-file)
(kill-p (not (get-file-buffer prefs))))
(unwind-protect
(if (and (file-readable-p prefs)
(progn
(set-buffer (find-file-noselect prefs))
(goto-char (point-min))
(search-forward
"\nBOOKMARKS_FILE:[ \t]+\\(.*\\S-\\)" nil t)))
(progn (setq id-ns-bookmarks-file (match-string 1))
(if (string-match "\\`~/" id-ns-bookmarks-file)
(setq id-ns-bookmarks-file
(concat "~" init-file-user "/"
(substring
id-ns-bookmarks-file 2)))))
(setq id-ns-bookmarks-file
(concat "~" init-file-user
"/.netscape/bookmarks.html")))
(if kill-p (kill-buffer (current-buffer))))))
(if (not (file-readable-p id-ns-bookmarks-file))
nil
(message "Reading Netscape bookmarks to build Web menu ...")
(with-temp-buffer
(unwind-protect
(progn
(insert-file-contents id-ns-bookmarks-file)
(goto-char (point-min))
(setq menu
(append
menu
(condition-case ()
(progn
(setq id-ns-bookmarks-menu
(id-ns-bookmarks-build-menu nil))
(if (and (integerp id-ns-bookmarks-menu-max-size)
(> id-ns-bookmarks-menu-max-size 0)
(> (length id-ns-bookmarks-menu)
id-ns-bookmarks-menu-max-size))
(setcdr
(nthcdr (1- id-ns-bookmarks-menu-max-size)
id-ns-bookmarks-menu) nil))
;; Limits the length of a submenu of Netscape
;; bookmarks.
(if (and (integerp id-ns-bookmarks-menu-max-size)
(> id-ns-bookmarks-menu-max-size 0)
(> (length id-ns-bookmarks-menu)
id-ns-bookmarks-menu-max-size))
(setcdr (nthcdr (1- id-ns-bookmarks-menu-max-size)
id-ns-bookmarks-menu) nil))
(if id-ns-bookmarks-sort-flag
(setq id-ns-bookmarks-menu
(id-ns-bookmarks-sort-items
id-ns-bookmarks-menu))
id-ns-bookmarks-menu))
;; If an error is encountered, reset so that bookmark
;; file read may be tried again later by the user.
(error
(setq id-ns-bookmarks-file nil)
(error "(id-ns-bookmarks-menu-filter): Error reading bookmarks file")))
id-ns-bookmarks-menu-items)))))
(message "Reading Netscape bookmarks to build Web menu ...Done")
menu)))))
(defun id-ns-bookmarks-build-menu (menu)
(let ((items))
(catch 'done
(while (re-search-forward "<\\(H3\\|A\\) " nil t)
(if (equal (match-string 1) "A")
(if (looking-at
"[ \t]*HREF=\"\\([^\"]+\\)\"[^>]*>\\([^<]+\\)</A>")
(setq items (cons
(vector (id-ns-bookmarks-truncate
(match-string 2))
`(hact 'www-url ,(match-string 1)) t)
items)))
(if (re-search-forward ">\\([^<]+\\)" nil t)
(progn
(setq menu (append
(if items
(if menu
(list (append menu items))
items)
menu)
(id-ns-bookmarks-build-menu
(list (id-ns-bookmarks-truncate
(match-string 1)))))
items nil)))
(throw 'done nil))))
(if items
(setq menu
(if menu
(list (append menu items))
items))))
menu)
(defun id-ns-bookmarks-sort-items (items)
(sort items
(function
(lambda (item1 item2)
(string-lessp
(cond
((and (listp item1) (stringp (car item1)))
;; submenu
(setq item1 (cons (car item1)
(id-ns-bookmarks-sort-items (cdr item1))))
(car item1))
((stringp item1)
;; literal
item1)
((vectorp item1)
;; bookmark
(aref item1 0))
(t (error "(id-ns-bookmarks-sort-items): Invalid item, %s" item1)))
(cond
((and (listp item2) (stringp (car item2)))
;; submenu
(setq item2 (cons (car item2)
(id-ns-bookmarks-sort-items (cdr item2))))
(car item2))
((stringp item2)
;; literal
item2)
((vectorp item2)
;; bookmark
(aref item2 0))
(t (error "(id-ns-bookmarks-sort-items): Invalid item, %s" item2))))))))
(defun id-ns-bookmarks-truncate (name)
(if (> (length name) id-ns-bookmarks-max-width)
(substring name 0 (1- id-ns-bookmarks-max-width))
name))
(defvar id-ns-bookmarks-menu nil
"Cached value of the InfoDock Netscape bookmarks menu.")
;;; ************************************************************************
;;; Initialize Menubar
;;; ************************************************************************
;;; Add Load Init button to menubar when starting up with -q
(defun maybe-add-init-button ()
(if init-file-user
nil
(add-menu-button nil
["Load .infodock"
(progn (delete-menu-item '("Load .infodock"))
(load-user-init-file (user-login-name)))
t])))
;;; This must precede the definition of infodock-software-menu.
(if (or noninteractive (not (boundp 'emacs-version))
(not (fboundp 'infodock-version-control-options-menu)))
(progn
(defun infodock-version-control-menu ()
'("%_Version-Control"
:config Version-Control
["Manual" (id-info "(infodock)Version Control") t]
"----"
["Initialize-Menu" (progn (require 'menus-vc)
(if sc-mode
(id-load-menus t)
(id-vc-mode id-default-vc-mode)))
t]))
(defalias 'infodock-version-control-options-menu
'infodock-version-control-menu)))
;; Moved down here to allow ensure earlier definitions needed
;; by the OO-Browser menus are already loaded.
(defun infodock-software-menu ()
(delq nil
(list
"%_Software"
:config 'Software
'["Manual" (id-info "(infodock)Software Development Support") t]
"----"
'("%_Compiler"
["Manual" (id-info "(xemacs)Compilation") t]
"----"
["Compile"
(let ((id-tool-visible-flag 'visible))
(id-tool-invoke id-tool-compiler)) t]
;; InfoDock sometimes uses a command other than next-error to
;; parse errors, so the key binding is used instead.
["To-Next-Error" (call-interactively (key-binding "\C-x`"))
:active t
:keys "C-x `"]
)
`("%_Debugger"
["Manual" (id-info "(infodock)Debugging") t]
"----"
["Invoke-Default" iddebug
:active (symbolp id-default-debugger)
:suffix (format "(%s)" id-default-debugger)]
"----"
["Invoke-DBX" (id-debug 'dbx) t]
["Invoke-GDB-or-WDB" (id-debug 'idgdbsrc) t]
["Invoke-Perl-Dbg" (id-debug 'perldb) t]
["Invoke-Perl5-Dbg" (id-debug 'perl5db) t]
["Invoke-SDB" (id-debug 'sdb) t]
["Invoke-XDB" (id-debug 'xdb) t]
,@ id-debug-commands-menu)
(when (fboundp 'oo-browser)
(require 'hversion)
(require 'br-menu)
br-menu-external)
(and (boundp 'ppg-sw-process-directory)
(stringp ppg-sw-process-directory)
'("%_SW-Process"
["Manual" (id-info "(infodock)Software Process") t]
"----"
["Document-List"
(progn (require 'sw-process)
(id-view-doc-library ppg-sw-process-summary))
t]
["Card-Catalog"
(progn (require 'sw-process)
(id-view-doc-library ppg-sw-process-index))
t]
("View-Format"
["ASCII-Text" (ppg-sw-process-viewer "text") t]
["FrameMaker" (ppg-sw-process-viewer "frame") t]
["Interleaf (slow)" (ppg-sw-process-viewer "ileaf") t]
["Postscript" (ppg-sw-process-viewer "postscript") t]
)))
'("%_Tags"
["Manual" (id-info "(xemacs)Tags") t]
"----"
["Build-Tags-Table" (shell-command
(read-string
"Files for Tags Table: "
"etags ")) t]
["Set-Tags-Table" visit-tags-table t]
"----"
["To-Ident-Def-at-Point" action-key t]
["To-Named-Def" find-tag t]
["To-Named-Def-Other-Window" find-tag-other-window t]
"----"
["Back-from-Ident-Def" pop-tag-mark t]
["Forward-from-Ident-Def" (pop-tag-mark t)
:active t
:keys "C-u M-*"]
"----"
["Tags-Matching-Regexp" tags-apropos t]
["Tags-Defined-in-File" tags-list t]
["Tags-File-Find-Regexp" tags-search t]
["Tags-File-Find-Next" tags-loop-continue t]
["Tags-File-Query-Replace" tags-query-replace t]
)
'["To-Line" goto-line t]
(infodock-version-control-menu)
infodock-xemacs-lisp-menu
)))
;;; ************************************************************************
;;; InfoDock Menubar Setup
;;; ************************************************************************
(defun infodock-menubar ()
"Creates and returns default menubar for InfoDock System."
(append
(delq
nil
(list
infodock-menu
(infodock-buffer-menu)
infodock-display-menu
infodock-edit-menu
infodock-file-menu
infodock-go-menu
(if id-hyperbole-p (infodock-hyperbole-menu))
infodock-key-menu
(infodock-options-menu)
(infodock-software-menu)
(infodock-tool-menu)
(if id-hyperbole-p infodock-web-menu)))
'(nil
["Mode-%_Menubars" menubar-modes t])))
(defconst infodock-menubar (infodock-menubar)
"Default menubar of global commands for InfoDock.")
(defconst infodock-popup-menubar
(cons "InfoDock Menubar" (delq nil (copy-sequence infodock-menubar)))
"Popup a menu containing the entire default InfoDock menubar.")
(defconst default-menubar infodock-menubar
"Default menubar from which new frame menubars are made.")
(add-hook 'before-init-hook 'maybe-add-init-button)
(if (fboundp 'set-menubar-dirty-flag)
nil
(defun set-menubar-dirty-flag ()
"This is a no-op under this version of InfoDock."
nil))
;; Reset default menubar.
(defun infodock-initialize-menubar ()
"Initialize InfoDock menubar by calling the value of `infodock-menubar-type'."
(when (and (featurep 'menubar)
(fboundp infodock-menubar-type))
(funcall infodock-menubar-type)))
(or noninteractive (infodock-initialize-menubar))
(add-hook 'before-init-hook 'infodock-initialize-menubar)
;; This must come after infodock-software-menu.
;; Must guard when running -batch or -no-autoloads. -sb
(when (and (fboundp 'id-menubar-set) (null noninteractive))
(id-menubar-set 'outline-mode 'id-menubar-outline))
;;; ************************************************************************
;;; Private variables
;;; ************************************************************************
;;; id-menus.el ends here
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment