|
24
|
1 ;; various hacks
|
|
|
2 ;; a compiled version exists!
|
|
|
3 ;; Last edited: Thu Oct 2 16:47:40 1986
|
|
|
4
|
|
|
5 (provide 'misc)
|
|
|
6
|
|
|
7 (defun
|
|
|
8 insert-time ()
|
|
|
9 (interactive)
|
|
|
10 (insert-string (current-time-string)))
|
|
|
11
|
|
|
12 (global-set-key "\et" 'insert-time)
|
|
|
13
|
|
|
14 (defun
|
|
|
15 note-edit ()
|
|
|
16 (interactive)
|
|
|
17 (beginning-of-buffer)
|
|
|
18 (if
|
|
|
19 (not (search-forward "Last edited: " nil t))
|
|
|
20 (progn (insert-string ";; Last edited: ")
|
|
|
21 (newline)
|
|
|
22 (forward-char -1))
|
|
|
23 (if (not (looking-at "\n"))
|
|
|
24 (kill-line)))
|
|
|
25 (insert-time))
|
|
|
26
|
|
|
27 (global-set-key "\em" 'note-edit)
|
|
|
28
|
|
|
29 (defun save-and-pause()
|
|
|
30 (interactive)
|
|
|
31 (save-some-buffers t)
|
|
|
32 (suspend-emacs))
|
|
|
33
|
|
|
34 (global-set-key "\C-x." 'save-and-pause)
|
|
|
35
|
|
|
36 (defun fix-comment-line ()
|
|
|
37 "split comment onto enough lines to avoid overflow"
|
|
|
38 (interactive)
|
|
|
39 (indent-for-comment)
|
|
|
40 (end-of-line)
|
|
|
41 (if (> (current-column) 79)
|
|
|
42 (progn
|
|
|
43 (while (> (current-column) 79)
|
|
|
44 (re-search-backward "[ ]"))
|
|
|
45 (indent-new-comment-line)
|
|
|
46 (end-of-line))))
|
|
|
47
|
|
|
48 (defun fix-all-comments ()
|
|
|
49 "iterate over file with fix-comment-line"
|
|
|
50 (interactive)
|
|
|
51 (while (search-forward ";" nil t)
|
|
|
52 (fix-comment-line)))
|
|
|
53
|
|
|
54 (global-set-key "\e:" 'fix-comment-line)
|
|
|
55
|
|
|
56 (defun grind-file ()
|
|
|
57 "grind all forms in a lisp file"
|
|
|
58 (interactive)
|
|
|
59 (beginning-of-buffer)
|
|
|
60 (while (re-search-forward "^(" nil t)
|
|
|
61 (beginning-of-line)
|
|
|
62 (indent-sexp)
|
|
|
63 (end-of-line)))
|
|
|
64
|
|
|
65 (defun suggest-breaks ()
|
|
|
66 "suggest line breaks to improve indentation"
|
|
|
67 (interactive)
|
|
|
68 (set-mark (point))
|
|
|
69 (message "Trying to add line breaks to over-long lines . . .")
|
|
|
70 (let (finished)
|
|
|
71 (while (not (or finished
|
|
|
72 (= (point)(point-max))))
|
|
|
73 (end-of-line)
|
|
|
74 (if (> (current-column) 79)
|
|
|
75 (let* ((left (progn (beginning-of-line)
|
|
|
76 (re-search-forward "[ ]*")
|
|
|
77 (current-column)))
|
|
|
78 (min-pt (point))
|
|
|
79 (target (min 69 (/ (+ 79 left) 2))))
|
|
|
80 (end-of-line)
|
|
|
81 (while (and (> (current-column) target)
|
|
|
82 (> (point) min-pt)
|
|
|
83 (search-backward " " nil t)))
|
|
|
84 (if (<= (point) min-pt)
|
|
|
85 (progn (goto-char min-pt)
|
|
|
86 (if (search-forward " " nil t)
|
|
|
87 (backward-char 1)
|
|
|
88 (message "losing %d %d %d" min-pt left target))))
|
|
|
89 (let ((help-form (quote
|
|
|
90 "y or <space> to break here,n or . or ! to stop, others interpreted"))
|
|
|
91 (re-probe t)
|
|
|
92 (char nil))
|
|
|
93 (while re-probe
|
|
|
94 (setq re-probe nil)
|
|
|
95 (setq char (read-char))
|
|
|
96 (cond ((or (= char ??)
|
|
|
97 (= char help-char))
|
|
|
98 (message help-form))
|
|
|
99 ((or (= char ?\ )
|
|
|
100 (= char ?y))
|
|
|
101 (while (looking-at " ")
|
|
|
102 (delete-char 1))
|
|
|
103 (newline-and-indent)
|
|
|
104 (message
|
|
|
105 "Trying to add line breaks to over-long lines . . ."))
|
|
|
106 ((or (= char ?n)
|
|
|
107 (= char ?\.)
|
|
|
108 (= char ?\!))
|
|
|
109 nil)
|
|
|
110 ((= char ?f)
|
|
|
111 (forward-char 1)
|
|
|
112 (search-forward " ")
|
|
|
113 (backward-char 1)
|
|
|
114 (setq re-probe t))
|
|
|
115 ((= char ?b)
|
|
|
116 (search-backward " ")
|
|
|
117 (setq re-probe t))
|
|
|
118 (t (setq unread-command-char char)
|
|
|
119 (setq finished t))))))
|
|
|
120 (forward-line)))
|
|
|
121 (message "Trying to add line breaks to over-long lines . . . done.")))
|
|
|
122
|
|
|
123 (defun set-left-margin ()
|
|
|
124 (interactive)
|
|
|
125 (if (and margin-stack
|
|
|
126 (< (current-column)(car margin-stack)))
|
|
|
127 (setq margin-stack nil)
|
|
|
128 (if (> (current-column) left-margin)
|
|
|
129 (setq margin-stack (cons left-margin margin-stack))))
|
|
|
130 (setq left-margin (current-column))
|
|
|
131 (set-fill-prefix))
|
|
|
132
|
|
|
133 (defun pop-left-margin ()
|
|
|
134 (interactive)
|
|
|
135 (if margin-stack
|
|
|
136 (progn (setq left-margin (car margin-stack))
|
|
|
137 (setq margin-stack (cdr margin-stack)))
|
|
|
138 (setq left-margin 0))
|
|
|
139 (move-to-column left-margin)
|
|
|
140 (set-fill-prefix))
|
|
|
141
|
|
42
|
142 (add-hook 'text-mode-hook
|
|
|
143 (lambda nil
|
|
|
144 (turn-on-auto-fill)
|
|
|
145 (abbrev-mode 1)
|
|
|
146 (local-set-key "\C-cl" 'set-left-margin)
|
|
|
147 (local-set-key "\C-cs" 'submerge-region)) t)
|
|
24
|
148
|
|
|
149 (global-set-key "\C-cp" 'pop-left-margin)
|
|
|
150
|
|
|
151 (make-variable-buffer-local 'margin-stack)
|
|
|
152 (set-default 'margin-stack nil)
|
|
|
153
|
|
|
154 (global-set-key "\^Xn" 'other-window) ; as per emacs - used to be narrow
|
|
|
155 (global-set-key "\^Xp" 'other-window-up) ; "
|
|
|
156
|
|
|
157 (defun other-window-up (n)
|
|
|
158 (interactive "p")
|
|
|
159 (other-window (- (or n 1))))
|
|
|
160
|
|
|
161 (defun minibuffer-electric-tilde ()
|
|
|
162 ;; by Stig@hackvan.com
|
|
|
163 (interactive)
|
|
|
164 (and (eq ?/ (preceding-char))
|
|
|
165 (delete-region (point-min) (point)))
|
|
|
166 (insert ?~))
|
|
|
167
|
|
|
168
|
|
|
169
|
|
|
170 ;; Created by: Joe Wells, jbw@cs.bu.edu
|
|
|
171 ;; Created on: Fri May 15 13:16:01 1992
|
|
|
172 ;; Last modified by: Joe Wells, jbw@csd
|
|
|
173 ;; Last modified on: Fri May 15 17:03:28 1992
|
|
|
174 ;; Filename: backtrace-fix.el
|
|
|
175 ;; Purpose: make backtrace useful when circular structures are on the stack
|
|
|
176
|
|
|
177 (or (fboundp 'original-backtrace)
|
|
|
178 (fset 'original-backtrace
|
|
|
179 (symbol-function 'backtrace)))
|
|
|
180
|
|
|
181 (defconst backtrace-junk "\
|
|
|
182 original-backtrace()
|
|
|
183 (condition-case ...)
|
|
|
184 (let ...)
|
|
|
185 (save-excursion ...)
|
|
|
186 (let ...)
|
|
|
187 ")
|
|
|
188
|
|
|
189 (defun circ-backtrace ()
|
|
|
190 "Print a trace of Lisp function calls currently active.
|
|
|
191 Output stream used is value of standard-output."
|
|
|
192 (let (err-flag)
|
|
|
193 (save-excursion
|
|
|
194 (set-buffer (get-buffer-create " backtrace-temp"))
|
|
|
195 (buffer-flush-undo (current-buffer))
|
|
|
196 (erase-buffer)
|
|
|
197 (let ((standard-output (current-buffer)))
|
|
|
198 (condition-case err
|
|
|
199 (original-backtrace)
|
|
|
200 (error
|
|
|
201 (setq error-flag err))))
|
|
|
202 (cond (err-flag
|
|
|
203 (goto-char (point-max))
|
|
|
204 (beginning-of-line 1)
|
|
|
205 ;; don't leave any unbalanced parens lying around
|
|
|
206 (delete-region (point) (point-max))))
|
|
|
207 (goto-char (point-min))
|
|
|
208 (search-forward backtrace-junk nil t)
|
|
|
209 (delete-region (point-min) (point))
|
|
|
210 (princ (buffer-substring (point-min) (point-max)))))
|
|
|
211 nil)
|
|
|
212
|
|
|
213 (defun install-circ-bt ()
|
|
|
214 (fset 'backtrace
|
|
|
215 (symbol-function 'circ-backtrace)))
|
|
|
216
|
|
|
217 (defvar submerge-prefix "> "
|
|
|
218 "prefix to submerge quoted text with")
|
|
|
219
|
|
|
220 (defun submerge-region (&optional start end)
|
|
|
221 "submerge the current region"
|
|
|
222 (interactive "r")
|
|
|
223 (let ((fill-prefix submerge-prefix))
|
|
|
224 (indent-region start end nil)))
|
