[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
misc-cmds.el - miscellaneous commands (interactive functions)
|
From: |
Drew Adams |
|
Subject: |
misc-cmds.el - miscellaneous commands (interactive functions) |
|
Date: |
Tue, 16 Jan 2001 21:35:20 -0500 |
;;; misc-cmds.el --- Miscellaneous commands (interactive functions).
;;
;; Emacs Lisp Archive Entry
;; Filename: misc-cmds.el
;; Description: Miscellaneous commands (interactive functions).
;; Author: Drew Adams
;; Maintainer: Drew Adams
;; Copyright (C) 1996-2001, Drew Adams, all rights reserved.
;; Created: Wed Aug 2 11:20:41 1995
;; Version: $Id: misc-cmds.el,v 1.5 2001/01/08 23:26:38 dadams Exp $
;; Last-Updated: Mon Jan 8 15:26:33 2001
;; By: dadams
;; Update #: 1771
;; Keywords: internal, unix, extensions, maint, local
;; Compatibility: GNU Emacs 20.x
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; Miscellaneous commands (interactive functions).
;;
;; Main new functions defined here:
;;
;; `chgrp', `chmod', `chown', `delete-lines',
;; `exit-with-confirmation', `forward-char-same-line',
;; `forward-overlay', `goto-previous-global-mark',
;; `goto-previous-mark', `kill-buffer-and-its-windows', `no-op',
;; `read-shell-file-command', `region-to-buffer', `region-to-file',
;; `view-X11-colors', `yank-secondary'.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Change log:
;;
;; RCS $Log: misc-cmds.el,v $
;; RCS Revision 1.5 2001/01/08 23:26:38 dadams
;; RCS Adapted file header for Emacs Lisp Archive.
;; RCS
;; RCS Revision 1.4 2001/01/03 17:40:54 dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.3 2001/01/03 00:55:33 dadams
;; RCS *** empty log message ***
;; RCS
;; RCS Revision 1.2 2000/11/28 20:27:26 dadams
;; RCS Optional require's via 3rd arg=t now.
;; RCS
;; RCS Revision 1.1 2000/09/14 17:23:10 dadams
;; RCS Initial revision
;; RCS
; Revision 1.3 1999/04/13 12:45:52 dadams
; Added: delete-lines.
;
; Revision 1.2 1999/03/17 14:56:52 dadams
; 1. Removed: update-file-autoloads, display-buffer.
; 2. Removed require: autoload, elect-mbuf.
; 3. Protect with fboundp.
; 4. Commented out: xwud, display-xwd-image-file, xwd,
; capture-image-as-xwd-file, display-buffer.
; 5. kill-buffer-and-its-windows: use get-buffer-window-list.
;
; Revision 1.1 1997/03/19 14:33:27 dadams
; Initial revision
;
; Revision 1.14 1996/06/20 12:00:29 dadams
; (trivial: Don't require help.el.)
;
; Revision 1.13 1996/06/06 14:22:29 dadams
; 1. Require help.el.
; 2. Update of file dependency comments (e.g. "Autoloaded from...").
;
; Revision 1.12 1996/06/03 11:35:15 dadams
; display-xwd-image-file: Do via background processes:
; shell-command -> start-process-shell-command.
;
; Revision 1.11 1996/06/03 09:44:39 dadams
; display-xwd-image-file:
; 1. Allow XWD-FILE arg as list. Added DIR arg.
; 2. No longer provide -noclick option by default.
;
; Revision 1.10 1996/04/26 09:59:15 dadams
; Put escaped newlines on long-line strings.
;
; Revision 1.9 1996/04/24 09:54:59 dadams
; Added: read-shell-file-command, chmod, chgrp, chown.
;
; Revision 1.8 1996/04/23 14:45:38 dadams
; Added display-xwd-image-file (xwud) and capture-image-as-xwd-file (xwd).
;
; Revision 1.7 1996/04/23 11:23:59 dadams
; Added: goto-previous-mark, goto-previous-global-mark.
;
; Revision 1.6 1996/04/18 14:21:40 dadams
; (trivial)
;
; Revision 1.5 1996/04/16 08:17:42 dadams
; Added declp-buffer-w-switches and declp-region-w-switches.
;
; Revision 1.4 1996/04/05 14:32:36 dadams
; Improved Commentary: List redefinitions.
;
; Revision 1.3 1996/03/20 16:13:58 dadams
; no-op, exit-with-confirmation, view-X11-colors, forward-overlay,
; update-file-autoloads, declp-buffer, declp-region, yank-secondary:
; defun -> defsubst
;
; Revision 1.2 1996/03/08 13:27:23 dadams
; drew-windows.el -> frame-fns.el, drew-util-19.el -> misc-fns.el.
;
; Revision 1.1 1996/03/05 14:56:47 dadams
; Initial revision
;
; Revision 1.40 1996/02/28 16:45:12 dadams
; 1. Added forward-overlay.
; 2. Moved forward-char-same-line here from drew-util-19.el.
;
; Revision 1.39 1996/02/15 14:24:53 dadams
; Added yank-secondary.
;
; Revision 1.38 1996/02/12 09:23:04 dadams
; Updated header keywords (for finder).
;
; Revision 1.37 1996/02/08 17:30:27 dadams
; Removed show-*Help*-buffer to drew-window-cmds.el.
;
; Revision 1.36 1996/02/06 10:54:23 dadams
; Put variable-interactive property on appropriate user option vars.
;
; Revision 1.35 1996/02/05 15:12:18 dadams
; 1. Added: default-pr-switches, declp-switches, declp-sheet-options.
; 2. lpr-command -> declp-command, print-region-1 -> declp-region-1.
; 3. lpr-switches is no longer used.
; 4. declp-buffer,declp-region,pr-declp-buffer,pr-declp-region: Optional args.
; 5. pr-declp-buffer, pr-declp-region, declp-region-1:
; Proper treatment of pr switches; pr error treatment; No BSD lpr shortcut.
; 6. :::###autoload region-to-buffer and region-to-file.
;
; Revision 1.34 1996/01/30 14:34:43 dadams
; Removed to new file replace+.el: query-replace, occur.
; No longer require drew-faces.el.
;
; Revision 1.33 1996/01/30 10:14:11 dadams
; raise-*Help*-buffer -> show-*Help*-buffer. Use show-a-frame-on (don't select)
; occur: Raise *Occur* buffer.
;
; Revision 1.32 1996/01/25 16:14:19 dadams
; kill-buffer-and-its-windows: Added args to call to windows-on.
;
; Revision 1.31 1996/01/16 08:46:44 dadams
; Removed: lpr2-buffer, pr2-buffer, lpr2-region, pr2-region.
; Added: read-number-up, declp-buffer, declp-region,
; pr-declp-buffer, pr-declp-region.
;
; Revision 1.30 1996/01/12 16:57:21 dadams
; 1. Changed lp2-* and pr2-* cmds to allow for N-up.
; 2. Added region-to-buffer, region-to-file.
; 3. Removed list-buffers.
;
; Revision 1.29 1996/01/09 09:12:08 dadams
; kill-buffer-delete-frames replaced by (new) kill-buffer-and-its-windows.
;
; Revision 1.28 1996/01/08 13:51:22 dadams
; 1. Added redefinition of display-buffer that raises frame.
; 2. query-replace: message -> display-in-minibuffer. Require drew-faces.el.
;
; Revision 1.27 1996/01/02 16:38:56 dadams
; Removed `switch-to-buffer' to `files+.el'.
;
; Revision 1.26 1995/12/28 15:04:14 dadams
; Removed requires for drew-windows.el and drew-util-19.el, since autoloaded.
;
; Revision 1.25 1995/12/12 16:49:18 dadams
; 1. Removed to new file drew-window-cmds.el: iconify-everything,
; iconify/map-frame, mouse-iconify/map-frame, mouse-tear-off-window,
; rename-frame, show-frame, hide-frame, delete-1-window-frames-on,
; delete-window.
; 2. Removed to drew-windows.el: delete-windows-on.
; 3. Added list-buffers (replacement for original).
;
; Revision 1.24 1995/12/01 14:19:08 dadams
; Removed to new file kill-reg-back.el:
; self-insert-kill-region-backward, use-self-insert-command,
; use-self-insert-kill-region-backward, kill-region-backward,
; toggle-self-insert-kill-region-backward, default-DEL-commands,
; memorize-default-DEL-command, use-kill-region-backward,
; use-default-DEL-command, toggle-kill-region-backward.
;
; Revision 1.23 1995/12/01 08:20:32 dadams
; Improved doc strings (cosmetic).
;
; Revision 1.22 1995/11/30 16:49:46 dadams
; Moved fset's to col 1 so imenu picks them up (cosmetic).
;
; Revision 1.21 1995/11/30 13:12:59 dadams
; Added self-insert-kill-region-backward, use-self-insert-kill-region-backward,
; toggle-self-insert-kill-region-backward, use-self-insert-command.
;
; Revision 1.20 1995/11/30 10:46:47 dadams
; Added fns to be able to kill region backward:
; kill-region-backward, use-kill-region-backward, toggle-kill-region-backward,
; default-DEL-commands, memorize-default-DEL-command,use-default-DEL-command.
;
; Revision 1.19 1995/11/28 16:44:02 dadams
; 1. Added redefinition of update-file-autoloads. Require autoload.el.
; 2. Require that drew-misc-19.el be loaded before compile it, so
; `old-*'s get defined.
;
; Revision 1.18 1995/11/28 15:27:03 dadams
; Added a few missing autoloads.
;
; Revision 1.17 1995/11/28 13:52:23 dadams
; Added `occur' from replace.el: Changed its interactive default to
; (symbol-around-point).
;
; Revision 1.16 1995/11/22 15:11:30 dadams
; Require drew-windows.el.
;
; Revision 1.15 1995/10/31 13:05:15 dadams
; (trivial - Keywords)
;
; Revision 1.14 1995/09/04 15:19:43 dadams
; Added redefinition of delete-windows-on (deletes 1-window frames too).
;
; Revision 1.13 1995/09/04 13:56:35 dadams
; Changed header to GNU std.
;
; Revision 1.12 1995/08/29 15:07:56 dadams
; delete-1-window-frames-on: Don't (set-buffer buffer).
;
; Revision 1.11 1995/08/24 13:14:59 dadams
; 1) Added view-X11-colors. 2) flash-ding ->
; flash-ding-minibuffer-frame.
;
; Revision 1.10 1995/08/18 15:10:52 dadams
; kill-buffer-delete-frames: Flash-ding when buffer-modified to draw
; attention to kill-buffer's yes-or-no-p msg.
;
; Revision 1.9 1995/08/18 06:23:57 dadams
; 1) Added no-op, pr2-buffer, pr2-region, pr2-2up-buffer, pr2-2up-region.
; 2) rename-frame: Accepts frame as old-name arg.
; 3) show-frame: Raise frame too. Accepts frame as arg.
; 4) Added local version of print-region-1. Load-library lpr.el.
;
; Revision 1.8 1995/08/16 08:54:23 dadams
; 1) Added rename-frame.
; 2) iconify-everything, iconify/map-frame, mouse-iconify/map-frame:
; Rename frame first.
;
; Revision 1.7 1995/08/11 06:22:58 dadams
; *** empty log message ***
;
; Revision 1.6 1995/08/10 06:30:52 dadams
; Added kill-this-buffer.
;
; Revision 1.5 1995/08/08 15:04:23 dadams
; 1) Added: mouse-tear-off-window, mouse-iconify/map-frame.
; 2) Removed bindings to start.el
; 3) delete-window: When the only window on frame, delete the frame.
;
; Revision 1.4 1995/08/08 12:54:08 dadams
; 1) Provide this.
; 2) Added: exit-with-confirmation, (new) delete-window, (new)
; switch-to-buffer, lpr stuff.
; 3) Autoload lpr.
;
; Revision 1.3 1995/08/04 14:54:13 dadams
; Added: show-frame, hide-frame, delete-1-window-frames-on,
; kill-buffer-delete-frames.
; Removed to start.el: define-key M-j.
; Require drew-util-19.el & elect-mbuf.el
;
; Revision 1.2 1995/08/02 15:05:22 dadams
; query-replace: symbol-around-point is default for NEW (OLD is avail via M-p).
;
; Revision 1.1 1995/08/02 09:21:44 dadams
; Initial revision
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
(require 'cl) ;; dolist, when, decf
(require 'frame-fns nil t) ;; (no error if not found): flash-ding
(provide 'misc-cmds)
(require 'misc-cmds) ; Ensure loaded before compile this.
;;;;;;;;;;;;;;;;;;;;;;;
(defsubst no-op (&rest args)
"Command that does nothing and returns nil. Any arguments are ignored."
(interactive))
;; Adapted from Epoch distribution file `dot.emacs'.
(defsubst exit-with-confirmation ()
"Exit Emacs, after confirming that you want to exit."
(interactive)
(when (y-or-n-p "Do you really want to exit Emacs? ")
(save-buffers-kill-emacs)))
(defsubst view-X11-colors ()
"View file `/usr/lib/X11/rgb.txt', which lists available X11 colors."
(interactive) (view-file-other-window "/usr/lib/X11/rgb.txt")) ; In `view.el'.
(defsubst forward-overlay (&optional arg)
"Move forward ARG overlays.
Move cursor to next position where an overlay starts or ends.
If there are no more overlay boundaries, move to (point-max)."
(interactive "p")
(decf arg)
(while (natnump arg) (goto-char (next-overlay-change (point))) (decf arg)))
;;;###autoload
(defun forward-char-same-line (&optional arg)
"Move forward a max of ARG chars on the same line, or backward if ARG < 0.
Returns the signed number of chars moved if /= ARG, else returns nil."
(interactive "p")
(let* ((start (point))
(fwd-p (natnump arg))
(max (save-excursion
(if fwd-p (end-of-line) (beginning-of-line))
(- (point) start))))
(forward-char (if fwd-p (min max arg) (max max arg)))
(and (< (abs max) (abs arg)) max)))
;;;;;;###autoload
;;;(defvar default-pr-switches "-fl68"
;;; "*String of default switches to pass to `pr'.
;;;These may be overridden in `pr-declp-buffer' and `pr-declp-region'.")
;;;(put 'default-pr-switches 'variable-interactive
;;; "sDefault switches to pass to `pr' (e.g. \"-fl68\"): ")
;;;;;;###autoload
;;;(defvar declp-switches nil
;;; "*List of strings to pass as extra switch args to `declp-command'.")
;;;;;;###autoload
;;;(defvar declp-command "declp" "*Shell command for printing a file.
;;;Should usually be either \"declp\" or \"declpt\".")
;;;(put 'declp-command 'variable-interactive
;;; "sShell command for printing a file. (\"declp\" or \"declpt\"): ")
;;;(defmacro declp-sheet-options (number-up)
;;; (` (if (and (integerp (, number-up)) (not (zerop (, number-up))))
;;; (if (natnump (, number-up))
;;; (format " -K 2 -N %d " (, number-up))
;;; (format " -N %d " (, number-up)))
;;; "")))
;;;;;;###autoload
;;;(defun declp-buffer-w-switches ()
;;; "Print buffer using `declp-command' and switches that you specify.
;;;Variable `declp-switches' is a list of proposed default switches."
;;; (interactive)
;;; (let ((cmd (read-from-minibuffer
;;; (concat "Print buffer `" (buffer-name) "' with command: ")
;;; (apply 'concat declp-command " " declp-switches) nil nil
;;; 'minibuffer-history)))
;;; (save-restriction (widen) (message "Spooling ...")
;;; (shell-command-on-region (point-min) (point-max) cmd)))
;;; (message "Spooling ... done."))
;;;(defsubst declp-buffer (&optional number-up)
;;; "Print buffer contents using `declp-command'.
;;;NUM-UP pages are printed on a side of paper, bordered by a rectangle
;;;if NUM-UP is a non-zero integer. NUM-UP is the prefix arg, if any.
;;;Otherwise you are prompted for NUM-UP.
;;; NUM-UP > 0 => Print on both sides of paper.
;;; NUM-UP < 0 => Only print on one side of paper.
;;; Otherwise => Print 1 page per sheet, on one side of paper, and
;;; do not print a rectangular border around each page.
;;;Global variable `declp-switches' is a list of switches (strings)
;;;for `declp-command'."
;;; (interactive (list (if current-prefix-arg
;;; (prefix-numeric-value current-prefix-arg)
;;; (read-number-up 'declp-buffer))))
;;; (declp-region-1 (point-min) (point-max)
;;; (cons (declp-sheet-options number-up) declp-switches)))
;;;;;;###autoload
;;;(defun declp-region-w-switches (start end)
;;; "Print region using `declp-command' and switches that you specify.
;;;Variable `declp-switches' is a list of proposed default switches."
;;; (interactive "r")
;;; (let ((cmd (concat (read-from-minibuffer
;;; (concat "Print region with command: ")
;;; (apply 'concat declp-command " " declp-switches) nil
nil
;;; 'minibuffer-history))))
;;; (message "Spooling ...")
;;; (shell-command-on-region start end cmd))
;;; (message "Spooling ... done."))
;;;(defsubst declp-region (start end &optional number-up)
;;; "Print region contents using `declp-command'.
;;;NUM-UP pages are printed on a side of paper, bordered by a rectangle
;;;if NUM-UP is a non-zero integer. NUM-UP is the prefix arg, if any.
;;;Otherwise you are prompted for NUM-UP.
;;; NUM-UP > 0 => Print on both sides of paper.
;;; NUM-UP < 0 => Only print on one side of paper.
;;; Otherwise => Print 1 page per sheet, on one side of paper, and
;;; do not print a rectangular border around each page.
;;;Global variable `declp-switches' is a list of switches (strings)
;;;for `declp-command'."
;;; (interactive (list (region-beginning) (region-end)
;;; (if current-prefix-arg
;;; (prefix-numeric-value current-prefix-arg)
;;; (read-number-up 'declp-region))))
;;; (declp-region-1 start end
;;; (cons (declp-sheet-options number-up) declp-switches)))
;;;;;;###autoload
;;;(defun pr-declp-buffer (&optional number-up pr-switches)
;;; "Print buffer with page headings using `declp-command'.
;;;The Unix `pr' command is used to provide the page headings.
;;;You are prompted for PR-SWITCHES, which is a string of switches
;;;to the `pr' command. For information on `pr', type `\\[manual-entry] pr'.
;;;\(Note: The `-m' option to `pr' makes no sense in this context.)
;;;NUM-UP pages are printed on a side of paper, bordered by a rectangle
;;;if NUM-UP is a non-zero integer. NUM-UP is the prefix arg, if any.
;;;Otherwise you are prompted for NUM-UP.
;;; NUM-UP > 0 => Print on both sides of paper.
;;; NUM-UP < 0 => Only print on one side of paper.
;;; Otherwise => Print 1 page per sheet, on one side of paper, and
;;; do not print a rectangular border around each page.
;;;Global variables:
;;;`declp-switches' is a list of switches (strings) for `declp-command'.
;;;`default-pr-switches' is a string of default switches for `pr'.
;;;Switches in PR-SWITCHES override those in `default-pr-switches'."
;;; (interactive
;;; (let (pr-opt
;;; (pr-opts ()))
;;; (list (if current-prefix-arg
;;; (prefix-numeric-value current-prefix-arg)
;;; (read-number-up 'pr-declp-region))
;;; (progn
;;; (setq pr-opts (list (read-from-minibuffer "Page title: "
;;; (cons (buffer-name)
1))
;;; "-h")) ; Order reversed below to '-h title'.
;;; (while (not (string= "" pr-opt))
;;; (push (setq pr-opt (read-from-minibuffer
;;; "Switches for `pr' (RET to end): "))
;;; pr-opts))
;;; (pop pr-opts) ; ""
;;; (nreverse pr-opts)))))
;;; (declp-region-1 (point-min) (point-max)
;;; (cons (declp-sheet-options number-up) declp-switches)
;;; (or pr-switches ""))) ; Non-nil for pr.
;;;;;;###autoload
;;;(defun pr-declp-region (start end &optional &optional number-up pr-switches)
;;; "Print region with page headings using `declp-command'.
;;;The Unix `pr' command is used to provide the page headings.
;;;You are prompted for PR-SWITCHES, which is a string of switches
;;;to the `pr' command. For information on `pr', type `\\[manual-entry] pr'.
;;;\(Note: The `-m' option to `pr' makes no sense in this context.)
;;;NUM-UP pages are printed on a side of paper, bordered by a rectangle
;;;if NUM-UP is a non-zero integer. NUM-UP is the prefix arg, if any.
;;;Otherwise you are prompted for NUM-UP.
;;; NUM-UP > 0 => Print on both sides of paper.
;;; NUM-UP < 0 => Only print on one side of paper.
;;; Otherwise => Print 1 page per sheet, on one side of paper, and
;;; do not print a rectangular border around each page.
;;;Global variables:
;;;`declp-switches' is a list of switches (strings) for `declp-command'.
;;;`default-pr-switches' is a string of default switches for `pr'.
;;;Switches in PR-SWITCHES override those in `default-pr-switches'."
;;; (interactive
;;; (let (pr-opt
;;; (pr-opts ()))
;;; (list (region-beginning) (region-end)
;;; (if current-prefix-arg
;;; (prefix-numeric-value current-prefix-arg)
;;; (read-number-up 'pr-declp-region))
;;; (progn
;;; (setq pr-opts (list (read-from-minibuffer "Page title: ") "-h"))
;;; (while (not (string= "" pr-opt))
;;; (push (setq pr-opt (read-from-minibuffer
;;; "Switches for `pr' (RET to end): "))
;;; pr-opts))
;;; (pop pr-opts) ; ""
;;; (nreverse pr-opts)))))
;;; (declp-region-1 start end
;;; (cons (declp-sheet-options number-up) declp-switches)
;;; (or pr-switches ""))) ; Non-nil for pr.
;;;;; Adapted from `print-region-1' in `lpr.el'.
;;;(defun declp-region-1 (start end switches &optional page-headers)
;;; ;; On some MIPS system, having a space in the job name
;;; ;; crashes the printer demon. But using dashes looks ugly
;;; ;; and it seems too annoying to do for those MIPS systems.
;;; (let ((name (concat (buffer-name) " Emacs buffer"))
;;; (title (concat (buffer-name) " Emacs buffer"))
;;; (width tab-width))
;;; (save-excursion
;;; (when (/= tab-width 8)
;;; (print-region-new-buffer start end)
;;; (setq tab-width width)
;;; (save-excursion (goto-char end) (setq end (point-marker)))
;;; (untabify (point-min) (point-max)))
;;; ;; Filter region through `pr'.
;;; (message "Filtering with `pr' ...")
;;; (when page-headers
;;; (print-region-new-buffer start end)
;;; (when (not (zerop (apply 'call-process-region start end "pr" t t nil
;;; default-pr-switches page-headers)))
;;; (display-buffer " *spool temp*")
;;; (error "Error in switches to `pr'."))
;;; (setq start (point-min))
;;; (setq end (point-max)))
;;; (message "Spooling ...")
;;; (apply 'shell-command-on-region
;;; (list start end (apply 'concat declp-command " " switches)))
;;; (when (markerp end) (set-marker end nil))
;;; (message "Spooling ... done."))))
;;;(defun read-number-up (fn)
;;; "Read NUMBER-UP argument for a declp print function,
;;;`declp-buffer', `declp-region', `pr-declp-buffer', or `pr-declp-region'."
;;; (let ((prompt "Number of pages per sheet of paper (`?' for help): ")
;;; input)
;;; (while (not (and (condition-case nil (setq input (read-minibuffer
prompt))
;;; (error nil)) ; Read a non-Lisp expression.
;;; (numberp input))) ; Read a Lisp sexp, but not a number.
;;; (save-window-excursion (describe-function fn))) ; Defined in `help.el'.
;;; (round input))) ; Convert floating point to integer.
(defsubst yank-secondary ()
"Insert the secondary selection at point.
Moves point to the end of the inserted text. Does not change mark."
(interactive) (insert (x-get-selection 'SECONDARY)))
(defsubst goto-previous-mark ()
"Jump to previous mark, rotating the (local) `mark-ring'.
Does not affect the `global-mark-ring'.
This is equivalent to `set-mark-command' with a non-nil argument."
(interactive) (set-mark-command t))
;;;###autoload
(defun goto-previous-global-mark (&optional pop-p)
"Jump to previous global mark, rotating the `global-mark-ring'.
With a non-nil prefix arg, this just does a `pop-global-mark'."
(interactive "P")
;; `pop-global-mark', then put popped mark at end of `global-mark-ring'.
;; 1. `pop-global-mark':
;; (It's inlined here to keep access to MARKER for #2, below.)
(while (and global-mark-ring (not (marker-buffer (car global-mark-ring))))
(pop global-mark-ring)) ;; Pop entries which refer to non-existent buffers.
(unless global-mark-ring (error "No global mark set."))
(let* ((marker (car global-mark-ring))
(buffer (marker-buffer marker))
(position (marker-position marker)))
(when (and (eq (point-marker) marker) (atom (cdr global-mark-ring)))
(error "No other global marks."))
(pop global-mark-ring)
(set-buffer buffer)
(unless (and (>= position (point-min)) (<= position (point-max))) (widen))
(goto-char position)
(switch-to-buffer buffer)
;; 2. Put popped mark at end of `global-mark-ring'.
(unless pop-p
(setq global-mark-ring (nconc global-mark-ring (list marker))))))
;;;###autoload
(defun region-to-buffer (start end buffer app-pre-p)
"Copy region to BUFFER: At beginning (prefix >= 0), end (< 0), or replace.
With prefix arg >= 0: `append-to-buffer':
Append contents of region to end of BUFFER.
(Point is moved to end of BUFFER first.)
With prefix arg < 0: `prepend-to-buffer':
Prepend contents of region to beginning of BUFFER.
(Point is moved to beginning of BUFFER first.)
With no prefix arg: `copy-to-buffer'.
Write region to BUFFER, replacing any previous contents.
BUFFER is a buffer or its name (a string)."
(interactive
(let ((arg (and current-prefix-arg
(prefix-numeric-value current-prefix-arg))))
(list (region-beginning) (region-end)
(read-buffer (concat (if arg
(if (natnump arg) "Append" "Prepend")
"Write")
" region to buffer: ")
(other-buffer))
arg)))
(setq buffer (get-buffer-create buffer)) ; Convert to buffer.
(when (eq buffer (current-buffer))
(error "Cannot copy region to its own buffer."))
(cond ((natnump app-pre-p)
(save-excursion (set-buffer buffer) (goto-char (point-max)))
(append-to-buffer buffer start end))
(app-pre-p
(save-excursion (set-buffer buffer) (goto-char (point-min)))
(prepend-to-buffer buffer start end))
(t (copy-to-buffer buffer start end))))
;;;###autoload
(defun region-to-file (start end filename append-p)
"With prefix arg, this is `append-to-file'. Without, it is `write-region'.
With prefix arg, append contents of region to end of file FILENAME.
Without, write region to FILENAME, replacing any previous contents."
(interactive
(list (region-beginning) (region-end)
(read-file-name (concat (if current-prefix-arg "Append" "Write")
" region to file: "))
current-prefix-arg))
(let* ((curr-file (buffer-file-name))
(same-file-p (and curr-file (string= curr-file filename))))
(cond ((or (not same-file-p)
(progn
(when (fboundp 'flash-ding) (flash-ding))
(yes-or-no-p
(format
"Do you really want to REPLACE the contents of `%s' by \
just the REGION? "
(file-name-nondirectory curr-file)))))
(write-region start end filename append-p)
(when same-file-p (revert-buffer t t)))
(t (message "OK. Not written.")))))
;(defalias 'xwud 'display-xwd-image-file)
;;;;###autoload
;(defun display-xwd-image-file (xwd-file &optional options dir)
; "Display an xwd image file XWD-FILE using the Unix `xwud' command.
;Arg XWD-FILE is a string naming the file, or else a list of such
;strings (non-interactively).
;If XWD-FILE is a list, then each of the files named in it is displayed
;in turn, a mouse click on an image causing it to be replaced by the
;next one. In this case, relative file names are taken as relative to
;the directory DIR (the optional third arg), which defaults to the
;current `default-directory'.
;A non-nil prefix arg => You are prompted for `xwud' options.
;For a list of possible options, type \"-help\" as an option.
;For more information, type `\\[manual-entry] xwud'.
;Output from the `xwud' processes is put into buffer \"*XWD Display*\",
;but that buffer is not displayed."
; (interactive "F*.xwd file to display: \nP")
; (when (and options (not (stringp options)))
; (setq options (read-from-minibuffer "`xwud' options: " nil nil nil
; 'minibuffer-history)))
; (setq dir (or dir default-directory))
; (if (listp xwd-file)
; (dolist (file xwd-file)
; (funcall 'display-xwd-image-file (expand-file-name file dir) options))
; (let ((buf (get-buffer-create "*XWD Display*")))
; (save-excursion (set-buffer buf) (erase-buffer))
; (start-process-shell-command "xwud" buf "xwud"
; (concat options " -in " xwd-file)))))
;;;; TO TEST:
;;;;(display-xwd-image-file
;;;; (directory-files "~/ICONS" nil "drew-poster.+\.xwd$" t) nil "~/ICONS")
;(defalias 'xwd 'capture-image-as-xwd-file)
;;;;###autoload
;(defun capture-image-as-xwd-file (xwd-file &optional options)
; "Capture an X window image as an *.xwd file via Unix `xwd' command.
;The \"-nobdrs\" `xwd' option is provided by default.
;A non-nil prefix arg => You are prompted for `xwd' options.
;For a list of options, type \"-help\" as an option.
;For more information, type `\\[manual-entry] xwud'."
; (interactive "F*.xwd image file to create: \nP")
; (if options
; (unless (stringp options)
; (setq options (read-from-minibuffer "`xwd' options: " " -nobdrs "
; nil nil 'minibuffer-history)))
; (setq options " -nobdrs "))
; (message
; "Click in X window you want to capture as image file `%s'." xwd-file)
; (shell-command (concat "xwd " options " -out " xwd-file)))
;;;###autoload
(defun read-shell-file-command (command)
"Prompt for shell COMMAND, using current buffer's file as default arg.
If buffer is not associated with a file, you are prompted for a file."
(let ((file (or (buffer-file-name) (read-file-name "File: "))))
(setq file (and file (file-name-nondirectory file)))
(setq command (format "%s " command)) ; Convert to string.
(read-from-minibuffer
"" (cons (concat command (and file (concat " " file)))
(length command)))))
(defsubst chmod (cmd)
"Execute Unix command `chmod'. Current buffer's file is default arg."
(interactive (list (read-shell-file-command 'chmod)))
(shell-command cmd))
(defsubst chgrp (cmd)
"Execute Unix command `chgrp'. Current buffer's file is default arg."
(interactive (list (read-shell-file-command 'chgrp)))
(shell-command cmd))
(defsubst chown (cmd)
"Execute Unix command `chown'. Current buffer's file is default arg."
(interactive (list (read-shell-file-command 'chown)))
(shell-command cmd))
;; If bound to, say, [M-S-backspace], this gives you a quick way
;; to clear,say, default minibuffer input.
;;;###autoload
(defun delete-lines (num-lines)
(interactive "p")
"Delete NUM-LINES lines, starting at point.
Lines are deleted, not killed.
With positive prefix arg, deletion is forward.
With negative prefix arg, deletion is backward."
(when (not (zerop num-lines))
(let ((column (current-column))
(forward-p (natnump num-lines)))
(if forward-p
(beginning-of-line)
(end-of-line))
(let ((beg (point)))
(forward-line (if forward-p
(1- num-lines)
(1+ num-lines)))
(if forward-p
(end-of-line)
(beginning-of-line))
(delete-region beg (point)))
(when (eq (following-char) ?\n)
(delete-char 1))
(move-to-column column))))
;; ***** NOTE: The following EMACS PRIMITIVE has been REDEFINED HERE:
;;
;; `display-buffer' - Raises frame too.
;(or (fboundp 'old-display-buffer)
;(fset 'old-display-buffer (symbol-function 'display-buffer)))
;;; REPLACES ORIGINAL (C source code?): Raises frame too.
;;;;###autoload
;(defun display-buffer (buffer &optional not-this-window)
; "Make BUFFER appear in some window but don't select it.
;BUFFER can be a buffer or a buffer name. Returns the window.
;If BUFFER is shown already in some window, just use that one,
;unless it is the selected window and the optional second arg
;NOT-THIS-WINDOW is non-nil (interactively, with prefix arg).
;Raises the frame in which buffer is already shown.
;If `pop-up-frames' is non-nil, make a new frame if no window
;shows BUFFER."
; (interactive (list (read-buffer "Display buffer: " (other-buffer) 'existing)
; current-prefix-arg))
; (let ((win (get-buffer-window buffer t)))
; (if (or not-this-window (not win))
; (old-display-buffer buffer not-this-window)
; (raise-frame (window-frame win))
; win))) ; Return the window.
;; Candidate as replacement for `kill-buffer', at least when used interactively.
;; Should not just redefine `kill-buffer', because some programs count on a
;; specific other buffer taking the place of the killed buffer (in the window).
;;;###autoload
(defun kill-buffer-and-its-windows (buffer)
"Kill BUFFER and delete its windows. Default is `current-buffer'.
BUFFER may be either a buffer or its name (a string)."
(interactive (list
(read-buffer "Kill buffer : " (current-buffer) 'existing)))
(setq buffer (get-buffer buffer))
(cond ((buffer-live-p buffer) ; Kill live buffer only.
(let ((wins (get-buffer-window-list buffer nil t))) ; On all frames.
(when (and (buffer-modified-p buffer)
(fboundp 'flash-ding-minibuffer-frame))
(flash-ding-minibuffer-frame t)) ; Defined in `setup-frames.el'.
(when (kill-buffer buffer) ; Only delete windows if buffer killed.
(dolist (win wins) ; (User might keep buffer if modified.)
(when (window-live-p win) (delete-window win))))))
((interactive-p)
(error "Cannot kill buffer. Not a live buffer: `%s'." buffer))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; `misc-cmds.el' ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- misc-cmds.el - miscellaneous commands (interactive functions),
Drew Adams <=