;; -*- mode: emacs-lisp; coding: hebrew-iso-8bit-unix; -*- ;; ek-pop-menu.el --- EK operations (Simon & Wiesel) global menu ;; Copyright (C) 1997-2000 Ehud karni ;; This file is NOT part of GNU Emacs, distribution conditions below. ;; ;; EHUD KARNI ינרק דוהא ;; Ben Gurion st' 14 ןוירוג ןב 'חר ;; Kfar - Sava 44 257 אבס - רפכ ;; =================================== ;; 972-(0)9-7659599 ;; =================================== ;; RCS: $Id: ek-pop-menu.el,v 1.101 2000/03/05 14:26:31 ehud Exp ehud $ ;; ;; LOG: $Log: ek-pop-menu.el,v $ ;; Revision 1.101 2000/03/05 14:26:31 ehud ;; Major re-write, break menu into sub menus, updated todo list. ;; ;; Revision 1.100 1998/11/11 14:28:08 ehud ;; Initial RCS (and last for 19.34) version ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ;; function to add to pop-up menu ;; eval-line ;; PC-lisp-complete-symbol ;; set-variable ;; name-last-kbd-macro ;; call-last-kbd-macro ;;tools ;; sum-total-text ;; col-move-fix-toggle ;; switch-buffer-loop ;; single-window-ek ;; split-window-ek (defvar EK-menu-save '(keymap "save, grep/compile, shell" (sbr menu-item "strip spaces N O W " strip-blanks-right :visible (not buffer-read-only)) (tab-all menu-item "tabify all N O W " tabify-all :visible (not buffer-read-only) :keys "Ctrl-S-F7" ) (utb-all menu-item "untabify all N O W " untabify-all :visible (not buffer-read-only) :keys "Ctrl-F7" ) (-0 menu-item "--" nil :visible (not buffer-read-only)) (sv-uns menu-item "leave spaces on save" save-unstrip :enable (not (included 'unstrip save-options))) (sv-strp menu-item "strip spaces on save" save-strip :enable (included 'unstrip save-options)) ;; (setq save-options (excluded 'unstrip save-options)) (sv-tbfy menu-item "tabify all on save" save-tabify :enable (not (included 'tabify save-options))) ;; (setq save-options (append '(tabify) (excluded 'untabify save-options))) (sv-utab menu-item "untabify all on save" save-untabify :enable (not (included 'untabify save-options))) ;; (setq save-options (append '(untabify) (excluded 'tabify save-options))) (-1 "--") (sv-bffr menu-item "Save current buffer " save-buffer ) (sv-ext menu-item "Save buffer (& kill)" save-and-exit :keys "S-F6" ) (ki-ext menu-item "kill this buffer" kill-and-exit :keys "F6" ) (wrt-fl menu-item "Write current buffer" write-file ) (rvrt-bf menu-item "Auto revert buffer " revert-buffer-nq :keys "Alt-G" :enable (buffer-file-name)) (-2 "--") (grep menu-item "run grep " grep :keys "Alt-S-F10" ) (nxt-err menu-item "goto next hit/error " next-error :keys "Alt-F10" ) (cmpl-mn menu-item "Compile main program" compile-main :keys "Alt-F8" :enable (buffer-file-name)) (cmpl-sb menu-item "Compile subroutine " compile-sub :keys "Alt-S-F8" :enable (buffer-file-name)) (cmp-dbg menu-item "Toggle compile debug" compile-debug-toggle :keys "Alt-F5" :button (:toggle . compile-debug)) (cmp-edt menu-item "Edit compile exten's" compile-ext-edit :keys "Alt-S-F5" ) (-3 "--") (sh-cmd menu-item "Shell command (one) " shell-command :keys "Alt-S-1" ) (shell menu-item "Open SubShell buffer" shell :keys "Alt-S-3" ) (-4 "--") (tgl-rdo menu-item "Toggle read only" toggle-read-only :keys "Ctrl-kp-*" :button (:toggle . buffer-read-only)) ) "EK sub menu - save/grep/shell/modes") (defvar EK-menu-lang '(keymap "Languge/direction, mode" (heb-tgl menu-item "Hebrew kbd Toggle" hebrew-kbd-toggle :keys "Alt-F1" :button (:toggle . hebrew-on )) (r2l-tgl menu-item "Right 2 Left Toggle" right2left-toggle :keys "Alt-F2" :button (:toggle . right2left-on)) (auto-bd menu-item "Auto bidi Toggle" auto-bidi-toggle :keys "Alt-S-F3" :button (:toggle . auto-bidi-on)) (heb-r2l menu-item "Set Hebrew & R2L" hebrew-kbd-all :keys "Alt-S-F1" ) (lat-l2r menu-item "Set Latine & L2R" latine-kbd-all :keys "Alt-S-F2" ) (-1 "--") (ins-mod menu-item "Insert mode start" ins-mode :keys "Insert" :button (:radio . (not overwrite-mode))) (push-md menu-item "Push mode start" push-mode-set :keys "Alt-F3" :button (:radio . push-mode-on )) (ins-end menu-item "Ins/Push mode end" ins-mode-end :keys "Insert" :button (:radio . overwrite-mode)) (-2 "--") (fundm menu-item "Fundamental mode" fundamental-mode :button (:radio . (eq major-mode 'fundamental-mode )) ) (emacs menu-item "emacs lisp mode " emacs-lisp-mode :button (:radio . (eq major-mode 'emacs-lisp-mode )) ) (sh-mod menu-item "script (sh) mode" sh-mode :button (:radio . (eq major-mode 'sh-mode )) ) (awk-md menu-item "Awk edit mode " awk-mode :button (:radio . (eq major-mode 'awk-mode )) ) (text menu-item "text mode" text-mode :button (:radio . (eq major-mode 'text-mode )) ) ) "EK sub menu - Languge/direction, modes") (defvar EK-menu-mark-1 '(keymap "EK Marks un/marking " (unmark menu-item "unmarking (any kind)" unmark :keys "S-F1" :enable (mark-exist-chk)) (-1 "--") (mark-ln menu-item "mark lines " mark-line :keys "F1" ) (mark-ch menu-item "mark character" mark-char :keys "F2" ) (mark-bl menu-item "mark block " mark-block :keys "S-F2" ) (-2 "--") (mark-wd menu-item "mark next word" mark-word-ek ) (wd-only menu-item "mark word (no punc)" mark-word-only-ek ) (mark-pg menu-item "mark current page" mark-page-ek ) (mark-bf menu-item "mark whole buffer" mark-whole-buffer-ek) (-3 menu-item "--" nil :visible (eq major-mode 'emacs-lisp-mode)) (mrk-dfn menu-item "mark elisp defun" mark-defun-ek :visible (eq major-mode 'emacs-lisp-mode)) ) "EK marks sub 1 - Un/Marking") (defvar EK-menu-mark-2 '(keymap "EK Marks push/pop" (push-mk menu-item "Push current marks" push-mark-ek :enable (mark-exist-chk)) (pop-mrk menu-item "Pop stacked marks " pop-mark-ek ) (pushedv menu-item "view pushed marks " pushed-mark-view ) (-1 "--") (m2p menu-item "copy mark to clipbrd" marked-to-primary :keys "Ctrl-Ins" :enable (mark-exist-chk)) (m2r menu-item "copy mark to register" marked-to-register :keys "Alt-R m" :enable (mark-exist-chk)) (am2r menu-item "add mark to register" add-marked-to-register :keys "Alt-R M" :enable (mark-exist-chk)) (-2 "--") (mrk-bgn menu-item "go to mark beginning" mark-begin :keys "Ctrl-kp--" :enable (mark-exist-chk)) (mrk-end menu-item "go to end of marked " mark-end :keys "Ctrl-kp-+" :enable (mark-exist-chk)) ) "EK marks sub 2 - push/pop, goto") (defvar EK-menu-mark-3 '(keymap "EK Marks whole ops" (copy-mk menu-item " copy marked " copy-marked :keys "F3" ) (move-mk menu-item " move marked " move-marked :keys "S-F3" ) (overlay menu-item "overlay marked" overlay-marked :keys "Ctrl-S-F9" :enable (= type-mark-set 4)) (dlt-mrk menu-item "delete marked" delete-marked :keys "Ctrl-F9" ) (-1 "--") (fill-mk menu-item "fill with char" fill-marked :keys "Ctrl-F8" ) (shift-r menu-item "shift right marked" shift-marked :keys "Alt-S-+" :enable (/= type-mark-set 2)) (shift-l menu-item "shift left marked " shift-marked-left :keys "Alt-S--" :enable (/= type-mark-set 2)) (reflowm menu-item "reformat marked" reflow-marked :keys "C-x R" ) ) "EK marks sub 3 - whole ops") (defvar EK-menu-mark-4 '(keymap "EK Marks translate" (chng-mk menu-item "All translate options" change-marked ) (-1 "--") (eng-mrk menu-item "Hebrew to lower case " english-marked :keys "Ctrl-S-F5" ) (heb-mrk menu-item "lower case to Hebrew " hebrew-marked :keys "Ctrl-F5" ) (-2 "--") (uppr-mk menu-item "lower to upper case " upper-marked :keys "C-S-F6, C-x C-l" ) (lwr-mrk menu-item "upper to lower case " lower-marked :keys "C-F6, C-x C-u" ) (-3 "--") (pc2ux-m menu-item "Hebrew PC to UNIX" pc2unix-marked ) (ux2pc-m menu-item "Hebrew UNIX to PC" unix2pc-marked ) (-4 "--") (kbd-e2h menu-item "lower to Hebrew (kbd)" kbd-e2h-marked ) (kbd-h2e menu-item "Hebrew to lower (kbd)" kbd-h2e-marked ) ) "EK marks sub 4 - translate") (defvar EK-menu-mark-5 '(keymap "EK Marks strings ops" (rp-in-m menu-item "replace in marked area" replace-in-marked :keys "Ctrl-S-F8" ) (-1 "--") (just-r menu-item "Justify right marked " justify-right-marked :keys "Alt-J" :enable (= type-mark-set 4)) (just-l menu-item "Justify left marked " justify-left-marked :keys "C-u Alt-J" :enable (= type-mark-set 4)) (invrt-m menu-item "Invert (right<-->left)" invert-marked :keys "Alt-S-I" ) (winvrtm menu-item "PC Windows invert R--L" winvert-marked :keys "C-x W" ) (winvenc menu-item "PC Windows encode R--L" winvert-encode-marked :keys "C-x E" ) (-2 "--") (ispl-mk menu-item "Spell (English) marked" ispell-marked ) (-3 "--") (sort-mk menu-item "Sort marked area ONLY " sort-marked :keys "Alt-S" ) (srt-c-m menu-item "Sort lines (marked=key)" sort-by-columns-mark :keys "Alt-S-S" :enable (= type-mark-set 4)) (-4 "--") (meta-mk menu-item "decode marked as mail" metamail-marked :enable (/= type-mark-set 4)) (base-64 menu-item "decode marked base64" base64-decode-marked :enable (/= type-mark-set 4)) (quot-pr menu-item "decode marked quoted" quoted-decode-marked :enable (/= type-mark-set 4)) ) "EK marks sub 5 - strings ops") (defvar EK-menu-mark-6 '(keymap "EK Marks as input" (cmpt-mk menu-item "compute marked as an expression " compute-marked ) (sum-mrk menu-item "sum all the numbers in marked area" sum-marked :keys "Alt-S-T" ) (eval-mk menu-item "eval marked as an elisp expression" eval-marked :enable (/= type-mark-set 4)) (hilit-m menu-item "(Re) highlight all the marked area" highlight-marked :enable (/= type-mark-set 4)) (cmd-inp menu-item "Run shell command on marked area " run-command-on-marked :keys "C-x !" ) ) "EK marks sub 6 - As input ops") (defvar EK-ops-menu (list 'keymap "EK ops" (list 'sav 'menu-item "saves/grep/tabs/shell" EK-menu-save) (list 'lng 'menu-item "Languge/direction/mode" EK-menu-lang) '(-1 "--") '(-2 "--") (list 'sm1 'menu-item "EK Marks un/marking" EK-menu-mark-1) (list 'sm2 'menu-item "EK Marks push/pop" EK-menu-mark-2) '(-3 menu-item "--" nil :visible (mark-exist-chk)) (list 'sm3 'menu-item "Whole marked area ops" EK-menu-mark-3 ':visible '(mark-exist-chk)) (list 'sm4 'menu-item "Translate in marked" EK-menu-mark-4 ':visible '(mark-exist-chk)) (list 'sm5 'menu-item "Marked area lines ops" EK-menu-mark-5 ':visible '(mark-exist-chk)) (list 'sm6 'menu-item "marked area as input" EK-menu-mark-6 ':visible '(mark-exist-chk)) '(-4 "--") '(compute menu-item "compute expression" compute :keys "Alt-C" ) '(cmp-wnd menu-item "compare next window" compare-windows ) '(fix-col menu-item "Fixed column movment" col-move-fix-toggle :keys "Alt-X" :button (:toggle . (not position-col-var))) ) "EK marks menu") (define-key global-map [menu-bar EK_ops] (list 'menu-item "EK ops" EK-ops-menu)) ;; help (define-key global-map [menu-bar help-menu sepek] '("--")) (define-key global-map [menu-bar help-menu swhelp-entry] '(menu-item "SW help entry" swhelp-entry :keys "F10")) (define-key global-map [menu-bar help-menu ek-apropos] '(menu-item "Apropos for emacs" ek-apropos :keys "Alt-A")) (define-key global-map [menu-bar help-menu view-site-help] '(menu-item "view EK help file" view-site-help :keys "Alt-S-H")) (define-key global-map [menu-bar help-menu manuals man] '(menu-item "Read Man Page..." manual-entry :keys "S-F9")) (defvar EK-menu-goto '(keymap "EK goto commands" (goto-cl menu-item "go to column" goto-col :keys "Alt-S-F6" ) (fwd-nbl menu-item "forward to non blank" forward-to-non-blank :keys "Alt-=" ) (bwd-nbl menu-item "backward to non blank" backward-to-non-blank :keys "Alt--" ) (fwd-nwd menu-item "forward to next word" forward-word-ehud :keys "Ctrl-right" ) (bwd-nwd menu-item "backward to prv word" backward-word-ehud :keys "Ctrl-left" ) (fwd-jmp menu-item "fwd chars" char-jump-next :keys "S-right" ) (bwd-jmp menu-item "bwd chars" char-jump-previous :keys "S-left" ) (-1 "--") (goto-ln menu-item "go to line" goto-line :keys "Alt-F6" ) (goto-tp menu-item "goto 1st screen line" cursor-to-top :keys "Ctrl-PgUp" ) (goto-bt menu-item "goto last screen line" cursor-to-bottom :keys "Ctrl-PgDn" ) (top-jmp menu-item "Up lines" line-jump-previous :keys "S-Up" ) (btm-jmp menu-item "Down lns" char-jump-next :keys "S-Down" ) (-2 "--") (scrl-up menu-item "Scroll 1 screen up" page-down :keys "Pg Dn" ) (scrl-dn menu-item "Scroll 1 screen down" page-up :keys "Pg Up" ) (ln-top menu-item "line to TOP of screen" line-to-top :keys "S-Pg Dn" ) (ln-btm menu-item "line to screen BOTTOM" line-to-bottom :keys "S-Pg Up" ) ) "EK goto ops") (define-key global-map [menu-bar edit search sepek-1] '("--")) (define-key global-map [menu-bar edit search rplc-txt] '(menu-item "replace string " replace-txt :keys "F7" )) (define-key global-map [menu-bar edit search rplc-nxt] '(menu-item "replace next (down)" replace-next :keys "S-F7" )) (define-key global-map [menu-bar edit search rplc-prv] '(menu-item "replace previous (up)" replace-previous :keys "Ctrl-F4" )) (define-key global-map [menu-bar edit search sepek-2] '("--")) (define-key global-map [menu-bar edit search lct-txt] '(menu-item "locate string (text)" locate-text :keys "F5" )) (define-key global-map [menu-bar edit search lct-nxt] '(menu-item "locate next (down)" locate-next :keys "S-F5" )) (define-key global-map [menu-bar edit search lct-prv] '(menu-item "locate previous (up)" locate-previous :keys "Ctrl-F2" )) (define-key global-map [menu-bar edit search lct-all] '(menu-item "locate all occurences" locate-all :keys "Ctrl-S-F2" )) (define-key global-map [menu-bar edit goto sepek-3] '("--")) (define-key global-map [menu-bar edit goto ek-goto] (list 'menu-item "EK goto commands" EK-menu-goto)) (define-key global-map [menu-bar edit sepek-1] '("--")) (define-key global-map [menu-bar edit muld-no] '(menu-item "Multiply numbers" mult-numbers :keys "Alt-S-N" )) (define-key global-map [menu-bar edit wnv-aln] '(menu-item "Windoz invert all " winvert-all-lines )) (define-key global-map [menu-bar edit wnv-ln1] '(menu-item "Windoz invert line" winvert-line )) (define-key global-map [menu-bar edit inv-aln] '(menu-item "Invert all lines" invert-all-lines )) (define-key global-map [menu-bar edit inv-ln1] '(menu-item "Invert line (r<==>l" invert-line :keys "Alt-I" )) (define-key global-map [menu-bar edit join-ln] '(menu-item "Join with next line" join-lines :keys "S-F4" )) (define-key global-map [menu-bar edit sepek-2] '("--")) (define-key global-map [menu-bar edit kill-rs] '(menu-item "Kill rest (to EOF)" kill-to-eof :keys "S-F10" )) (define-key global-map [menu-bar edit kil-nbl] '(menu-item "Kill to non blank" kill-to-non-blank :keys "Alt-F9" )) (define-key global-map [menu-bar edit zap-toc] '(menu-item "Zap up to character" zap-to-char :keys "Esc z" )) (define-key global-map [menu-bar edit ins-prm] '(menu-item "Insert clipboard" insert-primary :keys "Alt-insert" )) (define-key global-map [menu-bar edit ins-8sp] '(menu-item "Insert 8 spaces" ins-8-space :keys "S-F8" )) (define-key global-map [menu-bar edit ins-dec] '(menu-item "Ins char by number" insert-char-dec :keys "Alt-Q" )) (defun global-pop-menu (event) "Pop up a menu of global operation (nothing ?)" (interactive "e") (save-window-excursion (let ((mpp (mouse-position)) ;;save mouse starting position (do-cmd (x-popup-menu t (lookup-key global-map [menu-bar]))) ary lng) (set-mouse-position (car mpp) (car (cdr mpp)) (cdr (cdr mpp))) (if do-cmd (progn (setq do-cmd (append '(menu-bar) do-cmd)) (setq lng (length do-cmd)) (setq ary (make-vector lng nil)) (while (> lng 0) (setq lng (1- lng)) (aset ary lng (nth lng do-cmd))) ;; (princ ary) ;; (princ (lookup-key global-map ary)) (call-interactively (lookup-key global-map ary)) ))))) (defun global-pop-menu-by-key (prefix) "Pop up a menu of global operation by key" (interactive "P" ;; (mouse-popup-menubar-stuff (mouse-position) prefix))) (mouse-popup-menubar-stuff '(down-mouse-3 (# 19436 (782 . 122) 135431525 nil 19436 (86 . 8) nil (782 . 2) (9 . 15))) prefix))) (fset 'PC-O-SF11 'global-pop-menu-by-key) (global-set-key [drag-mouse-2] 'global-pop-menu) (global-set-key [drag-mouse-3] 'mouse-popup-menubar) (global-set-key [menu] 'global-pop-menu-by-key) (defun tst1 () (interactive) (let (ev mp) (setq mp (mouse-position)) (setq ev (read-event "do something with the mouse")) (setq ev (cons mp ev)) (describe-variable 'ev))) (global-set-key [drag-mouse-3] 'tst1) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;