Mercurial > hg > xemacs

comparison misc.el @ 78:0abfe9bf83a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Thu, 25 Sep 2025 17:57:05 +0100
parents 597d985bf448
children
comparison
equal deleted inserted replaced
77:62fb1a21629a 78:0abfe9bf83a0
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
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)
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)))