New org capture template
[emacs.git] / .emacs.d / elisp / icicle / misc-cmds.el
1 ;;; misc-cmds.el --- Miscellaneous commands (interactive functions).
2 ;;
3 ;; Filename: misc-cmds.el
4 ;; Description: Miscellaneous commands (interactive functions).
5 ;; Author: Drew Adams
6 ;; Maintainer: Drew Adams
7 ;; Copyright (C) 1996-2012, Drew Adams, all rights reserved.
8 ;; Created: Wed Aug 2 11:20:41 1995
9 ;; Version: 21.1
10 ;; Last-Updated: Fri Mar 2 07:59:10 2012 (-0800)
11 ;; By: dradams
12 ;; Update #: 3017
13 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/misc-cmds.el
14 ;; Keywords: internal, unix, extensions, maint, local
15 ;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x
16 ;;
17 ;; Features that might be required by this library:
18 ;;
19 ;; `avoid', `frame-fns', `misc-cmds', `misc-fns', `strings',
20 ;; `thingatpt', `thingatpt+'.
21 ;;
22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23 ;;
24 ;;; Commentary:
25 ;;
26 ;; Miscellaneous commands (interactive functions).
27 ;;
28 ;; Commands defined here:
29 ;;
30 ;; `beginning-of-line+', `beginning-or-indentation', `chgrp',
31 ;; `chmod', `chown', `clear-regexp-search-history',
32 ;; `clear-regexp-search-ring' `clear-search-history',
33 ;; `clear-search-ring', `clear-search-histories',
34 ;; `count-chars-in-region', `delete-lines', `end-of-line+',
35 ;; `forward-char-same-line', `forward-overlay',
36 ;; `goto-previous-mark', `indirect-buffer',
37 ;; `kill-buffer-and-its-windows', `mark-buffer-after-point',
38 ;; `mark-buffer-before-point', `old-rename-buffer',
39 ;; `recenter-top-bottom', `recenter-top-bottom-1',
40 ;; `recenter-top-bottom-2', `region-length', `region-to-buffer',
41 ;; `region-to-file', `resolve-file-name',
42 ;; `revert-buffer-no-confirm', `selection-length',
43 ;; `view-X11-colors'.
44 ;;
45 ;; Non-interactive functions defined here:
46 ;;
47 ;; `line-number-at-pos', `read-shell-file-command'.
48 ;;
49 ;;
50 ;; ***** NOTE: These EMACS PRIMITIVES have been REDEFINED HERE:
51 ;;
52 ;; `rename-buffer' - Uses (lax) completion.
53 ;;
54 ;; Suggested key bindings:
55 ;;
56 ;; (define-key ctl-x-map [home] 'mark-buffer-before-point)
57 ;; (define-key ctl-x-map [end] 'mark-buffer-after-point)
58 ;; (define-key ctl-x-map "\M-f" 'region-to-file)
59 ;; (global-set-key [C-S-f1] 'region-to-buffer)
60 ;; (global-set-key [C-S-backspace] 'region-to-file)
61 ;; (global-set-key [home] 'backward-line-text)
62 ;; (global-set-key [f5] 'revert-buffer-no-confirm) ; A la MS Windows
63 ;; (substitute-key-definition 'kill-buffer
64 ;; 'kill-buffer-and-its-windows global-map)
65 ;; (substitute-key-definition 'beginning-of-line 'beginning-of-line+ global-map)
66 ;; (substitute-key-definition 'end-of-line 'end-of-line+ global-map)
67 ;; (substitute-key-definition 'recenter 'recenter-top-bottom global-map)
68 ;;
69 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
70 ;;
71 ;;; Change Log:
72 ;;
73 ;; 2011/12/21 dadams
74 ;; Replaced redefinition of rename-buffer with defadvice.
75 ;; 2011/12/19 dadams
76 ;; goto-long-line: Use line-end-position, not end-of-line + point.
77 ;; 2011/12/12 dadams
78 ;; Added (redefinition of) rename-buffer.
79 ;; Soft require strings.el.
80 ;; 2011/09/06 dadams
81 ;; Added: resolve-file-name.
82 ;; 2011/05/10 dadams
83 ;; Removed hide/show-comments - moved it to thing-cmds.el.
84 ;; 2011/05/06 dadams
85 ;; Added: hide/show-comments.
86 ;; 2011/01/04 dadams
87 ;; Added autoload cookies for commands. Removed from non-interactive function.
88 ;; 2010/01/12 dadams
89 ;; region-to-buffer: save-excursion + set-buffer -> with-current-buffer.
90 ;; 2009/09/24 dadams
91 ;; Removed no-op - use predefined function ignore instead.
92 ;; 2009/06/02 dadams
93 ;; revert-buffer-no-confirm: Redefined using existing args (duh).
94 ;; 2009/04/26 dadams
95 ;; forward-char-same-line, end-of-line+, goto-long(est)-line, delete-lines:
96 ;; Bind inhibit-field-text-motion to t, for end-of-line.
97 ;; 2009/04/08 dadams
98 ;; Added: revert-buffer-no-confirm.
99 ;; eval-when-compile cl.el, regardless of Emacs version.
100 ;; 2008/05/23 dadams
101 ;; Moved to new library second-sel.el:
102 ;; primary-to-secondary, rotate-secondary-selection-yank-pointer,
103 ;; secondary-to-primary, yank-pop(-commands|secondary), yank-undo-function,
104 ;; current-secondary-selection, yank-secondary(-or-swap-w-region),
105 ;; secondary-selection(-ring(-max|-yank-pointer)), add-secondary-to-ring,
106 ;; mouse-drag-secondary, mouse-secondary-save-then-kill.
107 ;; 2008/05/22 dadams
108 ;; Added: secondary-selection(-ring(-max|-yank-pointer)), yank-undo-function,
109 ;; rotate-secondary-selection-yank-pointer, current-secondary-selection,
110 ;; add-secondary-to-ring, yank-pop-(commands|secondary).
111 ;; yank-secondary: Added optional arg - use current-secondary-selection.
112 ;; Use insert-for-yank.
113 ;; primary-to-secondary: Use add-secondary-to-ring, filter-buffer-substring.
114 ;; Delay setting this-command. Exchange point and mark.
115 ;; Return nil.
116 ;; Disable browse-kill-ring's advice.
117 ;; 2008/05/06 dadams
118 ;; Renamed: yank-secondary-or-convert-primary to yank-secondary-or-swap-w-region.
119 ;; yank-secondary-or-swap-w-region: Prefix arg < 0 means secondary-to-primary.
120 ;; primary-to-secondary: Overlay uses current buffer.
121 ;; 2008/05/03 dadams
122 ;; (put 'yank-secondary 'delete-selection 'yank).
123 ;; Added: primary-to-secondary, secondary-to-primary,
124 ;; yank-secondary-or-convert-primary.
125 ;; 2008/03/02 dadams
126 ;; describe-file: Use default dir if arg is nil.
127 ;; Removed "icicle" typos. Removed save-excursion.
128 ;; Moved describe-file to help+20.el and help-fns+.el.
129 ;; 2008/01/23 dadams
130 ;; goto-longest-line: Fix to work with narrowed buffer.
131 ;; Allow empty region, so can just search forward directly.
132 ;; If point at end of region, exchange with mark.
133 ;; If end is before beg, swap them.
134 ;; If only 1 line in region, give "Only..." msg, flash, and deactivate mark.
135 ;; Don't stop while loop just because mark is inactive.
136 ;; Go to target relative to point-min, not to absolute line nb, in case narrowed.
137 ;; Highlight current line (Emacs 22).
138 ;; Removed: region-or-buffer-limits.
139 ;; 2007-11-14
140 ;; Rewrote recenter-top-bottom to combine the best of -1 and -2.
141 ;; 2007/11/11 dadams
142 ;; recenter-top-bottom: Rewrote to base destination on current window position.
143 ;; Renamed original recenter-top-bottom to recenter-top-bottom-bis, and added
144 ;; treatment of scroll-conservatively.
145 ;; 2007/11/06 dadams
146 ;; Added: recenter-top-bottom.
147 ;; 2007/09/24 dadams
148 ;; Added: mark-buffer-(before|after)-point.
149 ;; 2007/09/19 dadams
150 ;; Define goto-previous-mark only if pop-to-mark-command is not defined (Emacs <22).
151 ;; Removed goto-previous-global-mark.
152 ;; 2007/04/28 dadams
153 ;; goto-longest-line: Fixed mapconcat arg for end message.
154 ;; 2007/04/02 dadams
155 ;; Added: region-or-buffer-limits
156 ;; goto-longest-line: Redefined using region-or-buffer-limits.
157 ;; 2007/03/10 dadams
158 ;; goto-longest-line: Raise error if region is empty.
159 ;; 2007/01/13 dadams
160 ;; Added: describe-file.
161 ;; 2006/10/21 dadams
162 ;; yank-secondary: Error message if there is no secondary selection.
163 ;; 2006/08/19 dadams
164 ;; Added: goto-long(est)-line, line-number-at-pos.
165 ;; 2006/02/11 dadams
166 ;; Added: region-length (selection-length, count-chars-in-region).
167 ;; 2006/01/28 dadams
168 ;; Added: clear(-regexp)-search-history, clear-search-histories.
169 ;; 2006/01/01 dadams
170 ;; defsubst -> defun.
171 ;; 2005/07/15 dadams
172 ;; Moved delete-lines back here.
173 ;; 2005/07/14 dadams
174 ;; forward-overlay: ensure arg is a number.
175 ;; 2005/07/12 dadams
176 ;; forward-char-same-line: Convert raw prefix arg to numeric before arithmetic.
177 ;; 2005/07/10 dadams
178 ;; Removed delete-lines (moved to icicles.el and renamed icicles-delete-lines).
179 ;; 2005/05/28 dadams
180 ;; region-to-buffer: Use another-buffer, if available.
181 ;; 2005/05/09 dadams
182 ;; Renamed: flash-ding-minibuffer-frame to 1on1-flash-ding-minibuffer-frame.
183 ;; 2005/01/20 dadams
184 ;; Removed exit-with-confirmation (use kill-emacs-query-functions in setup.el).
185 ;; 2004/11/16 dadams
186 ;; Replaced beginning-of-line*, end-of-line* with + versions.
187 ;; 2004/11/14 dadams
188 ;; Added beginning-or-indentation, beginning-of-line*, end-of-line*.
189 ;; 2000/11/28 dadams
190 ;; Optional require's via 3rd arg=t now.
191 ;; 1999/04/13 dadams
192 ;; Added: delete-lines.
193 ;; 1999/03/17 dadams
194 ;; 1. Protect with fboundp.
195 ;; 2. kill-buffer-and-its-windows: use get-buffer-window-list.
196 ;; 3. Commented out: xwud, display-xwd-image-file, xwd,
197 ;; capture-image-as-xwd-file, display-buffer.
198 ;; 1996/06/03 dadams
199 ;; display-xwd-image-file: Do via background processes:
200 ;; shell-command -> start-process-shell-command.
201 ;; 1996/06/03 dadams
202 ;; display-xwd-image-file:
203 ;; 1. Allow XWD-FILE arg as list. Added DIR arg.
204 ;; 2. No longer provide -noclick option by default.
205 ;; 1996/04/26 dadams
206 ;; Put escaped newlines on long-line strings.
207 ;; 1996/04/24 dadams
208 ;; Added: read-shell-file-command, chmod, chgrp, chown.
209 ;; 1996/04/23 dadams
210 ;; Added display-xwd-image-file (xwud) and capture-image-as-xwd-file (xwd).
211 ;; 1996/04/23 dadams
212 ;; Added: goto-previous-mark, goto-previous-global-mark.
213 ;; 1996/04/16 dadams
214 ;; Added declp-buffer-w-switches and declp-region-w-switches.
215 ;; 1996/03/20 dadams
216 ;; no-op, exit-with-confirmation, view-X11-colors, forward-overlay,
217 ;; declp-buffer, declp-region, yank-secondary: defun -> defsubst
218 ;; 1996/02/28 dadams
219 ;; Added forward-overlay, forward-char-same-line.
220 ;; 1996/02/15 dadams
221 ;; Added yank-secondary.
222 ;; 1996/02/06 dadams
223 ;; Put variable-interactive property on appropriate user option vars.
224 ;; 1996/02/05 dadams
225 ;; 1. Added: default-pr-switches, declp-switches, declp-sheet-options.
226 ;; 2. declp-buffer,declp-region,pr-declp-buffer,pr-declp-region: Optional args.
227 ;; 3. pr-declp-buffer, pr-declp-region, declp-region-1:
228 ;; Proper treatment of pr switches; pr error treatment; No BSD lpr shortcut.
229 ;; 1996/01/25 dadams
230 ;; kill-buffer-and-its-windows: Added args to call to windows-on.
231 ;; 1996/01/16 dadams
232 ;; Added: read-number-up, declp-buffer, declp-region, pr-declp-buffer,
233 ;; pr-declp-region.
234 ;; 1996/01/12 dadams
235 ;; Added region-to-buffer, region-to-file.
236 ;; 1996/01/08 dadams
237 ;; Added redefinition of display-buffer that raises frame.
238 ;; 1995/08/24 dadams
239 ;; 1) Added view-X11-colors. 2) flash-ding -> flash-ding-minibuffer-frame.
240 ;; 1995/08/18 dadams
241 ;; 1) Added no-op and local version of print-region-1.
242 ;; 1995/08/08 dadams
243 ;; Added: exit-with-confirmation, lpr stuff.
244 ;;
245 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
246 ;;
247 ;; This program is free software; you can redistribute it and/or modify
248 ;; it under the terms of the GNU General Public License as published by
249 ;; the Free Software Foundation; either version 2, or (at your option)
250 ;; any later version.
251
252 ;; This program is distributed in the hope that it will be useful,
253 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
254 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
255 ;; GNU General Public License for more details.
256
257 ;; You should have received a copy of the GNU General Public License
258 ;; along with this program; see the file COPYING. If not, write to
259 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
260 ;; Floor, Boston, MA 02110-1301, USA.
261 ;;
262 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
263 ;;
264 ;;; Code:
265
266 (eval-when-compile (require 'cl)) ;; case, plus for Emacs < 21: dolist, pop
267
268 (require 'frame-fns nil t) ;; (no error if not found): flash-ding
269 (require 'misc-fns nil t) ;; (no error if not found): another-buffer
270 (require 'strings nil t) ;; (no error if not found): read-buffer
271
272 ;;;;;;;;;;;;;;;;;;;;;;;
273
274 (provide 'misc-cmds)
275 (require 'misc-cmds) ; Ensure loaded before compile this.
276
277 ;;;;;;;;;;;;;;;;;;;;;;;
278
279
280 ;; ADVISE ORIGINAL `rename-buffer' (built-in).
281 ;;
282 ;; 1. Provide (lax) completion for new buffer name.
283 ;; 2. Use name of current buffer as default (< Emacs 23).
284 ;;
285 (defadvice rename-buffer (before read-buffer-completing activate)
286 "Interactively, (lax) completion is available for the buffer name."
287 (interactive (list (read-buffer "Rename buffer (to new name): " (buffer-name))
288 current-prefix-arg)))
289
290 ;;;###autoload
291 (defun view-X11-colors ()
292 "View file `/usr/lib/X11/rgb.txt', which lists available X11 colors."
293 (interactive) (view-file-other-window "/usr/lib/X11/rgb.txt")) ; In `view.el'.
294
295 ;;;###autoload
296 (defun forward-overlay (&optional arg)
297 "Move forward ARG overlays.
298 Move cursor to next position where an overlay starts or ends.
299 If there are no more overlay boundaries, move to (point-max)."
300 (interactive "p")
301 (setq arg (or arg 1))
302 (setq arg (1- arg))
303 (while (natnump arg) (goto-char (next-overlay-change (point))) (decf arg)))
304
305 ;;;###autoload
306 (defun forward-char-same-line (&optional arg)
307 "Move forward a max of ARG chars on the same line, or backward if ARG < 0.
308 Returns the signed number of chars moved if /= ARG, else returns nil."
309 (interactive "p")
310 (let* ((start (point))
311 (fwd-p (natnump arg))
312 (inhibit-field-text-motion t) ; Just to be sure, for `end-of-line'.
313 (max (save-excursion (if fwd-p (end-of-line) (beginning-of-line))
314 (- (point) start))))
315 (setq arg (prefix-numeric-value arg))
316 (forward-char (if fwd-p (min max arg) (max max arg)))
317 (and (< (abs max) (abs arg)) max)))
318
319 ;;;###autoload
320 (defun end-of-line+ (&optional n)
321 "Move cursor to end of current line or end of next line if repeated.
322 This is similar to `end-of-line', but:
323 If called interactively with no prefix arg:
324 If the previous command was also `end-of-line+', then move to the
325 end of the next line. Else, move to the end of the current line.
326 Otherwise, move to the end of the Nth next line (Nth previous line
327 if N<0). Command `end-of-line', by contrast, moves to the end of
328 the (N-1)th next line."
329 (interactive
330 (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) 0)))
331 (unless n (setq n 0)) ; non-interactive with no arg
332 (if (and (eq this-command last-command) (not current-prefix-arg))
333 (forward-line 1)
334 (forward-line n))
335 (let ((inhibit-field-text-motion t)) (end-of-line)))
336
337 ;;;###autoload
338 (defun beginning-of-line+ (&optional n)
339 "Move cursor to beginning of current line or next line if repeated.
340 This is the similar to `beginning-of-line', but:
341 1. With arg N, the direction is the opposite: this command moves
342 backward, not forward, N lines.
343 2. If called interactively with no prefix arg:
344 If the previous command was also `beginning-of-line+', then move
345 to the beginning of the previous line. Else, move to the
346 beginning of the current line.
347 Otherwise, move to the beginning of the Nth previous line (Nth next
348 line if N<0). Command `beginning-of-line', by contrast, moves to
349 the beginning of the (N-1)th next line."
350 (interactive
351 (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) 0)))
352 (unless n (setq n 0)) ; non-interactive with no arg
353 (if (and (eq this-command last-command) (not current-prefix-arg))
354 (forward-line -1)
355 (forward-line (- n))))
356
357 ;;;###autoload
358 (defun beginning-or-indentation (&optional n)
359 "Move cursor to beginning of this line or to its indentation.
360 If at indentation position of this line, move to beginning of line.
361 If at beginning of line, move to beginning of previous line.
362 Else, move to indentation position of this line.
363
364 With arg N, move backward to the beginning of the Nth previous line.
365 Interactively, N is the prefix arg."
366 (interactive "P")
367 (cond ((or (bolp) n)
368 (forward-line (- (prefix-numeric-value n))))
369 ((save-excursion (skip-chars-backward " \t") (bolp)) ; At indentation.
370 (forward-line 0))
371 (t (back-to-indentation))))
372
373 ;;;###autoload
374 (defun recenter-top-bottom (&optional arg)
375 "Move current line to window center, top, and bottom, successively.
376 With a prefix argument, this is the same as `recenter':
377 With numeric prefix ARG, move current line to window-line ARG.
378 With plain `C-u', move current line to window center.
379
380 Otherwise move current line to window center on first call, and to
381 top, middle, or bottom on successive calls.
382
383 The starting position of the window determines the cycling order:
384 If initially in the top or middle third: top -> middle -> bottom.
385 If initially in the bottom third: bottom -> middle -> top.
386
387 Top and bottom destinations are actually `scroll-conservatively' lines
388 from true window top and bottom."
389 (interactive "P")
390 (if arg ; Always respect ARG.
391 (recenter arg)
392 (case last-command
393 (recenter-tb-top ; Top -> middle -> bottom
394 (setq this-command 'recenter-tb-middle)
395 (recenter))
396 (recenter-tb-middle
397 (setq this-command 'recenter-tb-bottom)
398 (recenter (1- (- scroll-conservatively))))
399 (recenter-tb-bottom
400 (setq this-command 'recenter-tb-top)
401 (recenter scroll-conservatively))
402 (recenter-tb-bottom-1 ; Bottom -> middle -> top
403 (setq this-command 'recenter-tb-middle-1)
404 (recenter))
405 (recenter-tb-middle-1
406 (setq this-command 'recenter-tb-top-1)
407 (recenter scroll-conservatively))
408 (recenter-tb-top-1
409 (setq this-command 'recenter-tb-bottom-1)
410 (recenter (1- (- scroll-conservatively))))
411 (otherwise ; First time - save mode and recenter.
412 (let ((top (1+ (count-lines 1 (window-start))))
413 (current (1+ (count-lines 1 (point))))
414 (total (window-height)))
415 (setq this-command (if (< (- current top) (/ total 3))
416 'recenter-tb-middle
417 'recenter-tb-middle-1)))
418 (recenter)))))
419
420 ;; An alternative.
421 ;;;###autoload
422 (defun recenter-top-bottom-1 (&optional arg)
423 "Move current line to window center, top, and bottom, successively.
424 With prefix ARG, move current line to window-line ARG.
425 Top and bottom destinations are actually `scroll-conservatively' lines
426 from true top and bottom."
427 (interactive "P")
428 (cond ((and (eq this-command last-command) (not arg))
429 (setq this-command 'recenter-top-bottom-top)
430 (recenter scroll-conservatively))
431 ((and (eq 'recenter-top-bottom-top last-command) (not arg))
432 (setq this-command 'recenter-top-bottom-bottom)
433 (recenter (1- (- scroll-conservatively))))
434 (t (recenter arg))))
435
436 ;; Another alternative.
437 ;;;###autoload
438 (defun recenter-top-bottom-2 (&optional arg)
439 "Move current line to line ARG, window center, top, or bottom.
440 With a prefix argument, this is the same as `recenter':
441 With numeric prefix ARG, move current line to window-line ARG.
442 With plain `C-u', move current line to window center.
443
444 Otherwise, the window starting position determines the next position:
445 If in the top third, move to bottom.
446 If in middle third, move to top.
447 If in bottom third, move tocenter.
448
449 Top and bottom destinations are actually `scroll-conservatively' lines
450 from true top and bottom."
451 (interactive "P")
452 (cond (arg (recenter arg))
453 (t
454 (let* ((top (1+ (count-lines 1 (window-start))))
455 (bottom (1+ (count-lines 1 (window-end))))
456 (current (1+ (count-lines 1 (point))))
457 (total (window-height)))
458 (cond ((< (- current top) (/ total 3))
459 (recenter (1- (- scroll-conservatively))))
460 ((< (- bottom current) (/ total 3)) (recenter '(4)))
461 (t (recenter scroll-conservatively)))))))
462
463 ;;;###autoload
464 (defun mark-buffer-after-point (reversep)
465 "Select the part of the buffer after point.
466 With a prefix argument, select the part before point."
467 (interactive "P")
468 (push-mark (if reversep (point-min) (point-max)) nil t)
469 (setq deactivate-mark nil))
470
471 ;;;###autoload
472 (defun mark-buffer-before-point (reversep)
473 "Select the part of the buffer before point.
474 With a prefix argument, select the part after point."
475 (interactive "P")
476 (mark-buffer-after-point t))
477
478 ;;;###autoload
479 (defalias 'selection-length 'region-length)
480 ;;;###autoload
481 (defalias 'count-chars-in-region 'region-length)
482 ;;;###autoload
483 (defun region-length ()
484 "Display the number of characters in the region in a message."
485 (interactive)
486 (let ((len (abs (- (mark) (point)))))
487 (message "Region contains %s characters" len)
488 len))
489
490 (unless (fboundp 'line-number-at-pos) ; Exists in Emacs 22.
491 (defun line-number-at-pos (&optional pos)
492 "Buffer line number at position POS. Current line number if POS is nil.
493 Counting starts at (point-min), so any narrowing restriction applies."
494 (1+ (count-lines (point-min) (save-excursion (when pos (goto-char pos))
495 (forward-line 0) (point))))))
496
497 ;;;###autoload
498 (defun goto-longest-line (beg end)
499 "Go to the first of the longest lines in the region or buffer.
500 If the region is active, it is checked.
501 If not, the buffer (or its restriction) is checked.
502
503 Returns a list of three elements:
504
505 (LINE LINE-LENGTH OTHER-LINES LINES-CHECKED)
506
507 LINE is the first of the longest lines measured.
508 LINE-LENGTH is the length of LINE.
509 OTHER-LINES is a list of other lines checked that are as long as LINE.
510 LINES-CHECKED is the number of lines measured.
511
512 Interactively, a message displays this information.
513
514 If there is only one line in the active region, then the region is
515 deactivated after this command, and the message mentions only LINE and
516 LINE-LENGTH.
517
518 If this command is repeated, it checks for the longest line after the
519 cursor. That is *not* necessarily the longest line other than the
520 current line. That longest line could be before or after the current
521 line.
522
523 To search only from the current line forward, not throughout the
524 buffer, you can use `C-SPC' to set the mark, then use this
525 \(repeatedly)."
526 (interactive
527 (if (or (not mark-active) (null (mark)))
528 (list (point-min) (point-max))
529 (if (< (point) (mark))
530 (list (point) (mark))
531 (list (mark) (point)))))
532 (when (and (not mark-active) (= beg end))
533 (error "The buffer is empty"))
534 (when (and mark-active (> (point) (mark))) (exchange-point-and-mark))
535 (when (< end beg) (setq end (prog1 beg (setq beg end))))
536 (when (eq this-command last-command)
537 (forward-line 1) (setq beg (point)))
538 (goto-char beg)
539 (when (eobp) (error "End of buffer"))
540 (cond ((<= end (save-excursion (goto-char beg) (forward-line 1) (point)))
541 (let ((inhibit-field-text-motion t)) (beginning-of-line))
542 (when (and (> emacs-major-version 21) (require 'hl-line nil t))
543 (let ((hl-line-mode t)) (hl-line-highlight))
544 (add-hook 'pre-command-hook #'hl-line-unhighlight nil t))
545 (let ((lineno (line-number-at-pos))
546 (chars (let ((inhibit-field-text-motion t))
547 (save-excursion (end-of-line) (current-column)))))
548 (message "Only line %d: %d chars" lineno chars)
549 (let ((visible-bell t)) (ding))
550 (setq mark-active nil)
551 (list lineno chars nil 1)))
552 (t
553 (let* ((start-line (line-number-at-pos))
554 (max-width 0)
555 (line start-line)
556 (inhibit-field-text-motion t)
557 long-lines col)
558 (when (eobp) (error "End of buffer"))
559 (while (and (not (eobp)) (< (point) end))
560 (end-of-line)
561 (setq col (current-column))
562 (when (>= col max-width)
563 (setq long-lines (if (= col max-width)
564 (cons line long-lines)
565 (list line))
566 max-width col))
567 (forward-line 1)
568 (setq line (1+ line)))
569 (setq long-lines (nreverse long-lines))
570 (let ((lines long-lines))
571 (while (and lines (> start-line (car lines))) (pop lines))
572 (goto-char (point-min))
573 (when (car lines) (forward-line (1- (car lines)))))
574 (when (and (> emacs-major-version 21) (require 'hl-line nil t))
575 (let ((hl-line-mode t)) (hl-line-highlight))
576 (add-hook 'pre-command-hook #'hl-line-unhighlight nil t))
577 (when (interactive-p)
578 (let ((others (cdr long-lines)))
579 (message "Line %d: %d chars%s (%d lines measured)"
580 (car long-lines) max-width
581 (concat
582 (and others
583 (format ", Others: {%s}" (mapconcat
584 (lambda (line) (format "%d" line))
585 (cdr long-lines) ", "))))
586 (- line start-line))))
587 (list (car long-lines) max-width (cdr long-lines) (- line start-line))))))
588
589 ;;;###autoload
590 (defun goto-long-line (len)
591 "Go to the first line that is at least LEN characters long.
592 Use a prefix arg to provide LEN.
593 Plain `C-u' (no number) uses `fill-column' as LEN."
594 (interactive "P")
595 (setq len (if (consp len) fill-column (prefix-numeric-value len)))
596 (let ((start-line (line-number-at-pos))
597 (len-found 0)
598 (found nil)
599 (inhibit-field-text-motion t))
600 (while (and (not found) (not (eobp)))
601 (forward-line 1)
602 (setq found (< len (setq len-found (- (line-end-position) (point))))))
603 (if found
604 (when (interactive-p)
605 (message "Line %d: %d chars" (line-number-at-pos) len-found))
606 (goto-line start-line)
607 (message "Not found"))))
608
609 ;;;###autoload
610 (defun delete-lines (num-lines)
611 "Delete NUM-LINES lines, starting at point.
612 Lines are deleted, not killed.
613 With positive prefix arg, deletion is forward.
614 With negative prefix arg, deletion is backward."
615 (interactive "p")
616 (when (not (zerop num-lines))
617 (let ((column (current-column))
618 (forward-p (natnump num-lines))
619 (inhibit-field-text-motion t))
620 (if forward-p (beginning-of-line) (end-of-line))
621 (let ((beg (point)))
622 (forward-line (if forward-p (1- num-lines) (1+ num-lines)))
623 (if forward-p (end-of-line) (beginning-of-line))
624 (delete-region beg (point)))
625 (when (eq (following-char) ?\n) (delete-char 1))
626 (move-to-column column))))
627
628 ;;;(defvar default-pr-switches "-fl68"
629 ;;; "*String of default switches to pass to `pr'.
630 ;;;These may be overridden in `pr-declp-buffer' and `pr-declp-region'.")
631 ;;;(put 'default-pr-switches 'variable-interactive
632 ;;; "sDefault switches to pass to `pr' (e.g. \"-fl68\"): ")
633
634 ;;;(defvar declp-switches nil
635 ;;; "*List of strings to pass as extra switch args to `declp-command'.")
636
637 ;;;(defvar declp-command "declp" "*Shell command for printing a file.
638 ;;;Should usually be either \"declp\" or \"declpt\".")
639 ;;;(put 'declp-command 'variable-interactive
640 ;;; "sShell command for printing a file. (\"declp\" or \"declpt\"): ")
641
642 ;;;;;;###autoload
643 ;;;(defmacro declp-sheet-options (number-up)
644 ;;; (` (if (and (integerp (, number-up)) (not (zerop (, number-up))))
645 ;;; (if (natnump (, number-up))
646 ;;; (format " -K 2 -N %d " (, number-up))
647 ;;; (format " -N %d " (, number-up)))
648 ;;; "")))
649
650 ;;;;;;###autoload
651 ;;;(defun declp-buffer-w-switches ()
652 ;;; "Print buffer using `declp-command' and switches that you specify.
653 ;;;Variable `declp-switches' is a list of proposed default switches."
654 ;;; (interactive)
655 ;;; (let ((cmd (read-from-minibuffer
656 ;;; (concat "Print buffer `" (buffer-name) "' with command: ")
657 ;;; (apply 'concat declp-command " " declp-switches) nil nil
658 ;;; 'minibuffer-history)))
659 ;;; (save-restriction (widen) (message "Spooling...")
660 ;;; (shell-command-on-region (point-min) (point-max) cmd)))
661 ;;; (message "Spooling... done"))
662
663 ;;;(defun declp-buffer (&optional number-up)
664 ;;; "Print buffer contents using `declp-command'.
665 ;;;NUM-UP pages are printed on a side of paper, bordered by a rectangle
666 ;;;if NUM-UP is a non-zero integer. NUM-UP is the prefix arg, if any.
667 ;;;Otherwise you are prompted for NUM-UP.
668 ;;; NUM-UP > 0 => Print on both sides of paper.
669 ;;; NUM-UP < 0 => Only print on one side of paper.
670 ;;; Otherwise => Print 1 page per sheet, on one side of paper, and
671 ;;; do not print a rectangular border around each page.
672 ;;;Global variable `declp-switches' is a list of switches (strings)
673 ;;;for `declp-command'."
674 ;;; (interactive (list (if current-prefix-arg
675 ;;; (prefix-numeric-value current-prefix-arg)
676 ;;; (read-number-up 'declp-buffer))))
677 ;;; (declp-region-1 (point-min) (point-max)
678 ;;; (cons (declp-sheet-options number-up) declp-switches)))
679
680 ;;;;;;###autoload
681 ;;;(defun declp-region-w-switches (start end)
682 ;;; "Print region using `declp-command' and switches that you specify.
683 ;;;Variable `declp-switches' is a list of proposed default switches."
684 ;;; (interactive "r")
685 ;;; (let ((cmd (concat (read-from-minibuffer
686 ;;; (concat "Print region with command: ")
687 ;;; (apply 'concat declp-command " " declp-switches) nil nil
688 ;;; 'minibuffer-history))))
689 ;;; (message "Spooling...")
690 ;;; (shell-command-on-region start end cmd))
691 ;;; (message "Spooling... done"))
692
693 ;;;(defun declp-region (start end &optional number-up)
694 ;;; "Print region contents using `declp-command'.
695 ;;;NUM-UP pages are printed on a side of paper, bordered by a rectangle
696 ;;;if NUM-UP is a non-zero integer. NUM-UP is the prefix arg, if any.
697 ;;;Otherwise you are prompted for NUM-UP.
698 ;;; NUM-UP > 0 => Print on both sides of paper.
699 ;;; NUM-UP < 0 => Only print on one side of paper.
700 ;;; Otherwise => Print 1 page per sheet, on one side of paper, and
701 ;;; do not print a rectangular border around each page.
702 ;;;Global variable `declp-switches' is a list of switches (strings)
703 ;;;for `declp-command'."
704 ;;; (interactive (list (region-beginning) (region-end)
705 ;;; (if current-prefix-arg
706 ;;; (prefix-numeric-value current-prefix-arg)
707 ;;; (read-number-up 'declp-region))))
708 ;;; (declp-region-1 start end
709 ;;; (cons (declp-sheet-options number-up) declp-switches)))
710
711 ;;;;;;###autoload
712 ;;;(defun pr-declp-buffer (&optional number-up pr-switches)
713 ;;; "Print buffer with page headings using `declp-command'.
714 ;;;The Unix `pr' command is used to provide the page headings.
715 ;;;You are prompted for PR-SWITCHES, which is a string of switches
716 ;;;to the `pr' command. For information on `pr', type `\\[manual-entry] pr'.
717 ;;;\(Note: The `-m' option to `pr' makes no sense in this context.)
718
719 ;;;NUM-UP pages are printed on a side of paper, bordered by a rectangle
720 ;;;if NUM-UP is a non-zero integer. NUM-UP is the prefix arg, if any.
721 ;;;Otherwise you are prompted for NUM-UP.
722 ;;; NUM-UP > 0 => Print on both sides of paper.
723 ;;; NUM-UP < 0 => Only print on one side of paper.
724 ;;; Otherwise => Print 1 page per sheet, on one side of paper, and
725 ;;; do not print a rectangular border around each page.
726
727 ;;;Global variables:
728 ;;;`declp-switches' is a list of switches (strings) for `declp-command'.
729 ;;;`default-pr-switches' is a string of default switches for `pr'.
730 ;;;Switches in PR-SWITCHES override those in `default-pr-switches'."
731 ;;; (interactive
732 ;;; (let (pr-opt
733 ;;; (pr-opts ()))
734 ;;; (list (if current-prefix-arg
735 ;;; (prefix-numeric-value current-prefix-arg)
736 ;;; (read-number-up 'pr-declp-region))
737 ;;; (progn
738 ;;; (setq pr-opts (list (read-from-minibuffer "Page title: "
739 ;;; (cons (buffer-name) 1))
740 ;;; "-h")) ; Order reversed below to '-h title'.
741 ;;; (while (not (string= "" pr-opt))
742 ;;; (push (setq pr-opt (read-from-minibuffer
743 ;;; "Switches for `pr' (RET to end): "))
744 ;;; pr-opts))
745 ;;; (pop pr-opts) ; ""
746 ;;; (nreverse pr-opts)))))
747 ;;; (declp-region-1 (point-min) (point-max)
748 ;;; (cons (declp-sheet-options number-up) declp-switches)
749 ;;; (or pr-switches ""))) ; Non-nil for pr.
750
751 ;;;;;;###autoload
752 ;;;(defun pr-declp-region (start end &optional &optional number-up pr-switches)
753 ;;; "Print region with page headings using `declp-command'.
754 ;;;The Unix `pr' command is used to provide the page headings.
755 ;;;You are prompted for PR-SWITCHES, which is a string of switches
756 ;;;to the `pr' command. For information on `pr', type `\\[manual-entry] pr'.
757 ;;;\(Note: The `-m' option to `pr' makes no sense in this context.)
758
759 ;;;NUM-UP pages are printed on a side of paper, bordered by a rectangle
760 ;;;if NUM-UP is a non-zero integer. NUM-UP is the prefix arg, if any.
761 ;;;Otherwise you are prompted for NUM-UP.
762 ;;; NUM-UP > 0 => Print on both sides of paper.
763 ;;; NUM-UP < 0 => Only print on one side of paper.
764 ;;; Otherwise => Print 1 page per sheet, on one side of paper, and
765 ;;; do not print a rectangular border around each page.
766
767 ;;;Global variables:
768 ;;;`declp-switches' is a list of switches (strings) for `declp-command'.
769 ;;;`default-pr-switches' is a string of default switches for `pr'.
770 ;;;Switches in PR-SWITCHES override those in `default-pr-switches'."
771 ;;; (interactive
772 ;;; (let (pr-opt
773 ;;; (pr-opts ()))
774 ;;; (list (region-beginning) (region-end)
775 ;;; (if current-prefix-arg
776 ;;; (prefix-numeric-value current-prefix-arg)
777 ;;; (read-number-up 'pr-declp-region))
778 ;;; (progn
779 ;;; (setq pr-opts (list (read-from-minibuffer "Page title: ") "-h"))
780 ;;; (while (not (string= "" pr-opt))
781 ;;; (push (setq pr-opt (read-from-minibuffer
782 ;;; "Switches for `pr' (RET to end): "))
783 ;;; pr-opts))
784 ;;; (pop pr-opts) ; ""
785 ;;; (nreverse pr-opts)))))
786 ;;; (declp-region-1 start end
787 ;;; (cons (declp-sheet-options number-up) declp-switches)
788 ;;; (or pr-switches ""))) ; Non-nil for pr.
789
790 ;;;;; Adapted from `print-region-1' in `lpr.el'.
791 ;;;(defun declp-region-1 (start end switches &optional page-headers)
792 ;;; ;; On some MIPS system, having a space in the job name
793 ;;; ;; crashes the printer demon. But using dashes looks ugly
794 ;;; ;; and it seems too annoying to do for those MIPS systems.
795 ;;; (let ((name (concat (buffer-name) " Emacs buffer"))
796 ;;; (title (concat (buffer-name) " Emacs buffer"))
797 ;;; (width tab-width))
798 ;;; (save-excursion
799 ;;; (when (/= tab-width 8)
800 ;;; (print-region-new-buffer start end)
801 ;;; (setq tab-width width)
802 ;;; (save-excursion (goto-char end) (setq end (point-marker)))
803 ;;; (untabify (point-min) (point-max)))
804 ;;; ;; Filter region through `pr'.
805 ;;; (message "Filtering with `pr'...")
806 ;;; (when page-headers
807 ;;; (print-region-new-buffer start end)
808 ;;; (when (not (zerop (apply 'call-process-region start end "pr" t t nil
809 ;;; default-pr-switches page-headers)))
810 ;;; (display-buffer " *spool temp*")
811 ;;; (error "Error in switches to `pr'"))
812 ;;; (setq start (point-min))
813 ;;; (setq end (point-max)))
814 ;;; (message "Spooling...")
815 ;;; (apply 'shell-command-on-region
816 ;;; (list start end (apply 'concat declp-command " " switches)))
817 ;;; (when (markerp end) (set-marker end nil))
818 ;;; (message "Spooling... done"))))
819
820 ;;;(defun read-number-up (fn)
821 ;;; "Read NUMBER-UP argument for a declp print function,
822 ;;;`declp-buffer', `declp-region', `pr-declp-buffer', or `pr-declp-region'."
823 ;;; (let ((prompt "Number of pages per sheet of paper (`?' for help): ")
824 ;;; input)
825 ;;; (while (not (and (condition-case nil (setq input (read-minibuffer prompt))
826 ;;; (error nil)) ; Read a non-Lisp expression.
827 ;;; (numberp input))) ; Read a Lisp sexp, but not a number.
828 ;;; (save-window-excursion (describe-function fn))) ; Defined in `help.el'.
829 ;;; (round input))) ; Convert floating point to integer.
830
831
832 (unless (fboundp 'pop-to-mark-command)
833 (defun goto-previous-mark ()
834 "Jump to previous mark, rotating the (local) `mark-ring'.
835 Does not affect the `global-mark-ring'.
836 This is equivalent to `set-mark-command' with a non-nil argument."
837 (interactive) (set-mark-command t)))
838
839 ;;;###autoload
840 (defun region-to-buffer (start end buffer arg)
841 "Copy region to BUFFER: At beginning (prefix >= 0), end (< 0), or replace.
842 START and END are the region boundaries.
843 BUFFER is a buffer or its name (a string).
844 With prefix ARG >= 0: `append-to-buffer':
845 Append contents of region to end of BUFFER.
846 (Point is moved to end of BUFFER first.)
847 With prefix ARG < 0: `prepend-to-buffer':
848 Prepend contents of region to beginning of BUFFER.
849 (Point is moved to beginning of BUFFER first.)
850 With no prefix ARG (nil): `copy-to-buffer'.
851 Write region to BUFFER, replacing any previous contents."
852 (interactive
853 (let ((arg (and current-prefix-arg (prefix-numeric-value current-prefix-arg))))
854 (list (region-beginning)
855 (region-end)
856 (read-buffer (concat (if arg
857 (if (natnump arg) "Append" "Prepend")
858 "Write")
859 " region to buffer: ")
860 (if (fboundp 'another-buffer) ; Defined in `misc-fns.el'.
861 (another-buffer nil t)
862 (other-buffer (current-buffer))))
863 arg)))
864 (setq buffer (get-buffer-create buffer)) ; Convert to buffer.
865 (when (eq buffer (current-buffer)) (error "Cannot copy region to its own buffer"))
866 (cond ((natnump arg)
867 (with-current-buffer buffer (goto-char (point-max)))
868 (append-to-buffer buffer start end))
869 (arg
870 (with-current-buffer buffer (goto-char (point-min)))
871 (prepend-to-buffer buffer start end))
872 (t (copy-to-buffer buffer start end))))
873
874 ;;;###autoload
875 (defun region-to-file (start end filename arg)
876 "With prefix arg, this is `append-to-file'. Without, it is `write-region'.
877 START and END are the region boundaries.
878 Prefix ARG non-nil means append region to end of file FILENAME.
879 Prefix ARG nil means write region to FILENAME, replacing contents."
880 (interactive
881 (list (region-beginning)
882 (region-end)
883 (read-file-name (concat (if current-prefix-arg "Append" "Write")
884 " region to file: "))
885 current-prefix-arg))
886 (let* ((curr-file (buffer-file-name))
887 (same-file-p (and curr-file (string= curr-file filename))))
888 (cond ((or (not same-file-p)
889 (progn (when (fboundp 'flash-ding) (flash-ding))
890 (yes-or-no-p
891 (format
892 "Do you really want to REPLACE the contents of `%s' by \
893 just the REGION? "
894 (file-name-nondirectory curr-file)))))
895 (write-region start end filename arg)
896 (when same-file-p (revert-buffer t t)))
897 (t (message "OK. Not written.")))))
898
899 ;(defalias 'xwud 'display-xwd-image-file)
900 ;;;;###autoload
901 ;(defun display-xwd-image-file (xwd-file &optional options dir)
902 ; "Display an xwd image file XWD-FILE using the Unix `xwud' command.
903 ;Arg XWD-FILE is a string naming the file, or else a list of such
904 ;strings (non-interactively).
905
906 ;If XWD-FILE is a list, then each of the files named in it is displayed
907 ;in turn, a mouse click on an image causing it to be replaced by the
908 ;next one. In this case, relative file names are taken as relative to
909 ;the directory DIR (the optional third arg), which defaults to the
910 ;current `default-directory'.
911
912 ;A non-nil prefix arg => You are prompted for `xwud' options.
913 ;For a list of possible options, type \"-help\" as an option.
914 ;For more information, type `\\[manual-entry] xwud'.
915
916 ;Output from the `xwud' processes is put into buffer \"*XWD Display*\",
917 ;but that buffer is not displayed."
918 ; (interactive "F*.xwd file to display: \nP")
919 ; (when (and options (not (stringp options)))
920 ; (setq options (read-from-minibuffer "`xwud' options: " nil nil nil
921 ; 'minibuffer-history)))
922 ; (setq dir (or dir default-directory))
923 ; (if (listp xwd-file)
924 ; (dolist (file xwd-file)
925 ; (funcall 'display-xwd-image-file (expand-file-name file dir) options))
926 ; (let ((buf (get-buffer-create "*XWD Display*")))
927 ; (save-excursion (set-buffer buf) (erase-buffer))
928 ; (start-process-shell-command "xwud" buf "xwud"
929 ; (concat options " -in " xwd-file)))))
930
931 ;;;; TO TEST:
932 ;;;;(display-xwd-image-file
933 ;;;; (directory-files "~/ICONS" nil "drew-poster.+\.xwd$" t) nil "~/ICONS")
934
935 ;(defalias 'xwd 'capture-image-as-xwd-file)
936 ;;;;###autoload
937 ;(defun capture-image-as-xwd-file (xwd-file &optional options)
938 ; "Capture an X window image as an *.xwd file via Unix `xwd' command.
939 ;The \"-nobdrs\" `xwd' option is provided by default.
940 ;A non-nil prefix arg => You are prompted for `xwd' options.
941 ;For a list of options, type \"-help\" as an option.
942 ;For more information, type `\\[manual-entry] xwud'."
943 ; (interactive "F*.xwd image file to create: \nP")
944 ; (if options
945 ; (unless (stringp options)
946 ; (setq options (read-from-minibuffer "`xwd' options: " " -nobdrs "
947 ; nil nil 'minibuffer-history)))
948 ; (setq options " -nobdrs "))
949 ; (message
950 ; "Click in X window you want to capture as image file `%s'." xwd-file)
951 ; (shell-command (concat "xwd " options " -out " xwd-file)))
952
953 (defun resolve-file-name (bounds &optional killp)
954 "Replace the file name at/near point by its absolute, true file name.
955 If the region is active, replace its content instead, treating it as a
956 file name.
957
958 If library `thingatpt+.el' is available then use the file name
959 *nearest* point. Otherwise, use the file name *at* point.
960
961 With a prefix arg, add both the original file name and the true name
962 to the kill ring. Otherwise, add neither to the kill ring. (If the
963 region was active then its content was already added to the ring.)"
964 (interactive
965 (let* ((regionp (and transient-mark-mode mark-active))
966 (thg+bnds (and (not regionp)
967 (require 'thingatpt+ nil t)
968 (thing-nearest-point-with-bounds 'filename)))
969 (bnds (if regionp
970 (cons (region-beginning) (region-end))
971 (if thg+bnds
972 (cdr thg+bnds)
973 (bounds-of-thing-at-point 'filename))))
974 (fname (if bnds
975 (buffer-substring (car bnds) (cdr bnds))
976 (message "No file name at point"))))
977 (list bnds current-prefix-arg)))
978 (when bounds
979 (let* ((file (buffer-substring (car bounds) (cdr bounds)))
980 (absfile (expand-file-name (buffer-substring (car bounds) (cdr bounds))))
981 (dir (or (file-name-directory absfile) default-directory))
982 (true-dir (file-truename dir))
983 (relfile (file-name-nondirectory absfile))
984 (true-file (concat true-dir relfile)))
985 (unless (equal file true-file)
986 (cond (killp
987 (if (and transient-mark-mode mark-active)
988 (delete-region (car bounds) (cdr bounds)) ; Don't add it twice.
989 (kill-region (car bounds) (cdr bounds)))
990 (insert (kill-new true-file)))
991 (t
992 (delete-region (car bounds) (cdr bounds))
993 (insert true-file)))))))
994
995 (defun read-shell-file-command (command)
996 "Prompt for shell COMMAND, using current buffer's file as default arg.
997 If buffer is not associated with a file, you are prompted for a file.
998 COMMAND is a symbol."
999 (let ((file (or (buffer-file-name) (read-file-name "File: "))))
1000 (setq file (and file (file-name-nondirectory file))
1001 command (format "%s " command)) ; Convert to string.
1002 (read-from-minibuffer
1003 "" (cons (concat command (and file (concat " " file))) (length command)))))
1004
1005 ;;;###autoload
1006 (defun chmod (cmd)
1007 "Execute Unix command `chmod'. Current buffer's file is default arg.
1008 CMD is the command to execute (interactively, `chmod')."
1009 (interactive (list (read-shell-file-command 'chmod)))
1010 (shell-command cmd))
1011
1012 ;;;###autoload
1013 (defun chgrp (cmd)
1014 "Execute Unix command `chgrp'. Current buffer's file is default arg.
1015 CMD is the command to execute (interactively, `chgrp')."
1016 (interactive (list (read-shell-file-command 'chgrp)))
1017 (shell-command cmd))
1018
1019 ;;;###autoload
1020 (defun chown (cmd)
1021 "Execute Unix command `chown'. Current buffer's file is default arg.
1022 CMD is the command to execute (interactively, `chown')."
1023 (interactive (list (read-shell-file-command 'chown)))
1024 (shell-command cmd))
1025
1026
1027 ;; ***** NOTE: The following EMACS PRIMITIVE has been REDEFINED HERE:
1028 ;;
1029 ;; `display-buffer' - Raises frame too.
1030
1031 ;(or (fboundp 'old-display-buffer)
1032 ;(fset 'old-display-buffer (symbol-function 'display-buffer)))
1033
1034 ;;; REPLACES ORIGINAL (C source code?): Raises frame too.
1035 ;;;;###autoload
1036 ;(defun display-buffer (buffer &optional not-this-window)
1037 ; "Make BUFFER appear in some window but don't select it.
1038 ;BUFFER can be a buffer or a buffer name. Returns the window.
1039
1040 ;If BUFFER is shown already in some window, just use that one,
1041 ;unless it is the selected window and the optional second arg
1042 ;NOT-THIS-WINDOW is non-nil (interactively, with prefix arg).
1043 ;Raises the frame in which buffer is already shown.
1044
1045 ;If `pop-up-frames' is non-nil, make a new frame if no window
1046 ;shows BUFFER."
1047 ; (interactive (list (read-buffer "Display buffer: " (other-buffer) 'existing)
1048 ; current-prefix-arg))
1049 ; (let ((win (get-buffer-window buffer t)))
1050 ; (if (or not-this-window (not win))
1051 ; (old-display-buffer buffer not-this-window)
1052 ; (raise-frame (window-frame win))
1053 ; win))) ; Return the window.
1054
1055
1056 ;; Candidate as replacement for `kill-buffer', at least when used interactively.
1057 ;; Should not just redefine `kill-buffer', because some programs count on a
1058 ;; specific other buffer taking the place of the killed buffer (in the window).
1059 ;;;###autoload
1060 (defun kill-buffer-and-its-windows (buffer)
1061 "Kill BUFFER and delete its windows. Default is `current-buffer'.
1062 BUFFER may be either a buffer or its name (a string)."
1063 (interactive (list (read-buffer "Kill buffer: " (current-buffer) 'existing)))
1064 (setq buffer (get-buffer buffer))
1065 (if (buffer-live-p buffer) ; Kill live buffer only.
1066 (let ((wins (get-buffer-window-list buffer nil t))) ; On all frames.
1067 (when (and (buffer-modified-p buffer)
1068 (fboundp '1on1-flash-ding-minibuffer-frame))
1069 (1on1-flash-ding-minibuffer-frame t)) ; Defined in `oneonone.el'.
1070 (when (kill-buffer buffer) ; Only delete windows if buffer killed.
1071 (dolist (win wins) ; (User might keep buffer if modified.)
1072 (when (window-live-p win) (delete-window win)))))
1073 (when (interactive-p)
1074 (error "Cannot kill buffer. Not a live buffer: `%s'" buffer))))
1075
1076 ;;; Like `clone-indirect-buffer' of Emacs 21.
1077 ;;;###autoload
1078 (defun indirect-buffer ()
1079 "Edit stuff in this buffer in an indirect-buffer window.
1080 The indirect buffer can have a different major mode from current."
1081 (interactive)
1082 (let ((buffer-name (generate-new-buffer-name "*indirect*")))
1083 (pop-to-buffer (make-indirect-buffer (current-buffer) buffer-name))))
1084
1085 ;;;###autoload
1086 (defalias 'clear-search-ring 'clear-search-history)
1087 ;;;###autoload
1088 (defun clear-search-history (&optional regexp-too-p)
1089 "Clear the search history (empty it).
1090 With prefix arg, clear also the regular-expression search history."
1091 (interactive "P")
1092 (setq search-ring ())
1093 (when regexp-too-p (setq regexp-search-ring nil)))
1094
1095 ;;;###autoload
1096 (defalias 'clear-regexp-search-ring 'clear-regexp-search-history)
1097 ;;;###autoload
1098 (defun clear-regexp-search-history (&optional simple-too-p)
1099 "Clear the regular-expression search history (empty it).
1100 With prefix arg, clear also the simple search history."
1101 (interactive "P")
1102 (setq regexp-search-ring ())
1103 (when simple-too-p (setq search-ring nil)))
1104
1105 ;;;###autoload
1106 (defun clear-search-histories ()
1107 "Clear both search histories: simple search and regexp search."
1108 (interactive)
1109 (setq regexp-search-ring ())
1110 (setq search-ring nil))
1111
1112 ;;;###autoload
1113 (defun revert-buffer-no-confirm ()
1114 "Revert buffer without confirmation."
1115 (interactive) (revert-buffer t t))
1116
1117 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1118 ;;; misc-cmds.el ends here