|
|
1.1 root 1: ;; Generate key binding summary for Emacs
2: ;; Copyright (C) 1985 Richard M. Stallman.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21:
22: (defun make-command-summary ()
23: "Make a summary of current key bindings in the buffer *Summary*.
24: Previous contents of that buffer are killed first."
25: (interactive)
26: (message "Making command summary...")
27: ;; This puts a description of bindings in a buffer called *Help*.
28: (save-window-excursion
29: (describe-bindings))
30: (with-output-to-temp-buffer "*Summary*"
31: (save-excursion
32: (let ((cur-mode mode-name))
33: (set-buffer standard-output)
34: (erase-buffer)
35: (insert-buffer-substring "*Help*")
36: (goto-char (point-min))
37: (delete-region (point) (progn (forward-line 1) (point)))
38: (while (search-forward " " nil t)
39: (replace-match " "))
40: (goto-char (point-min))
41: (while (search-forward "-@ " nil t)
42: (replace-match "-SP"))
43: (goto-char (point-min))
44: (while (search-forward " .. ~ " nil t)
45: (replace-match "SP .. ~"))
46: (goto-char (point-min))
47: (while (search-forward "C-?" nil t)
48: (replace-match "DEL"))
49: (goto-char (point-min))
50: (while (search-forward "C-i" nil t)
51: (replace-match "TAB"))
52: (goto-char (point-min))
53: (if (re-search-forward "^Local Bindings:" nil t)
54: (progn
55: (forward-char -1)
56: (insert " for " cur-mode " Mode")
57: (while (search-forward "??\n" nil t)
58: (delete-region (point)
59: (progn
60: (forward-line -1)
61: (point))))))
62: (goto-char (point-min))
63: (insert "Emacs command summary, " (substring (current-time-string) 0 10)
64: ".\n")
65: ;; Delete "key binding" and underlining of dashes.
66: (delete-region (point) (progn (forward-line 2) (point)))
67: (forward-line 1) ;Skip blank line
68: (while (not (eobp))
69: (let ((beg (point)))
70: (or (re-search-forward "^$" nil t)
71: (goto-char (point-max)))
72: (double-column beg (point))
73: (forward-line 1)))
74: (goto-char (point-min)))))
75: (message "Making command summary...done"))
76:
77: (defun double-column (start end)
78: (interactive "r")
79: (let (half cnt
80: line lines nlines
81: (from-end (- (point-max) end)))
82: (setq nlines (count-lines start end))
83: (if (<= nlines 1)
84: nil
85: (setq half (/ (1+ nlines) 2))
86: (goto-char start)
87: (save-excursion
88: (forward-line half)
89: (while (< half nlines)
90: (setq half (1+ half))
91: (setq line (buffer-substring (point) (save-excursion (end-of-line) (point))))
92: (setq lines (cons line lines))
93: (delete-region (point) (progn (forward-line 1) (point)))))
94: (setq lines (nreverse lines))
95: (while lines
96: (end-of-line)
97: (indent-to 41)
98: (insert (car lines))
99: (forward-line 1)
100: (setq lines (cdr lines))))
101: (goto-char (- (point-max) from-end))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.