/
help-fns+.el
2481 lines (2381 loc) · 135 KB
/
help-fns+.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
;;; help-fns+.el --- Extensions to `help-fns.el'.
;;
;; Filename: help-fns+.el
;; Description: Extensions to `help-fns.el'.
;; Author: Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 2007-2012, Drew Adams, all rights reserved.
;; Created: Sat Sep 01 11:01:42 2007
;; Version: 22.1
;; Last-Updated: Sun Oct 28 18:51:09 2012 (-0700)
;; By: dradams
;; Update #: 1487
;; URL: http://www.emacswiki.org/cgi-bin/wiki/help-fns+.el
;; Doc URL: http://emacswiki.org/emacs/HelpPlus
;; Keywords: help, faces, characters, packages, description
;; Compatibility: GNU Emacs: 22.x, 23.x
;;
;; Features that might be required by this library:
;;
;; `button', `help-fns', `help-mode', `info', `naked', `view',
;; `wid-edit', `wid-edit+'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Extensions to `help-fns.el'. Also includes a redefinition of
;; `describe-face', which is from `faces.el'.
;;
;; ************************** IMPORTANT ***************************
;; * *
;; * Byte-compiling this file in one Emacs version and using the *
;; * compiled file in another version works ONLY as follows: *
;; * *
;; * If you compile in Emacs 22, use it only for Emacs 22. *
;; * If you compile in Emacs 23. use it for Emacs 22, 23, or 24. *
;; * If you compile in Emacs 24, use it only for Emacs 24. *
;; * *
;; ****************************************************************
;;
;;
;; Keys bound here:
;;
;; `C-h B' `describe-buffer'
;; `C-h c' `describe-command' (replaces `describe-key-briefly')
;; `C-h o' `describe-option'
;; `C-h C-c' `describe-key-briefly' (replaces `C-h c')
;; `C-h C-o' `describe-option-of-type'
;; `C-h M-c' `describe-copying' (replaces `C-h C-c')
;; `C-h M-f' `describe-file'
;; `C-h M-k' `describe-keymap'
;; `C-h M-l' `find-function-on-key'
;;
;; Commands defined here:
;;
;; `describe-buffer', `describe-command', `describe-file',
;; `describe-keymap', `describe-option', `describe-option-of-type'.
;;
;; User options defined here:
;;
;; `help-cross-reference-manuals' (Emacs 23.2+).
;;
;; Non-interactive functions defined here:
;;
;; `describe-mode-1', `help-all-exif-data',
;; `help-commands-to-key-buttons', `help-custom-type',
;; `help-documentation', `help-documentation-property',
;; `help-key-button-string', `help-remove-duplicates',
;; `help-substitute-command-keys', `help-value-satisfies-type-p',
;; `help-var-inherits-type-p', `help-var-is-of-type-p',
;; `help-var-matches-type-p', `help-var-val-satisfies-type-p',
;; `Info-first-index-occurrence' (Emacs 23.2+),
;; `Info-indexed-find-file' (Emacs 23.2+), `Info-indexed-find-node'
;; (Emacs 23.2+), `Info-index-entries-across-manuals' (Emacs
;; 23.2+), `Info-index-occurrences' (Emacs 23.2+),
;; `Info-make-manuals-xref' (Emacs 23.2+).
;;
;; Internal variables defined here:
;;
;; `Info-indexed-file' (Emacs 23.2+), `Info-indexed-nodes' (Emacs
;; 23.2+), `variable-name-history'.
;;
;;
;; ***** NOTE: The following command defined in `faces.el'
;; has been REDEFINED HERE:
;;
;; `describe-face'.
;;
;;
;; ***** NOTE: The following command defined in `help.el'
;; has been REDEFINED HERE:
;;
;; `describe-mode'.
;;
;;
;; ***** NOTE: The following functions defined in `help-fns.el'
;; have been REDEFINED HERE:
;;
;; `describe-function', `describe-function-1', `describe-variable',
;; `help-fns--key-bindings', `help-fns--signature',
;;
;;
;; ***** NOTE: The following command defined in `package.el'
;; has been REDEFINED HERE:
;;
;; `describe-package'.
;;
;;
;; Put this in your initialization file (`~/.emacs'):
;;
;; (require 'help-fns+)
;;
;; Acknowledgement: Passing text properties on doc strings to the
;; *Help* buffer is an idea from Johan bockgard. He sent it on
;; 2007-01-24 to emacs-devel@gnu.org, Subject
;; "display-completion-list should not strip text properties".
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change Log:
;;
;; 2012/10/28 dadams
;; help-fns--key-bindings: Fixed: forgot to mapconcat over keys.
;; 2012/10/26 dadams
;; Added: help-fns--key-bindings, help-fns--signature,
;; Added Emacs 24.3+ version of describe-function-1. Updated version for 23.2-24.2.
;; help-substitute-command-keys: Fix for \= when no match for \[, \<, \{ past it.
;; 2012/09/24 dadams
;; describe-file: Added optional arg NO-ERROR-P.
;; 2012/09/22 dadams
;; Info-index-occurrences, Info-first-index-occurrence:
;; Replace Info-directory call by short version. Better Searching msg.
;; 2012/09/21 dadams
;; Renamed Info-any-index-occurrences-p to Info-first-index-occurrence.
;; Info-any-index-occurrences-p: Return the first successful lookup, not t.
;; Info-index-entries-across-manuals, Info-index-occurrences, Info-any-index-occurrences-p:
;; Added optional arg INDEX-NODES.
;; Adjust calls to those fns accordingly, e.g., in define-button-type for help-info-manual-lookup
;; and help-insert-xref-button in Info-make-manuals-xref.
;; 2012/07/20 dadams
;; Added: describe-buffer, describe-mode-1. Bound describe-buffer to C-h B.
;; describe-mode: Redefined to use describe-mode-1.
;; 2012/07/03 dadams
;; Info-make-manuals-xref, Info-index-entries-across-manuals, Info-index-occurrences,
;; Info-any-index-occurrences-p:
;; Added optional arg NOMSG.
;; describe-(function|variable|file|package): No message if not interactive-p.
;; describe-function-1: pass MSGP to Info-make-manuals-xref (i.e. msg always).
;; describe-(mode|variable|face|keymap|package): Pass proper NOMSG arg to Info-make-manuals-xref.
;; 2012/01/11 dadams
;; describe-variable: Remove * from beginning of doc string.
;; 2011/11/25 dadams
;; Reverted yesterday's change and added IMPORTANT note to Commentary.
;; 2011/11/24 dadams
;; Added Emacs 24 version of with-help-window. They changed the signature of help-window-setup.
;; 2011/10/14 dadams
;; describe-mode: Call help-documentation while in mode's buffer, in case no \\<...>.
;; 2011/10/08 dadams
;; Info-make-manuals-xref: Do nothing if OBJECT is not a string or a symbol (e.g. is a keymap).
;; 2011/10/07 dadams
;; Added soft require of naked.el.
;; help-substitute-command-keys, describe-function-1:
;; Use naked-key-description if available.
;; 2011/08/22 dadams
;; describe-variable (Emacs 23+): Added terpri after Value: (for multiline value).
;; 2011/07/25 dadams
;; describe-mode:
;; Put call to help-documentation inside let for maj: else major-mode gets changed to help-mode.
;; 2011/06/26 dadams
;; Added: help-commands-to-key-buttons, help-documentation(-property),
;; help-key-button-string, help-substitute-command-keys (Emacs 23+).
;; describe-(mode|variable|function-1|keymap) for Emacs 23+:
;; Use help-documentation (with insert and button arg), instead of documentation (with princ).
;; 2011/06/22 dadams
;; Info-make-manuals-xref: Added optional arg MANUALS.
;; 2011/06/20 dadams
;; Info(-any)-index-occurrences(-p): Fix pattern: remove arbitrary prefix [^\n]*.
;; Added, for Emacs 24+: describe-package.
;; 2011/06/14 dadams
;; Added, for Emacs 23.2+: describe-mode.
;; Info-make-manuals-xref: Added optional arg NO-NEWLINES-AFTER-P.
;; 2011/06/13 dadams
;; Added: Info-any-index-occurrences-p.
;; Info-make-manuals-xref: Use Info-any-index-occurrences-p, not Info-index-occurrences.
;; 2011/06/11 dadams
;; Added, for Emacs 23.2+:
;; describe-face, describe-function-1, help-cross-reference-manuals, Info-indexed-find-file,
;; Info-indexed-find-node, Info-index-entries-across-manuals, Info-index-occurrences,
;; Info-make-manuals-xref, Info-indexed-file, Info-indexed-nodes.
;; describe-keymap: Emacs 23.2+: Added link to manuals.
;; describe-variable: Updated Emacs 23 version, per vanilla.
;; Emacs 23.2+: Added link to manuals.
;; Require info.el for Emacs 23.2+.
;; 2011/04/25 dadams
;; describe-file: Incorporate autofile bookmark description. Added optional arg.
;; 2011/03/31 dadams
;; help-var-(matches|inherits)-type-p: Wrap string-match with save-match-data.
;; 2011/03/17 dadams
;; describe-file: Added clickable thumbnail image to the help for an image file.
;; 2011/03/02 dadams
;; Added: help-all-exif-data
;; describe-file: Show all EXIF data, using help-all-exif-data.
;; 2011/02/22 dadams
;; describe-file: Show also EXIF data for an image file.
;; 2011/01/04 dadams
;; Removed autoload cookies from non def* sexps and define-key.
;; 2010/02/12 dadams
;; Added variable-name-history.
;; 2009/08/30 dadams
;; describe-keymap: Don't print nil if the map has no doc.
;; 2009/05/26 dadams
;; describe-variable: Updated wrt latest Emacs 23:
;; Added file-name-non-directory; removed substitute-command-keys.
;; 2008/09/13 dadams
;; Updated for latest Emacs 23 CVS.
;; describe-variable: Create separate version for Emacs 23.
;; describe-function-1: No longer needed for Emacs 23, since my patch added.
;; Added: with-selected-frame, with-help-window, at least temporarily.
;; Require wid-edit.el.
;; 2008/09/02 dadams
;; describe-function-1, describe-variable:
;; Emacs 23 uses find-lisp-object-file-name. Thx to Per Nordlow.
;; 2008/08/19 dadams
;; describe-keymap: Use insert instead of princ for map part. Thx to Chong Yidong.
;; 2008/05/20 dadams
;; describe-function: Different prompt if prefix arg.
;; 2008/03/02 dadams
;; Moved describe-file here from misc-cmds.el. Bound to C-h M-f.
;; Require cl.el at compile time.
;; 2008/02/01 dadams
;; Bound M-l to find-function-on-key.
;; 2008/01/03 dadams
;; Added: describe-function-1. The redefinition fills overlong lines.
;; 2007/12/25 dadams
;; help-var-inherits-type-p:
;; Recheck var-type match after set var-type to its car.
;; Handle string (regexp) TYPES elements.
;; help-value-satisfies-type-p: Skip type check for string type (regexp).
;; help-var-is-of-type-p: Doc string. Use help-var-matches-type-p.
;; Added: help-var-matches-type-p.
;; 2007/12/24 dadams
;; help-var-inherits-type-p: Recheck type match after set var-type to its car.
;; Added: help-custom-type.
;; 2007/12/23 dadams
;; help-var-is-of-type-p:
;; Added MODE arg. Use help-var-inherits-type-p, help-var-val-satisfies-type-p.
;; Redefined as MODE choice, not just a simple or. Treat more cases.
;; Added: help-var-inherits-type-p, help-var-val-satisfies-type-p,
;; help-value-satisfies-type-p.
;; describe-option-of-type: Prefix arg means use mode inherit-or-value.
;; 2007/12/22 dadams
;; help-var-is-of-type-p:
;; Check supertypes also. Use both :validate and :match.
;; Wrap type check in condition-case. Use widget-put instead of plist-put.
;; Added soft require of wid-edit+.el.
;; 2007/12/21 dadams
;; help-var-is-of-type-p: Use :validate, not :match, for the test.
;; 2007/12/20 dadams
;; Moved describe-option-of-type to C-h C-o.
;; 2007/12/15 dadams
;; Bound C-h c to describe-command and C-h C-c to describe-key-briefly.
;; 2007/12/07 dadams
;; describe-option-of-type:
;; Call describe-variable with nil buffer. Use "nil" as default value.
;; 2007/12/06 dadams
;; describe-option-of-type:
;; If nil type, all defcustom vars are candidates. Use custom-variable-p.
;; Specific error if no such custom type.
;; 2007/12/04 dadams
;; Added: describe-option-of-type, help-remove-duplicates, help-var-is-of-type-p.
;; Bound o to describe-option, M-o to describe-option-of-type,
;; C-c to describe-command, M-c to describe-copying.
;; 2007/11/28 dadams
;; Renamed describe-bindings-in-map to describe-keymap. Added keymap's doc string.
;; 2007/11/22 dadams
;; Added: describe-bindings-in-map. Bound to C-h M-k.
;; 2007/11/01 dadams
;; Corrected require typo: help-mode -> help-fns.
;; 2007/10/18 dadams
;; Created.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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, 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; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(require 'help-fns)
(require 'wid-edit+ nil t) ;; (no error if not found):
;; redefined color widget (for help-var-is-of-type-p)
(require 'wid-edit) ;; widget-convert
(require 'naked nil t) ;; (no error if not found): naked-key-description
(when (or (> emacs-major-version 23) (and (= emacs-major-version 23) (> emacs-minor-version 1)))
(require 'info)) ;; Info-virtual-files
(eval-when-compile (require 'cl)) ;; case
;; Quiet the byte-compiler.
(defvar advertised-signature-table)
(defvar dir-local-variables-alist)
(defvar dir-locals-file)
(defvar file-local-variables-alist)
(defvar Info-indexed-nodes) ; In `info.el'
(defvar help-cross-reference-manuals) ; For Emacs < 23.2
(defvar help-enable-auto-load) ; For Emacs < 24.3
(defvar package-alist)
(defvar package-archive-contents)
(defvar package--builtins)
(defvar package--initialized)
;;;;;;;;;;;;;;;;;;;;;;;;
(defvar variable-name-history () "Minibuffer history for variable names.")
(define-key help-map "B" 'describe-buffer)
(define-key help-map "c" 'describe-command)
(define-key help-map "o" 'describe-option)
(define-key help-map "\C-c" 'describe-key-briefly)
(define-key help-map "\C-o" 'describe-option-of-type)
(define-key help-map "\M-c" 'describe-copying)
(define-key help-map "\M-f" 'describe-file)
(define-key help-map "\M-k" 'describe-keymap)
(define-key help-map "\M-l" 'find-function-on-key)
;; Need Emacs 23 for version of `make-text-button' that accepts a string.
(when (> emacs-major-version 22)
(defun help-documentation (function &optional raw add-help-buttons)
"Same as `documentation', but optionally adds buttons for help.
Non-nil optional arg ADD-HELP-BUTTONS does that, adding buttons to key
descriptions, which link to the key's command help."
(let ((raw-doc (documentation function 'RAW)))
(if raw raw-doc (help-substitute-command-keys raw-doc add-help-buttons))))
(defun help-documentation-property (symbol prop &optional raw add-help-buttons)
"Same as `documentation-property', but optionally adds buttons for help.
Non-nil optional arg ADD-HELP-BUTTONS does that, adding buttons to key
descriptions, which link to the key's command help."
(let ((raw-doc (documentation-property symbol prop 'RAW)))
(if raw raw-doc (help-substitute-command-keys raw-doc add-help-buttons))))
(defun help-commands-to-key-buttons (string)
"Like `substitute-command-keys', but adds buttons for help on keys.
Key descriptions become links to help about their commands."
(help-substitute-command-keys string 'ADD-HELP-BUTTONS))
(defun help-substitute-command-keys (string &optional add-help-buttons)
"Same as `substitute-command-keys', but optionally adds buttons for help.
Non-nil optional arg ADD-HELP-BUTTONS does that, adding buttons to key
descriptions, which link to the key's command help."
;; REPEAT:
;; Search for first occurrence of any of the patterns: \[...], \{...}, or \<...>.
;; Handle escaping via \=, if present before the pattern or if there is no pattern match.
;; If pattern is a keymap (\<...>): use it from then on.
;; If pattern is a command (\[...]): (a) substitute its key description, (b) put a button on it.
;; If pattern is a bindings spec (\{...}): just substitute the usual text.
(with-syntax-table emacs-lisp-mode-syntax-table
(let* ((strg (copy-sequence string))
(len-strg (length strg))
(ii 0)
(jj 0)
(newstrg "")
(re-command "\\\\\\[\\(\\(\\sw\\|\\s_\\)+\\)\\]")
(re-keymap "\\\\<\\(\\(\\sw\\|\\s_\\)+\\)>")
(re-bindings "\\\\{\\(\\(\\sw\\|\\s_\\)+\\)}")
(re-any (concat "\\(" re-command "\\|" re-keymap "\\|" re-bindings "\\)"))
(keymap (or overriding-terminal-local-map overriding-local-map))
(msg nil)
key bindings ma mc mk mb)
(while (< ii len-strg)
(setq key nil
bindings nil
strg (substring strg ii))
(save-match-data ; ANY
(setq ma (string-match re-any strg))
(cond ((not ma) ; No \[...], \{...}, or \<...>, but we need to handle \=
(setq jj 0
newstrg (concat newstrg (replace-regexp-in-string
"\\\\=\\(.\\)" "\\1" strg nil nil nil jj)))
(when (match-beginning 1) (setq jj (match-beginning 1)))
(setq ii len-strg))
(t
(let ((escaped nil)
(odd nil))
(save-match-data
(let ((ma1 ma))
(setq ii ma)
(while (string-match "\\\\=$" (substring strg 0 ma1))
(setq odd (not odd)
ma1 (match-beginning 0))
(when odd
(setq ii (- ii 2)
escaped ma1)))))
(if (not escaped)
(setq ii ma
jj (match-end 0)
ma (match-string-no-properties 0 strg)
newstrg (concat newstrg (substring strg 0 ii)))
(setq jj (match-end 0) ; End of \[...], \{...}, or \<...>
newstrg (if odd
(concat newstrg
(substring strg 0 ii) ; Unescaped \='s
(substring strg ma jj)) ; \[...], \{...}, or \<...>
(concat newstrg (substring strg 0 ii)))
ma (if odd nil (match-string-no-properties 0 strg))
ii jj))))))
(when ma
(save-match-data ; KEYMAP
(setq ma (copy-sequence ma))
(setq mk (string-match re-keymap ma))
(setq mk (and mk (match-string-no-properties 0 ma)))
(when mk
(setq keymap (intern (match-string-no-properties 1 ma)))
(if (boundp keymap)
(setq keymap (symbol-value keymap))
(setq msg (format "\nUses keymap \"%s\", which is not currently defined.\n"
keymap))
(setq keymap (or overriding-terminal-local-map overriding-local-map)))))
(unless mk ; COMMAND
(save-match-data
(setq ma (copy-sequence ma))
(setq mc (string-match re-command ma))
(setq mc (and mc (match-string-no-properties 0 ma)))
(setq mc (and mc (intern (substring mc 2 -1)))) ; Remove \[...] envelope
(when mc
(let ((follow-remap t))
(while (and (setq key (where-is-internal mc keymap 'FIRSTONLY))
(vectorp key) (> (length key) 1) (eq 'remap (aref key 0))
(symbolp (aref key 1)) follow-remap)
(setq mc (aref key 1)
follow-remap nil)))
(setq key (if key
(if (fboundp 'naked-key-description)
(naked-key-description key)
(key-description key))
(concat "M-x " (symbol-name mc))))
(when add-help-buttons (setq key (help-key-button-string key mc))))))
(unless (or mk mc) ; BINDINGS
(save-match-data
(setq ma (copy-sequence ma))
(setq mb (string-match re-bindings ma))
(setq mb (and mb (match-string-no-properties 0 ma)))
(when mb
(setq bindings (intern (match-string-no-properties 1 ma)))
(cond ((boundp bindings)
(setq bindings (substitute-command-keys mb))) ; Use original - no buttons.
(t
(setq msg (format "\nUses keymap \"%s\", which is not currently defined.\n"
bindings))
(setq bindings nil))))))
(unless mk
(setq newstrg (concat newstrg (or key bindings (substring strg ii jj)))))
(setq ii (or jj len-strg))))
(if (string= string newstrg)
string ; Return original string, not a copy, if no changes.
newstrg))))
(defun help-key-button-string (key-description command)
"Return a button for KEY-DESCRIPTION that links to the COMMAND description.
KEY-DESCRIPTION is a key-description string.
COMMAND is the command (a symbol) associated with the key described.
Return a copy of string KEY-DESCRIPTION with button properties added.
Clicking the button shows the help for COMMAND."
(let ((new-key (copy-sequence key-description)))
(make-text-button new-key nil 'button (list t) ':type 'help-function 'help-args (list command))
new-key)))
(when (boundp 'Info-virtual-files) ; Emacs 23.2+
(defcustom help-cross-reference-manuals '(("emacs" "elisp"))
"*Manuals to search, for a `*Help*' buffer link to the manuals.
A cons.
The car is a list of manuals to search, or the symbol `all', to
search all. If nil, then do not create a cross-reference link.
The cdr is a boolean:
Non-`nil' means search the manuals, then create a cross-ref link:
create it only if some search hits are found.
`nil' means create a cross-ref link without searching manuals
first (but only if there are some manuals to search)."
:set #'(lambda (sym defs) (custom-set-default sym defs) (setq Info-indexed-nodes ()))
:type '(cons
(choice :tag "Which Manuals"
(repeat :tag "Specific Manuals (files)" string)
(const :tag "All Manuals" all))
(boolean :tag "Search Before Creating Button?"))
:group 'help)
(defvar Info-indexed-file "*Indexed*"
"Info file for virtual manual from `Info-index-entries-across-manuals'.")
(defvar Info-indexed-nodes ()
"Alist of cached nodes with matching index entries.
Each element is (NODENAME STRING MATCHES), where:
NODENAME is the name of the node that is indexed,
STRING is the search string passed to `Info-index-occurrences',
MATCHES is a list of index matches found by `Info-index-occurrences'.
This has the same structure as `Info-apropos-nodes', but the search
was made by `Info-index-occurrences', not by `Info-apropos-matches',
so that matches are exact (ignoring case).")
(defun Info-indexed-find-file (filename &optional _noerror)
"Index-search implementation of `Info-find-file'."
filename)
(defun Info-indexed-find-node (_filename nodename &optional _no-going-back)
"Index-search implementation of `Info-find-node-2'."
(let* ((nodeinfo (assoc nodename Info-indexed-nodes))
(matches (nth 2 nodeinfo)))
(when matches
(insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" Info-indexed-file nodename))
(insert "Index Matches\n")
(insert "*************\n\n")
(insert "Index entries that match `" (nth 1 nodeinfo) "':\n\n")
(insert "\0\b[index\0\b]\n")
(if (eq matches t)
(insert "No matches found.\n")
(insert "* Menu:\n\n")
(dolist (entry matches)
(insert (format "* %-38s (%s)%s.%s\n" (format "%s [%s]:" (nth 1 entry) (nth 0 entry))
(nth 0 entry) (nth 2 entry)
(if (nth 3 entry) (format " (line %s)" (nth 3 entry)) ""))))))))
(add-to-list 'Info-virtual-files '("\\`\\*Indexed\\*\\'"
(find-file . Info-indexed-find-file)
(find-node . Info-indexed-find-node)
;; (slow . t) ; $$$$$$ Useless here?
))
(defun Info-make-manuals-xref (object &optional no-newlines-after-p manuals-spec nomsg)
"Create a cross-ref link for index entries for OBJECT in manuals.
Non-`nil' optional arg NO-NEWLINES-AFTER-P means do not add two
newlines after the cross reference.
Optional arg MANUALS-SPEC controls which manuals to search. It has
the same form as option `help-cross-reference-manuals', and it
defaults to the value of that option.
Do nothing if the car of MANUALS-SPEC is nil (no manuals to search).
If its cdr is `nil' then create the link without first searching any
manuals. Otherwise, create the link only if there are search hits in
the manuals."
(when (or (stringp object) (symbolp object)) ; Exclude, e.g., a keymap as OBJECT.
(unless manuals-spec (setq manuals-spec help-cross-reference-manuals))
(when (car manuals-spec) ; Create no link if no manuals to search.
(let ((books (car manuals-spec))
(search-now-p (cdr manuals-spec))
(symb-name (if (stringp object) object (symbol-name object))))
(when (or (not search-now-p)
(save-current-buffer (Info-first-index-occurrence symb-name () books nomsg)))
(let ((buffer-read-only nil))
(insert (format "\n\nFor more information %s the "
(if (cdr manuals-spec) "see" "check")))
(help-insert-xref-button "manuals" 'help-info-manual-lookup symb-name () books)
(insert ".")
(unless no-newlines-after-p (insert "\n\n"))))))))
(when (and (> emacs-major-version 21)
(condition-case nil (require 'help-mode nil t) (error nil))
(get 'help-xref 'button-category-symbol)) ; In `button.el'
(define-button-type 'help-info-manual-lookup
:supertype 'help-xref
'help-function #'(lambda (string &optional index-nodes books nomsg)
(Info-index-entries-across-manuals string () books nomsg))
'help-echo "mouse-2, RET: Look it up in the manuals"))
(defun Info-index-entries-across-manuals (string &optional index-nodes manuals nomsg)
"Look up STRING in Info MANUALS on your system.
Looks for exact matches (ignoring case): STRING is expected to be an
index entry. Build an Info menu of the possible matches.
Optional arg INDEX-NODES are the index nodes in MANUALS to search.
By default (nil value), all indexes are searched.
Optional arg MANUALS is the list of manuals to search, or the symbol
`all', to search all.
Optional arg NOMSG non-nil means do not display a progress message."
(let ((nodes Info-indexed-nodes)
nodename)
(while (and nodes (not (equal string (nth 1 (car nodes))))) (setq nodes (cdr nodes)))
(if nodes
(Info-find-node Info-indexed-file (car (car nodes)))
(setq nodename (format "Index for `%s'" string))
(push (list nodename string (Info-index-occurrences string index-nodes manuals nomsg))
Info-indexed-nodes)
(Info-find-node Info-indexed-file nodename))))
;; Similar to `Info-apropos-matches', but using exact matches (ignoring case).
(defun Info-index-occurrences (index-entry &optional index-nodes manuals nomsg)
"Collect occurrences of INDEX-ENTRY in INDEX-NODES of MANUALS.
Return a list of the form ((FILE INDEX-ENTRY NODE LINE) ...), where:
FILE is the name of an Info file,
NODE is an Info node name,
LINE is the line number of the INDEX-ENTRY occurrence in that node.
Optional arg INDEX-NODES are the index nodes in MANUALS to search.
By default (nil value), search all indexes of each manual.
Optional arg MANUALS is the list of manuals to search, or the symbol
`all', to search all.
Optional arg NOMSG non-nil means do not display a progress message."
(unless (string= index-entry "")
;; Unlike `Info-apropos-matches', we match only the exact string as an index entry.
(let ((pattern (format "\n\\* +\\(%s\\):[ \t]+\\([^\n]+\\)\
\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?"
(regexp-quote index-entry)))
matches node)
(unless nomsg
(message "Searching indexes of %s..."
(cond ((eq manuals 'all) "all manuals")
((null (cadr manuals)) (concat (car manuals) " manual"))
(t (concat "manuals " (mapconcat #'identity manuals ", "))))))
(condition-case nil
(with-temp-buffer
(when (eq manuals 'all) (setq manuals ()))
(Info-mode)
;; Next two lines are essentially `(Info-directory)'.
(info-initialize)
(Info-find-node-2 "dir" "top" 'NO-GOING-BACK)
(unless manuals
(goto-char (point-min))
(re-search-forward "\\* Menu: *\n" nil t)
(let (manual)
(while (re-search-forward "\\*.*: *(\\([^)]+\\))" nil t)
;; `add-to-list' ensures no dups in `manuals', so the `dolist' runs faster.
(setq manual (match-string 1))
(set-text-properties 0 (length manual) nil manual)
(add-to-list 'manuals manual))))
(dolist (manual manuals)
(unless nomsg (message "Searching indexes of manual `%s'..." manual))
(when (or index-nodes
(setq index-nodes (Info-index-nodes (Info-find-file manual))))
(Info-find-node manual (car index-nodes))
(while (progn (goto-char (point-min))
(while (re-search-forward pattern nil t)
(setq matches (cons (list manual
(match-string-no-properties 1)
(match-string-no-properties 2)
(match-string-no-properties 3))
matches)))
(setq index-nodes (cdr index-nodes)
node (car index-nodes)))
(Info-goto-node node)))))
(error nil))
matches)))
;; Like `Info-index-occurrences', but return only the first occurrence found.
(defun Info-first-index-occurrence (index-entry &optional index-nodes manuals nomsg)
"Return nil or an occurrence of INDEX-ENTRY in INDEX-NODES of MANUALS.
Search INDEX-NODES and MANUALS in order.
A non-nil return value is the first first successful index lookup, in
the form (FILE INDEX-ENTRY NODE LINE) - see `Info-index-occurrences'.
Optional arg INDEX-NODES are the index nodes of MANUALS to search.
By default (nil value), search all indexes of each manual.
Optional arg MANUALS is the list of manuals to search, or the symbol
`all', to search all.
Optional arg NOMSG non-nil means do not display a progress message."
(and (not (string= index-entry ""))
;; Unlike `Info-apropos-matches', we match only the exact string as an index entry.
(let ((pattern (format "\n\\* +\\(%s\\):[ \t]+\\([^\n]+\\)\
\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?"
(regexp-quote index-entry)))
(found nil)
node)
(unless nomsg
(message "Searching indexes of %s..."
(cond ((eq manuals 'all) "all manuals")
((null (cadr manuals)) (concat (car manuals) " manual"))
(t (concat "manuals " (mapconcat #'identity manuals ", "))))))
(condition-case nil
(with-temp-buffer
(when (eq manuals 'all) (setq manuals ()))
(Info-mode)
;; Next two lines are essentially `(Info-directory)'.
(info-initialize)
(Info-find-node-2 "dir" "top" 'NO-GOING-BACK)
(unless manuals
(goto-char (point-min))
(re-search-forward "\\* Menu: *\n" nil t)
(let (manual)
(while (re-search-forward "\\*.*: *(\\([^)]+\\))" nil t)
;; `add-to-list' ensures no dups in `manuals', so the `dolist' runs faster.
(setq manual (match-string 1))
(set-text-properties 0 (length manual) nil manual)
(add-to-list 'manuals manual))))
(setq found (catch 'Info-first-index-occurrence
(dolist (manual manuals)
(unless nomsg
(message "Searching indexes of manual `%s'..." manual))
(when (or index-nodes
(setq index-nodes (Info-index-nodes
(Info-find-file manual))))
(Info-find-node manual (car index-nodes))
(while (progn (goto-char (point-min))
(when (re-search-forward pattern nil t)
(throw 'Info-first-index-occurrence
(list manual
(match-string-no-properties 1)
(match-string-no-properties 2)
(match-string-no-properties 3))))
(setq index-nodes (cdr index-nodes)
node (car index-nodes)))
(Info-goto-node node))))
nil)))
(error nil))
found)))
(defun describe-buffer (&optional buffer-name) ; Bound to `C-h B'
"Describe the existing buffer named BUFFER-NAME.
The description includes the information provided by `describe-mode'.
By default, describe the current buffer."
;; (interactive "bDescribe buffer: ")
(interactive "@")
(unless buffer-name (setq buffer-name (buffer-name)))
(help-setup-xref `(describe-buffer ,buffer-name) (interactive-p))
(let ((buf (get-buffer buffer-name)))
(unless (and buf (buffer-live-p buf)) (error(format "No such live buffer `%s'" buffer-name)))
(let* ((file (or (buffer-file-name buf)
(with-current-buffer buf
(and (eq major-mode 'dired-mode) default-directory))))
(help-text (concat
(format "Buffer `%s'\n%s\n\n" buffer-name (make-string
(+ 9 (length buffer-name)) ?-))
(and file (format "File/directory:\t%s\n" file))
(format "Mode:\t\t%s\n"
(with-current-buffer buf (format-mode-line mode-name)))
(format "Size in chars:\t%g\n" (buffer-size buf))
(with-current-buffer buf
(if (not buffer-display-time)
"Never displayed\n"
(format "Last displayed:\t%s\n"
(format-time-string
;; Could use this, for short format: "%02H:%02M:%02S"
;; Or this, for a bit longer: "%_3a %_2l:%02M:%02S %_2p"
"%a %b %e %T %Y (%z)"
buffer-display-time))))
(format "Modified:\t%s\n" (if (buffer-modified-p buf)"yes" "no"))
(with-current-buffer buf
(format "Read-only:\t%s\n\n\n" (if buffer-read-only "yes" "no"))))))
(with-help-window (help-buffer)
(describe-mode-1 buf))
(with-current-buffer (help-buffer)
(let ((inhibit-read-only t))
(goto-char (point-min))
(insert help-text))))))
;; REPLACE ORIGINAL
;;
;; Use `describe-mode-1', which is different from the original `describe-mode' in these ways:
;;
;; 1. Call `Info-make-manuals-xref' to create a cross-ref link to manuals.
;; 2. Add key-description buttons to command help. Use `insert', not `princ'.
;;
(defun describe-mode (&optional buffer)
"Display documentation of current major mode and minor modes.
A brief summary of the minor modes comes first, followed by the
major mode description. This is followed by detailed
descriptions of the minor modes, each on a separate page.
For this to work correctly for a minor mode, the mode's indicator
variable \(listed in `minor-mode-alist') must also be a function
whose documentation describes the minor mode."
(interactive "@")
(unless buffer (setq buffer (current-buffer)))
(help-setup-xref (list #'describe-mode buffer) (called-interactively-p 'interactive))
(with-help-window (help-buffer) (describe-mode-1 buffer))
nil) ; For the sake of IELM and maybe others
(defun describe-mode-1 (buffer)
"Helper for `describe-mode'.
Does everything except create the help window and set up the
back/forward buttons, so you can use this in other help commands that
have their own back/forward buttons."
;; For the sake of `help-do-xref' and `help-xref-go-back', do not switch buffers
;; before calling `help-buffer'.
(with-current-buffer buffer
(let (minor-modes)
;; Older packages do not register in minor-mode-list but only in `minor-mode-alist'.
(dolist (x minor-mode-alist)
(setq x (car x))
(unless (memq x minor-mode-list) (push x minor-mode-list)))
(dolist (mode minor-mode-list) ; Find enabled minor mode we will want to mention.
;; Document minor mode if listed in `minor-mode-alist', non-nil, and has a function def.
(let ((fmode (or (get mode :minor-mode-function) mode)))
(and (boundp mode) (symbol-value mode) (fboundp fmode)
(let ((pretty-minor-mode (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
(symbol-name fmode))
(capitalize (substring (symbol-name fmode)
0 (match-beginning 0)))
fmode)))
(push (list fmode pretty-minor-mode
(format-mode-line (assq mode minor-mode-alist)))
minor-modes)))))
(setq minor-modes (sort minor-modes (lambda (a b) (string-lessp (cadr a) (cadr b)))))
(when minor-modes
(princ "Enabled minor modes:\n")
(make-local-variable 'help-button-cache)
(with-current-buffer standard-output
(dolist (mode minor-modes)
(let ((mode-function (nth 0 mode))
(pretty-minor-mode (nth 1 mode))
(indicator (nth 2 mode)))
(add-text-properties 0 (length pretty-minor-mode) '(face bold) pretty-minor-mode)
(save-excursion
(goto-char (point-max))
(princ "\n\f\n")
(push (point-marker) help-button-cache)
;; Document the minor modes fully.
(insert pretty-minor-mode)
(princ (format " minor mode (%s):\n" (if (zerop (length indicator))
"no indicator"
(format "indicator%s" indicator))))
(with-current-buffer standard-output
(insert (help-documentation mode-function nil 'ADD-HELP-BUTTONS)))
(Info-make-manuals-xref mode-function t nil (not (interactive-p)))) ; Link manuals.
(insert-button pretty-minor-mode 'action (car help-button-cache)
'follow-link t 'help-echo "mouse-2, RET: show full information")
(newline)))
(forward-line -1)
(fill-paragraph nil)
(forward-line 1))
(princ "\n(Information about these minor modes follows the major mode info.)\n\n"))
(let ((mode mode-name)) ; Document the major mode.
(with-current-buffer standard-output
(let ((start (point)))
(insert (format-mode-line mode nil nil buffer))
(add-text-properties start (point) '(face bold)))))
(princ " mode")
(let* ((mode major-mode)
(file-name (find-lisp-object-file-name mode nil)))
(when file-name
(princ (concat " defined in `" (file-name-nondirectory file-name) "'"))
(with-current-buffer standard-output ; Make a hyperlink to the library.
(save-excursion (re-search-backward "`\\([^`']+\\)'" nil t)
(help-xref-button 1 'help-function-def mode file-name)))))
(princ ":\n")
(let* ((maj major-mode)
(maj-doc (help-documentation maj nil 'ADD-HELP-BUTTONS)))
(with-current-buffer standard-output
(insert maj-doc)
(Info-make-manuals-xref maj t nil (not (interactive-p)))))))) ; Link to manuals.
)
;; REPLACE ORIGINAL in `help-fns.el':
;;
;; 1. Preferred candidate is `symbol-nearest-point'.
;; 2. With a prefix argument, candidates are commands only.
;; 3. No no-function message if not called interactively.
;;
;;;###autoload
(defun describe-function (function &optional commandp)
"Display the full documentation of FUNCTION (a symbol).
FUNCTION names an Emacs Lisp function, possibly a user command.
With a prefix argument, candidates are commands (interactive) only.
Default candidate is: preferably the `symbol-nearest-point', or else
the innermost function call surrounding point
\(`function-called-at-point').
Return the description that was displayed, as a string."
(interactive
(let ((fn (or (and (fboundp 'symbol-nearest-point)
(symbol-nearest-point))
(function-called-at-point)))
(enable-recursive-minibuffers t)
val)
(setq val (completing-read (if current-prefix-arg "Describe command: " "Describe function: ")
obarray (if current-prefix-arg 'commandp 'fboundp) t nil nil
(and fn (symbol-name fn))))
(list (if (equal val "") fn (intern val)) current-prefix-arg)))
(if (not function)
(when (interactive-p) (message "You did not specify a function"))
(unless (or (not commandp) (commandp function))
(error "Not a defined Emacs command (interactive function): `%s'" function))
;;$$$ (unless (fboundp function) (error "Not a defined Emacs function: `%s'" function))
(help-setup-xref (list #'describe-function function) (interactive-p))
(save-excursion
(with-output-to-temp-buffer (help-buffer)
(prin1 function)
;; Use " is " instead of ": " so it is easier to get the function name using `forward-sexp'.
(princ " is ")
(describe-function-1 function)
(print-help-return-message)
(with-current-buffer standard-output (buffer-string)))))) ; Return help text.
;; REPLACE ORIGINAL in `help-fns.el' (`help.el', for Emacs < 22):
;;
;; Fill long lines. Add `,' before "which".
;;
(when (< emacs-major-version 23)
(defun describe-function-1 (function)
(let* ((def (if (symbolp function) (symbol-function function) function))
(beg (if (commandp def) "an interactive " "a "))
(pt1 (with-current-buffer (help-buffer) (point)))
file-name string)
(setq string (cond ((or (stringp def) (vectorp def)) "a keyboard macro")
((subrp def) (if (eq 'unevalled (cdr (subr-arity def)))
(concat beg "special form")
(concat beg "built-in function")))
((byte-code-function-p def) (concat beg "compiled Lisp function"))
((symbolp def)
(while (symbolp (symbol-function def))
(setq def (symbol-function def)))
(format "an alias for `%s'" def))
((eq (car-safe def) 'lambda) (concat beg "Lisp function"))
((eq (car-safe def) 'macro) "a Lisp macro")
((eq (car-safe def) 'autoload)
(setq file-name (nth 1 def))
(format "%s autoloaded %s" (if (commandp def) "an interactive" "an")
(if (eq (nth 4 def) 'keymap)
"keymap"
(if (nth 4 def) "Lisp macro" "Lisp function"))))
((keymapp def)
(let ((is-full nil)
(elts (cdr-safe def)))
(while elts
(when (char-table-p (car-safe elts))
(setq is-full t
elts ()))
(setq elts (cdr-safe elts)))
(if is-full "a full keymap" "a sparse keymap")))
(t "")))
(princ string)
(with-current-buffer standard-output
(save-excursion (save-match-data (when (re-search-backward "alias for `\\([^`']+\\)'" nil t)
(help-xref-button 1 'help-function def)))))
(unless file-name (setq file-name (symbol-file function 'defun)))
(setq file-name (describe-simplify-lib-file-name file-name))
(when (equal file-name "loaddefs.el")
;; Find the real def site of the preloaded function. This is necessary only for defaliases.
(let ((location (condition-case nil
(find-function-search-for-symbol function nil "loaddefs.el")
(error nil))))
(when location
(with-current-buffer (car location)
(goto-char (cdr location))
(when (re-search-backward "^;;; Generated autoloads from \\(.*\\)" nil t)
(setq file-name (match-string 1)))))))
(when (and (null file-name) (subrp def)) ; Find the C source file name.
(setq file-name (if (get-buffer " *DOC*") (help-C-file-name def 'subr) 'C-source)))
(when file-name
(princ " in `")
;; We used to add `.el' to file name, but that's wrong when the user used `load-file'.
(princ (if (eq file-name 'C-source) "C source code" file-name))
(princ "'")
(with-current-buffer standard-output ; Make a hyperlink to the library.
(save-excursion (re-search-backward "`\\([^`']+\\)'" nil t)
(help-xref-button 1 'help-function-def function file-name))))
(princ ".")
(with-current-buffer (help-buffer)
(fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point)) (point)))
(terpri)(terpri)
(when (commandp function)
(let ((pt2 (with-current-buffer (help-buffer) (point))))
(if (and (eq function 'self-insert-command)
(eq (key-binding "a") 'self-insert-command)
(eq (key-binding "b") 'self-insert-command)
(eq (key-binding "c") 'self-insert-command))
(princ "It is bound to many ordinary text characters.\n")
(let* ((remapped (command-remapping function))
(keys (where-is-internal
(or remapped function) overriding-local-map nil nil))
non-modified-keys)
(dolist (key keys) ; Which non-control non-meta keys run this command?
(when (member (event-modifiers (aref key 0)) '(nil (shift)))
(push key non-modified-keys)))
(when remapped
(princ "It is remapped to `") (princ (symbol-name remapped)) (princ "'"))
(when keys
(princ (if remapped ", which is bound to " "It is bound to "))
;; If lots of ordinary text characters run this command, don't mention them one by one.
(if (< (length non-modified-keys) 10)
(princ (mapconcat (if (fboundp 'naked-key-description)