|
|
1.1 root 1: ;; Generate key binding summary for Emacs
2: ;; Copyright (C) 1985 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is free software; you can redistribute it and/or modify
7: ;; it under the terms of the GNU General Public License as published by
8: ;; the Free Software Foundation; either version 1, or (at your option)
9: ;; any later version.
10:
11: ;; GNU Emacs is distributed in the hope that it will be useful,
12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: ;; GNU General Public License for more details.
15:
16: ;; You should have received a copy of the GNU General Public License
17: ;; along with GNU Emacs; see the file COPYING. If not, write to
18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19:
20:
21: (defun make-command-summary ()
22: "Make a summary of current key bindings in the buffer *Summary*.
23: Previous contents of that buffer are killed first."
24: (interactive)
25: (message "Making command summary...")
26: ;; This puts a description of bindings in a buffer called *Help*.
27: (save-window-excursion
28: (describe-bindings))
29: (with-output-to-temp-buffer "*Summary*"
30: (save-excursion
31: (let ((cur-mode mode-name))
32: (set-buffer standard-output)
33: (erase-buffer)
34: (insert-buffer-substring "*Help*")
35: (goto-char (point-min))
36: (delete-region (point) (progn (forward-line 1) (point)))
37: (while (search-forward " " nil t)
38: (replace-match " "))
39: (goto-char (point-min))
40: (while (search-forward "-@ " nil t)
41: (replace-match "-SP"))
42: (goto-char (point-min))
43: (while (search-forward " .. ~ " nil t)
44: (replace-match "SP .. ~"))
45: (goto-char (point-min))
46: (while (search-forward "C-?" nil t)
47: (replace-match "DEL"))
48: (goto-char (point-min))
49: (while (search-forward "C-i" nil t)
50: (replace-match "TAB"))
51: (goto-char (point-min))
52: (if (re-search-forward "^Local Bindings:" nil t)
53: (progn
54: (forward-char -1)
55: (insert " for " cur-mode " Mode")
56: (while (search-forward "??\n" nil t)
57: (delete-region (point)
58: (progn
59: (forward-line -1)
60: (point))))))
61: (goto-char (point-min))
62: (insert "Emacs command summary, " (substring (current-time-string) 0 10)
63: ".\n")
64: ;; Delete "key binding" and underlining of dashes.
65: (delete-region (point) (progn (forward-line 2) (point)))
66: (forward-line 1) ;Skip blank line
67: (while (not (eobp))
68: (let ((beg (point)))
69: (or (re-search-forward "^$" nil t)
70: (goto-char (point-max)))
71: (double-column beg (point))
72: (forward-line 1)))
73: (goto-char (point-min)))))
74: (message "Making command summary...done"))
75:
76: (defun double-column (start end)
77: (interactive "r")
78: (let (half cnt
79: line lines nlines
80: (from-end (- (point-max) end)))
81: (setq nlines (count-lines start end))
82: (if (<= nlines 1)
83: nil
84: (setq half (/ (1+ nlines) 2))
85: (goto-char start)
86: (save-excursion
87: (forward-line half)
88: (while (< half nlines)
89: (setq half (1+ half))
90: (setq line (buffer-substring (point) (save-excursion (end-of-line) (point))))
91: (setq lines (cons line lines))
92: (delete-region (point) (progn (forward-line 1) (point)))))
93: (setq lines (nreverse lines))
94: (while lines
95: (end-of-line)
96: (indent-to 41)
97: (insert (car lines))
98: (forward-line 1)
99: (setq lines (cdr lines))))
100: (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.