/
menu-bar.el
2618 lines (2277 loc) · 113 KB
/
menu-bar.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; menu-bar.el --- define a default menu bar
;; Copyright (C) 1993-1995, 2000-2017 Free Software Foundation, Inc.
;; Author: Richard M. Stallman
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal, mouse
;; Package: emacs
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; Avishai Yacobi suggested some menu rearrangements.
;;; Commentary:
;;; Code:
;; useful functions (stump)
(defun aq-binding (any)
nil)
;; This is referenced by some code below; it is defined in uniquify.el
(defvar uniquify-buffer-name-style)
;; From emulation/cua-base.el; used below
(defvar cua-enable-cua-keys)
;; Don't clobber an existing menu-bar keymap, to preserve any menu-bar key
;; definitions made in loaddefs.el.
(or (lookup-key global-map [menu-bar])
(bindings--define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")))
;; Force Help item to come last, after the major mode's own items.
;; The symbol used to be called `help', but that gets confused with the
;; help key.
(setq menu-bar-final-items '(buffer services help-menu))
;; This definition is just to show what this looks like.
;; It gets modified in place when menu-bar-update-buffers is called.
(defvar global-buffers-menu-map (make-sparse-keymap "Buffers"))
;; Only declared obsolete (and only made a proper alias) in 23.3.
(define-obsolete-variable-alias
'menu-bar-files-menu 'menu-bar-file-menu "22.1")
(defvar menu-bar-file-menu
(let ((menu (make-sparse-keymap "File")))
;; This is referenced by some code below; it is defined in uniquify.el
(defvar uniquify-buffer-name-style)
;; From emulation/cua-base.el; used below
(defvar cua-enable-cua-keys)
;; The "File" menu items
(bindings--define-key menu [exit-emacs]
'(menu-item "Quit" save-buffers-kill-terminal
:help "Save unsaved buffers, then exit"))
(bindings--define-key menu [separator-exit]
menu-bar-separator)
;; Don't use delete-frame as event name because that is a special
;; event.
(bindings--define-key menu [separator-print]
menu-bar-separator)
(bindings--define-key menu [recover-session]
'(menu-item "Recover Crashed Session" recover-session
:enable
(and auto-save-list-file-prefix
(file-directory-p
(file-name-directory auto-save-list-file-prefix))
(directory-files
(file-name-directory auto-save-list-file-prefix)
nil
(concat "\\`"
(regexp-quote
(file-name-nondirectory
auto-save-list-file-prefix)))
t))
:help "Recover edits from a crashed session"))
(bindings--define-key menu [revert-buffer]
'(menu-item "Revert Buffer" revert-buffer
:enable (or (not (eq revert-buffer-function
'revert-buffer--default))
(not (eq
revert-buffer-insert-file-contents-function
'revert-buffer-insert-file-contents--default-function))
(and buffer-file-number
(or (and buffer-file-name
(file-remote-p buffer-file-name))
(buffer-modified-p)
(not (verify-visited-file-modtime
(current-buffer))))))
:help "Re-read current buffer from its file"))
(bindings--define-key menu [write-file]
'(menu-item "Save As..." write-file
:enable (and (menu-bar-menu-frame-live-and-visible-p)
(menu-bar-non-minibuffer-window-p))
:help "Write current buffer to another file"))
(bindings--define-key menu [save-buffer]
'(menu-item "Save" save-buffer
:enable (and (buffer-modified-p)
(buffer-file-name)
(menu-bar-menu-frame-live-and-visible-p)
(menu-bar-non-minibuffer-window-p))
:help "Save current buffer to its file"))
(bindings--define-key menu [separator-save]
menu-bar-separator)
(bindings--define-key menu [kill-buffer]
'(menu-item "Close" kill-this-buffer
:enable (kill-this-buffer-enabled-p)
:help ,(purecopy "Discard (kill) current buffer")))
(bindings--define-key menu [insert-file]
`(menu-item ,(purecopy "Insert File...") insert-file
:enable (and (menu-bar-non-minibuffer-window-p)
(menu-bar-menu-frame-live-and-visible-p))
:help ,(purecopy "Insert another file into current buffer")))
(bindings--define-key menu [dired]
`(menu-item ,(purecopy "Open Directory...") dired
:enable (and (menu-bar-non-minibuffer-window-p)
(menu-bar-menu-frame-live-and-visible-p))
:help ,(purecopy "Read a directory, to operate on its files")))
(bindings--define-key menu [open-file]
`(menu-item ,(purecopy "Open File...") menu-find-file-existing
:enable (menu-bar-non-minibuffer-window-p)
:help "Read an existing file into an Emacs buffer"))
(bindings--define-key menu [new-file]
'(menu-item "Visit New File..." find-file
:enable (menu-bar-non-minibuffer-window-p)
:help "Specify a new file's name, to edit the file"))
menu))
(defun menu-find-file-existing ()
"Edit the existing file FILENAME."
(interactive)
(let* ((mustmatch (not (and (fboundp 'x-uses-old-gtk-dialog)
(x-uses-old-gtk-dialog))))
(filename (car (find-file-read-args "Find file: " mustmatch))))
(if mustmatch
(find-file-existing filename)
(find-file filename))))
;; The "Edit->Search" submenu
(defvar menu-bar-last-search-type nil
"Type of last non-incremental search command called from the menu.")
(defun nonincremental-repeat-search-forward ()
"Search forward for the previous search string or regexp."
(interactive)
(cond
((and (eq menu-bar-last-search-type 'string)
search-ring)
(nonincremental-search-forward))
((and (eq menu-bar-last-search-type 'regexp)
regexp-search-ring)
(re-search-forward (car regexp-search-ring)))
(t
(error "No previous search"))))
(defun nonincremental-repeat-search-backward ()
"Search backward for the previous search string or regexp."
(interactive)
(cond
((and (eq menu-bar-last-search-type 'string)
search-ring)
(nonincremental-search-backward))
((and (eq menu-bar-last-search-type 'regexp)
regexp-search-ring)
(re-search-backward (car regexp-search-ring)))
(t
(error "No previous search"))))
(defun nonincremental-search-forward (&optional string backward)
"Read a string and search for it nonincrementally."
(interactive "sSearch for string: ")
(setq menu-bar-last-search-type 'string)
;; Ideally, this whole command would be equivalent to `C-s RET'.
(let ((isearch-forward (not backward))
(isearch-regexp-function search-default-mode)
(isearch-regexp nil))
(if (or (equal string "") (not string))
(funcall (isearch-search-fun-default) (car search-ring))
(isearch-update-ring string nil)
(funcall (isearch-search-fun-default) string))))
(defun nonincremental-search-backward (&optional string)
"Read a string and search backward for it nonincrementally."
(interactive "sSearch backwards for string: ")
(nonincremental-search-forward string 'backward))
(defun nonincremental-re-search-forward (string)
"Read a regular expression and search for it nonincrementally."
(interactive "sSearch for regexp: ")
(setq menu-bar-last-search-type 'regexp)
(if (equal string "")
(re-search-forward (car regexp-search-ring))
(isearch-update-ring string t)
(re-search-forward string)))
(defun nonincremental-re-search-backward (string)
"Read a regular expression and search backward for it nonincrementally."
(interactive "sSearch for regexp: ")
(setq menu-bar-last-search-type 'regexp)
(if (equal string "")
(re-search-backward (car regexp-search-ring))
(isearch-update-ring string t)
(re-search-backward string)))
;; The Edit->Search->Incremental Search menu
(defvar menu-bar-i-search-menu
(let ((menu (make-sparse-keymap "Incremental Search")))
(bindings--define-key menu [isearch-backward-regexp]
'(menu-item "Backward Regexp..." isearch-backward-regexp
:help "Search backwards for a regular expression as you type it"))
(bindings--define-key menu [isearch-forward-regexp]
'(menu-item "Forward Regexp..." isearch-forward-regexp
:help "Search forward for a regular expression as you type it"))
(bindings--define-key menu [isearch-backward]
'(menu-item "Backward String..." isearch-backward
:help "Search backwards for a string as you type it"))
(bindings--define-key menu [isearch-forward]
'(menu-item "Forward String..." isearch-forward
:help "Search forward for a string as you type it"))
menu))
(defvar menu-bar-search-menu
(let ((menu (make-sparse-keymap "Search")))
(bindings--define-key menu [i-search]
`(menu-item "Incremental Search" ,menu-bar-i-search-menu))
(bindings--define-key menu [separator-tag-isearch]
menu-bar-separator)
(bindings--define-key menu [tags-continue]
`(menu-item ,(purecopy "Continue Tags Search") tags-loop-continue
:help ,(purecopy "Continue last tags search operation")))
(bindings--define-key menu [tags-srch]
`(menu-item ,(purecopy "Search Tagged Files...") tags-search
:help ,(purecopy "Search for a regexp in all tagged files")))
(bindings--define-key menu [separator-tag-search]
`(menu-item ,(purecopy "--")))
(bindings--define-key menu [grep]
`(menu-item ,(purecopy "Search Files (Grep)...") grep
:help ,(purecopy "Search files for strings or regexps (with Grep)")))
(bindings--define-key menu [separator-grep-search]
`(menu-item ,(purecopy "--")))
(bindings--define-key menu [repeat-search-back]
'(menu-item "Repeat Backwards"
nonincremental-repeat-search-backward
:enable (or (and (eq menu-bar-last-search-type 'string)
search-ring)
(and (eq menu-bar-last-search-type 'regexp)
regexp-search-ring))
:help "Repeat last search backwards"))
(bindings--define-key menu [repeat-search-fwd]
'(menu-item "Repeat Forward"
nonincremental-repeat-search-forward
:enable (or (and (eq menu-bar-last-search-type 'string)
search-ring)
(and (eq menu-bar-last-search-type 'regexp)
regexp-search-ring))
:help "Repeat last search forward"))
(bindings--define-key menu [separator-repeat-search]
menu-bar-separator)
(bindings--define-key menu [re-search-backward]
'(menu-item "Regexp Backwards..."
nonincremental-re-search-backward
:help "Search backwards for a regular expression"))
(bindings--define-key menu [re-search-forward]
'(menu-item "Regexp Forward..."
nonincremental-re-search-forward
:help "Search forward for a regular expression"))
(bindings--define-key menu [search-backward]
'(menu-item "String Backwards..."
nonincremental-search-backward
:help "Search backwards for a string"))
(bindings--define-key menu [search-forward]
'(menu-item "String Forward..." nonincremental-search-forward
:help "Search forward for a string"))
menu))
;; The Edit->Replace submenu
(defvar menu-bar-replace-menu
(let ((menu (make-sparse-keymap "Replace")))
(bindings--define-key menu [tags-repl-continue]
'(menu-item "Continue Replace" tags-loop-continue
:help "Continue last tags replace operation"))
(bindings--define-key menu [tags-repl]
'(menu-item "Replace in Tagged Files..." tags-query-replace
:help "Interactively replace a regexp in all tagged files"))
(bindings--define-key menu [separator-replace-tags]
menu-bar-separator)
(bindings--define-key menu [query-replace-regexp]
'(menu-item "Replace Regexp..." query-replace-regexp
:enable (not buffer-read-only)
:help "Replace regular expression interactively, ask about each occurrence"))
(bindings--define-key menu [query-replace]
'(menu-item "Replace String..." query-replace
:enable (not buffer-read-only)
:help "Replace string interactively, ask about each occurrence"))
menu))
(defvar yank-menu (cons (purecopy "Select Yank") nil))
(fset 'yank-menu (cons 'keymap yank-menu))
;;; Assemble the top-level Edit menu items.
(defvar menu-bar-edit-menu
(let ((menu (make-sparse-keymap "Edit")))
(bindings--define-key menu [props]
`(menu-item ,(purecopy "Text Properties") facemenu-menu
:enable (menu-bar-menu-frame-live-and-visible-p)))
(defvar menu-bar-goto-menu
(let ((menu (make-sparse-keymap "Go To")))
(bindings--define-key menu [set-tags-name]
'(menu-item "Set Tags File Name..." visit-tags-table
:visible (menu-bar-goto-uses-etags-p)
:help "Tell navigation commands which tag table file to use"))
(bindings--define-key menu [separator-tag-file]
'(menu-item "--" nil :visible (menu-bar-goto-uses-etags-p)))
(bindings--define-key menu [xref-pop]
'(menu-item "Back" xref-pop-marker-stack
:visible (and (featurep 'xref)
(not (xref-marker-stack-empty-p)))
:help "Back to the position of the last search"))
(bindings--define-key menu [xref-apropos]
'(menu-item "Find Apropos..." xref-find-apropos
:help "Find function/variables whose names match regexp"))
(bindings--define-key menu [xref-find-otherw]
'(menu-item "Find Definition in Other Window..."
xref-find-definitions-other-window
:help "Find function/variable definition in another window"))
(bindings--define-key menu [xref-find-def]
'(menu-item "Find Definition..." xref-find-definitions
:help "Find definition of function or variable"))
(bindings--define-key menu [separator-xref]
menu-bar-separator)
(bindings--define-key menu [end-of-buf]
'(menu-item "Goto End of Buffer" end-of-buffer))
(bindings--define-key menu [beg-of-buf]
'(menu-item "Goto Beginning of Buffer" beginning-of-buffer))
(bindings--define-key menu [go-to-pos]
'(menu-item "Goto Buffer Position..." goto-char
:help "Read a number N and go to buffer position N"))
(bindings--define-key menu [go-to-line]
'(menu-item "Goto Line..." goto-line
:help "Read a line number and go to that line"))
menu))
(defun menu-bar-goto-uses-etags-p ()
(or (not (boundp 'xref-backend-functions))
(eq (car xref-backend-functions) 'etags--xref-backend)))
(defvar yank-menu (cons (purecopy "Select Yank") nil))
(fset 'yank-menu (cons 'keymap yank-menu))
(bindings--define-key menu [props]
`(menu-item ,(purecopy "Text Properties") facemenu-menu))
;; ns-win.el said: Add spell for platform consistency.
(if (featurep 'ns)
(bindings--define-key menu [spell]
`(menu-item "Spell" ispell-menu-map)))
(bindings--define-key menu [fill]
`(menu-item "Fill" fill-region
:enable (and mark-active (not buffer-read-only))
:help
"Fill text in region to fit between left and right margin"))
(bindings--define-key menu [separator-bookmark]
menu-bar-separator)
(bindings--define-key menu [bookmark]
`(menu-item "Bookmarks" menu-bar-bookmark-map))
(bindings--define-key menu [goto]
`(menu-item ,(purecopy "Go To") ,menu-bar-goto-menu
:enable (menu-bar-menu-frame-live-and-visible-p)))
(bindings--define-key menu [replace]
`(menu-item ,(purecopy "Replace") ,menu-bar-replace-menu
:enable (menu-bar-menu-frame-live-and-visible-p)))
(bindings--define-key menu [search]
`(menu-item ,(purecopy "Search") ,menu-bar-search-menu
:enable (menu-bar-menu-frame-live-and-visible-p)))
(bindings--define-key menu [separator-search]
menu-bar-separator)
(bindings--define-key menu [mark-whole-buffer]
`(menu-item ,(purecopy "Select All") mark-whole-buffer
:enable (menu-bar-menu-frame-live-and-visible-p)
:help ,(purecopy "Mark the whole buffer for a subsequent cut/copy")))
(bindings--define-key menu [clear]
`(menu-item ,(purecopy "Clear") delete-region
:enable (and mark-active
(not buffer-read-only))
:help
"Delete the text in region between mark and current position"))
(bindings--define-key menu (if (featurep 'ns) [select-paste]
[paste-from-menu])
;; ns-win.el said: Change text to be more consistent with
;; surrounding menu items `paste', etc."
`(menu-item ,(if (featurep 'ns) "Select and Paste" "Paste from Kill Menu")
yank-menu
:enable (and (cdr yank-menu) (not buffer-read-only))
:help "Choose a string from the kill ring and paste it"))
(bindings--define-key menu [paste]
`(menu-item "Paste" yank
:enable (funcall
',(lambda ()
(and (or
(gui-backend-selection-exists-p 'CLIPBOARD)
(if (featurep 'ns) ; like paste-from-menu
(cdr yank-menu)
kill-ring))
(not buffer-read-only))))
:help "Paste (yank) text most recently cut/copied"))
(bindings--define-key menu [copy]
;; ns-win.el said: Substitute a Copy function that works better
;; under X (for GNUstep).
`(menu-item "Copy" ,(if (featurep 'ns)
'ns-copy-including-secondary
'kill-ring-save)
:enable mark-active
:help "Copy text in region between mark and current position"
:keys ,(if (featurep 'ns)
"\\[ns-copy-including-secondary]"
"\\[kill-ring-save]")))
(bindings--define-key menu [cut]
`(menu-item ,(purecopy "Cut") kill-region
:enable (and mark-active (not buffer-read-only)
(menu-bar-menu-frame-live-and-visible-p))
:help
"Cut (kill) text in region between mark and current position"))
;; ns-win.el said: Separate undo from cut/paste section.
(if (featurep 'ns)
(bindings--define-key menu [separator-undo] menu-bar-separator))
(bindings--define-key menu [undo]
'(menu-item "Undo" undo
:enable (and (not buffer-read-only)
(menu-bar-menu-frame-live-and-visible-p)
(not (eq t buffer-undo-list))
(if (eq last-command 'undo)
(listp pending-undo-list)
(consp buffer-undo-list)))
:help "Undo last operation"))
menu))
(define-obsolete-function-alias
'menu-bar-kill-ring-save 'kill-ring-save "24.1")
;; These are alternative definitions for the cut, paste and copy
;; menu items. Use them if your system expects these to use the clipboard.
(put 'clipboard-kill-region 'menu-enable
'(and mark-active (not buffer-read-only)))
(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
(put 'clipboard-yank 'menu-enable
`(funcall ',(lambda ()
(and (or (gui-backend-selection-exists-p 'PRIMARY)
(gui-backend-selection-exists-p 'CLIPBOARD))
(not buffer-read-only)))))
(defun clipboard-yank ()
"Insert the clipboard contents, or the last stretch of killed text."
(interactive "*")
(let ((select-enable-clipboard t))
(yank)))
(defun clipboard-kill-ring-save (beg end &optional region)
"Copy region to kill ring, and save in the GUI's clipboard.
If the optional argument REGION is non-nil, the function ignores
BEG and END, and saves the current region instead."
(interactive "r\np")
(and (or (not transient-mark-mode) (use-region-p)) ;; Aquamacs restriction
(let ((select-enable-clipboard t))
(kill-ring-save beg end region))))
(defun clipboard-kill-region (beg end &optional region)
"Kill the region, and save it in the GUI's clipboard.
If the optional argument REGION is non-nil, the function ignores
BEG and END, and kills the current region instead."
(interactive "r\np")
(and (or (not transient-mark-mode) (use-region-p)) ;; Aquamacs restriction
(let ((select-enable-clipboard t))
(kill-region beg end region))))
(defun menu-bar-enable-clipboard ()
"Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
Do the same for the keys of the same name."
(interactive)
;; These are Sun server keysyms for the Cut, Copy and Paste keys
;; (also for XFree86 on Sun keyboard):
(bindings--define-key global-map [f20] 'clipboard-kill-region)
(bindings--define-key global-map [f16] 'clipboard-kill-ring-save)
(bindings--define-key global-map [f18] 'clipboard-yank)
;; X11R6 versions:
(bindings--define-key global-map [cut] 'clipboard-kill-region)
(bindings--define-key global-map [copy] 'clipboard-kill-ring-save)
(bindings--define-key global-map [paste] 'clipboard-yank))
;; The "Options" menu items
(defvar menu-bar-custom-menu
(let ((menu (make-sparse-keymap "Customize")))
(bindings--define-key menu [customize-apropos-faces]
'(menu-item "Faces Matching..." customize-apropos-faces
:help "Browse faces matching a regexp or word list"))
(bindings--define-key menu [customize-apropos-options]
'(menu-item "Options Matching..." customize-apropos-options
:help "Browse options matching a regexp or word list"))
(bindings--define-key menu [customize-apropos]
'(menu-item "All Settings Matching..." customize-apropos
:help "Browse customizable settings matching a regexp or word list"))
(bindings--define-key menu [separator-1]
menu-bar-separator)
(bindings--define-key menu [customize-group]
'(menu-item "Specific Group..." customize-group
:help "Customize settings of specific group"))
(bindings--define-key menu [customize-face]
'(menu-item "Specific Face..." customize-face
:help "Customize attributes of specific face"))
(bindings--define-key menu [customize-option]
'(menu-item "Specific Option..." customize-option
:help "Customize value of specific option"))
(bindings--define-key menu [separator-2]
menu-bar-separator)
(bindings--define-key menu [customize-changed-options]
'(menu-item "New Options..." customize-changed-options
:help "Options added or changed in recent Emacs versions"))
(bindings--define-key menu [customize-saved]
'(menu-item "Saved Options" customize-saved
:help "Customize previously saved options"))
(bindings--define-key menu [separator-3]
menu-bar-separator)
(bindings--define-key menu [customize-browse]
'(menu-item "Browse Customization Groups" customize-browse
:help "Browse all customization groups"))
(bindings--define-key menu [customize]
'(menu-item "Top-level Customization Group" customize
:help "The master group called `Emacs'"))
(bindings--define-key menu [customize-themes]
'(menu-item "Custom Themes" customize-themes
:help "Choose a pre-defined customization theme"))
menu))
;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences"))
(defmacro menu-bar-make-mm-toggle (fname doc help &optional props)
"Make a menu-item for a global minor mode toggle.
FNAME is the minor mode's name (variable and function).
DOC is the text to use for the menu entry.
HELP is the text to use for the tooltip.
PROPS are additional properties."
`'(menu-item ,doc ,fname
,@props
:help ,help
:button (:toggle . (and (default-boundp ',fname)
(default-value ',fname)))))
(defmacro menu-bar-make-toggle (name variable doc message help &rest body)
`(progn
(defun ,name (&optional interactively)
,(concat "Toggle whether to " (downcase (substring help 0 1))
(substring help 1) ".
In an interactive call, record this option as a candidate for saving
by \"Save Options\" in Custom buffers.")
(interactive "p")
(if ,(if body `(progn . ,body)
`(progn
(custom-load-symbol ',variable)
(let ((set (or (get ',variable 'custom-set) 'set-default))
(get (or (get ',variable 'custom-get) 'default-value)))
(funcall set ',variable (not (funcall get ',variable))))))
(message ,message "enabled globally")
(message ,message "disabled globally"))
;; The function `customize-mark-as-set' must only be called when
;; a variable is set interactively, as the purpose is to mark it as
;; a candidate for "Save Options", and we do not want to save options
;; the user have already set explicitly in his init file.
(if interactively (customize-mark-as-set ',variable)))
'(menu-item ,doc ,name
:help ,help
:button (:toggle . (and (default-boundp ',variable)
(default-value ',variable))))))
;; Function for setting/saving default font.
(defun menu-set-font ()
"Interactively select a font and make it the default on all frames.
The selected font will be the default on both the existing and future frames."
(interactive)
(set-frame-font (if (fboundp 'x-select-font)
(x-select-font)
(mouse-select-font))
nil t))
(defun menu-bar-options-save ()
"Save current values of Options menu items using Custom."
(interactive)
(let ((need-save nil))
;; These are set with menu-bar-make-mm-toggle, which does not
;; put on a customized-value property.
(dolist (elt '(global-show-newlines-mode global-linum-mode
column-number-mode size-indication-mode
cua-mode show-paren-mode transient-mark-mode
display-time-mode display-battery-mode
visual-line-mode))
(and (customize-mark-to-save elt)
(setq need-save t)))
;; These are set with `customize-set-variable'.
(dolist (elt '(scroll-bar-mode
debug-on-quit debug-on-error
;; Somehow this works, when tool-bar and menu-bar don't.
tooltip-mode window-divider-mode
save-place uniquify-buffer-name-style fringe-mode
indicate-empty-lines indicate-buffer-boundaries
case-fold-search font-use-system-font
current-language-environment default-input-method
;; Saving `text-mode-hook' is somewhat questionable,
;; as we might get more than we bargain for, if
;; other code may has added hooks as well.
;; Nonetheless, not saving it would like be confuse
;; more often.
;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2002-02-11.
text-mode-hook tool-bar-position
word-wrap truncate-lines global-visual-line-mode global-auto-fill-mode))
(and (get elt 'customized-value)
(customize-mark-to-save elt)
(setq need-save t)))
(when (get 'default 'customized-face)
(put 'default 'saved-face (get 'default 'customized-face))
(put 'default 'customized-face nil)
(setq need-save t))
;; Save if we changed anything.
(when need-save
(custom-save-all))))
;;; Assemble all the top-level items of the "Options" menu
(defun menu-bar-window-divider-customize ()
"Show customization buffer for `window-divider' group."
(interactive)
(customize-group 'window-divider))
(defun menu-bar-bottom-and-right-window-divider ()
"Display dividers on the bottom and right of each window."
(interactive)
(customize-set-variable 'window-divider-default-places t)
(window-divider-mode 1))
(defun menu-bar-right-window-divider ()
"Display dividers only on the right of each window."
(interactive)
(customize-set-variable 'window-divider-default-places 'right-only)
(window-divider-mode 1))
(defun menu-bar-bottom-window-divider ()
"Display dividers only at the bottom of each window."
(interactive)
(customize-set-variable 'window-divider-default-places 'bottom-only)
(window-divider-mode 1))
(defun menu-bar-no-window-divider ()
"Do not display window dividers."
(interactive)
(window-divider-mode -1))
;; For the radio buttons below we check whether the respective dividers
;; are displayed on the selected frame. This is not fully congruent
;; with `window-divider-mode' but makes the menu entries work also when
;; dividers are displayed by manipulating frame parameters directly.
(defvar menu-bar-showhide-window-divider-menu
(let ((menu (make-sparse-keymap "Window Divider")))
(bindings--define-key menu [customize]
'(menu-item "Customize" menu-bar-window-divider-customize
:help "Customize window dividers"
:visible (memq (window-system) '(x w32))))
(bindings--define-key menu [bottom-and-right]
'(menu-item "Bottom and Right"
menu-bar-bottom-and-right-window-divider
:help "Display window divider on the bottom and right of each window"
:visible (memq (window-system) '(x w32))
:button (:radio
. (and (window-divider-width-valid-p
(cdr (assq 'bottom-divider-width
(frame-parameters))))
(window-divider-width-valid-p
(cdr (assq 'right-divider-width
(frame-parameters))))))))
(bindings--define-key menu [right-only]
'(menu-item "Right Only"
menu-bar-right-window-divider
:help "Display window divider on the right of each window only"
:visible (memq (window-system) '(x w32))
:button (:radio
. (and (not (window-divider-width-valid-p
(cdr (assq 'bottom-divider-width
(frame-parameters)))))
(window-divider-width-valid-p
(cdr (assq 'right-divider-width
(frame-parameters))))))))
(bindings--define-key menu [bottom-only]
'(menu-item "Bottom Only"
menu-bar-bottom-window-divider
:help "Display window divider on the bottom of each window only"
:visible (memq (window-system) '(x w32))
:button (:radio
. (and (window-divider-width-valid-p
(cdr (assq 'bottom-divider-width
(frame-parameters))))
(not (window-divider-width-valid-p
(cdr (assq 'right-divider-width
(frame-parameters)))))))))
(bindings--define-key menu [no-divider]
'(menu-item "None"
menu-bar-no-window-divider
:help "Do not display window dividers"
:visible (memq (window-system) '(x w32))
:button (:radio
. (and (not (window-divider-width-valid-p
(cdr (assq 'bottom-divider-width
(frame-parameters)))))
(not (window-divider-width-valid-p
(cdr (assq 'right-divider-width
(frame-parameters)))))))))
menu))
(defun menu-bar-showhide-fringe-ind-customize ()
"Show customization buffer for `indicate-buffer-boundaries'."
(interactive)
(customize-variable 'indicate-buffer-boundaries))
(defun menu-bar-showhide-fringe-ind-mixed ()
"Display top and bottom indicators in opposite fringes, arrows in right."
(interactive)
(customize-set-variable 'indicate-buffer-boundaries
'((t . right) (top . left))))
(defun menu-bar-showhide-fringe-ind-box ()
"Display top and bottom indicators in opposite fringes."
(interactive)
(customize-set-variable 'indicate-buffer-boundaries
'((top . left) (bottom . right))))
(defun menu-bar-showhide-fringe-ind-right ()
"Display buffer boundaries and arrows in the right fringe."
(interactive)
(customize-set-variable 'indicate-buffer-boundaries 'right))
(defun menu-bar-showhide-fringe-ind-left ()
"Display buffer boundaries and arrows in the left fringe."
(interactive)
(customize-set-variable 'indicate-buffer-boundaries 'left))
(defun menu-bar-showhide-fringe-ind-none ()
"Do not display any buffer boundary indicators."
(interactive)
(customize-set-variable 'indicate-buffer-boundaries nil))
(defun customize-tool-bar ()
"Show tool bar customization.
Only available in Aquamacs."
(interactive)
(tool-bar-mode 1) ; must be visible
(sit-for 0)
(ns-tool-bar-customize))
(defvar menu-bar-showhide-fringe-ind-menu
(let ((menu (make-sparse-keymap "Buffer boundaries")))
(bindings--define-key menu [customize]
'(menu-item "Other (Customize)"
menu-bar-showhide-fringe-ind-customize
:help "Additional choices available through Custom buffer"
:visible (display-graphic-p)
:button (:radio . (not (member indicate-buffer-boundaries
'(nil left right
((top . left) (bottom . right))
((t . right) (top . left))))))))
(bindings--define-key menu [mixed]
'(menu-item "Opposite, Arrows Right" menu-bar-showhide-fringe-ind-mixed
:help
"Show top/bottom indicators in opposite fringes, arrows in right"
:visible (display-graphic-p)
:button (:radio . (equal indicate-buffer-boundaries
'((t . right) (top . left))))))
(bindings--define-key menu [box]
'(menu-item "Opposite, No Arrows" menu-bar-showhide-fringe-ind-box
:help "Show top/bottom indicators in opposite fringes, no arrows"
:visible (display-graphic-p)
:button (:radio . (equal indicate-buffer-boundaries
'((top . left) (bottom . right))))))
(bindings--define-key menu [right]
'(menu-item "In Right Fringe" menu-bar-showhide-fringe-ind-right
:help "Show buffer boundaries and arrows in right fringe"
:visible (display-graphic-p)
:button (:radio . (eq indicate-buffer-boundaries 'right))))
(bindings--define-key menu [left]
'(menu-item "In Left Fringe" menu-bar-showhide-fringe-ind-left
:help "Show buffer boundaries and arrows in left fringe"
:visible (display-graphic-p)
:button (:radio . (eq indicate-buffer-boundaries 'left))))
(bindings--define-key menu [none]
'(menu-item "No Indicators" menu-bar-showhide-fringe-ind-none
:help "Hide all buffer boundary indicators and arrows"
:visible (display-graphic-p)
:button (:radio . (eq indicate-buffer-boundaries nil))))
menu))
(defun menu-bar-showhide-fringe-menu-customize ()
"Show customization buffer for `fringe-mode'."
(interactive)
(customize-variable 'fringe-mode))
(defun menu-bar-showhide-fringe-menu-customize-reset ()
"Reset the fringe mode: display fringes on both sides of a window."
(interactive)
(customize-set-variable 'fringe-mode nil))
(defun menu-bar-showhide-fringe-menu-customize-right ()
"Display fringes only on the right of each window."
(interactive)
(require 'fringe)
(customize-set-variable 'fringe-mode '(0 . nil)))
(defun menu-bar-showhide-fringe-menu-customize-left ()
"Display fringes only on the left of each window."
(interactive)
(require 'fringe)
(customize-set-variable 'fringe-mode '(nil . 0)))
(defun menu-bar-showhide-fringe-menu-customize-disable ()
"Do not display window fringes."
(interactive)
(require 'fringe)
(customize-set-variable 'fringe-mode 0))
(defvar menu-bar-showhide-fringe-menu
(let ((menu (make-sparse-keymap "Fringe")))
(bindings--define-key menu [showhide-fringe-ind]
`(menu-item "Buffer Boundaries" ,menu-bar-showhide-fringe-ind-menu
:visible (display-graphic-p)
:help "Indicate buffer boundaries in fringe"))
(bindings--define-key menu [indicate-empty-lines]
(menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines
"Empty Line Indicators"
"Indicating of empty lines %s"
"Indicate trailing empty lines in fringe, globally"))
(bindings--define-key menu [customize]
'(menu-item "Customize Fringe" menu-bar-showhide-fringe-menu-customize
:help "Detailed customization of fringe"
:visible (display-graphic-p)))
(bindings--define-key menu [default]
'(menu-item "Default" menu-bar-showhide-fringe-menu-customize-reset
:help "Default width fringe on both left and right side"
:visible (display-graphic-p)
:button (:radio . (eq fringe-mode nil))))
(bindings--define-key menu [right]
'(menu-item "On the Right" menu-bar-showhide-fringe-menu-customize-right
:help "Fringe only on the right side"
:visible (display-graphic-p)
:button (:radio . (equal fringe-mode '(0 . nil)))))
(bindings--define-key menu [left]
'(menu-item "On the Left" menu-bar-showhide-fringe-menu-customize-left
:help "Fringe only on the left side"
:visible (display-graphic-p)
:button (:radio . (equal fringe-mode '(nil . 0)))))
(bindings--define-key menu [none]
'(menu-item "None" menu-bar-showhide-fringe-menu-customize-disable
:help "Turn off fringe"
:visible (display-graphic-p)
:button (:radio . (eq fringe-mode 0))))
menu))
(defun menu-bar-right-scroll-bar ()
"Display scroll bars on the right of each window."
(interactive)
(customize-set-variable 'scroll-bar-mode 'right))
(defun menu-bar-left-scroll-bar ()
"Display scroll bars on the left of each window."
(interactive)
(customize-set-variable 'scroll-bar-mode 'left))
(defun menu-bar-no-scroll-bar ()
"Turn off scroll bars."
(interactive)
(customize-set-variable 'scroll-bar-mode nil))
(defun menu-bar-horizontal-scroll-bar ()
"Display horizontal scroll bars on each window."
(interactive)
(customize-set-variable 'horizontal-scroll-bar-mode t))
(defun menu-bar-no-horizontal-scroll-bar ()
"Turn off horizontal scroll bars."
(interactive)
(customize-set-variable 'horizontal-scroll-bar-mode nil))
(defvar menu-bar-showhide-scroll-bar-menu
(let ((menu (make-sparse-keymap "Scroll-bar")))
(bindings--define-key menu [horizontal]
'(menu-item "Horizontal"
menu-bar-horizontal-scroll-bar
:help "Horizontal scroll bar"
:visible (horizontal-scroll-bars-available-p)
:button (:radio . (cdr (assq 'horizontal-scroll-bars
(frame-parameters))))))
(bindings--define-key menu [none-horizontal]
'(menu-item "None-horizontal"
menu-bar-no-horizontal-scroll-bar
:help "Turn off horizontal scroll bars"
:visible (horizontal-scroll-bars-available-p)
:button (:radio . (not (cdr (assq 'horizontal-scroll-bars
(frame-parameters)))))))
(bindings--define-key menu [right]
'(menu-item "On the Right"
menu-bar-right-scroll-bar
:help "Scroll-bar on the right side"
:visible (display-graphic-p)
:button (:radio . (eq (cdr (assq 'vertical-scroll-bars
(frame-parameters)))
'right))))
(bindings--define-key menu [left]
'(menu-item "On the Left"
menu-bar-left-scroll-bar
:help "Scroll-bar on the left side"
:visible (display-graphic-p)
:button (:radio . (eq (cdr (assq 'vertical-scroll-bars
(frame-parameters)))
'left))))
(bindings--define-key menu [none]
'(menu-item "None"