Download
(eval-when-compile (when (< emacs-major-version 21) (require 'cl)))
(require 'strings)
(when (< emacs-major-version 22)
(defvar compilation-highlight-overlay)
(defvar next-error-function)
(defvar next-error-last-buffer)
(defvar next-error-recenter))
(when (> emacs-major-version 21)
(defcustom next-error-highlight 0.5
"*Highlighting of the current locus in selected source buffer.
Highlighting means use face `next-error' or show a fringe arrow.
Value:
* `fringe-arrow' means indicate the locus using a fringe arrow (which
is moved when the locus is moved).
* `until-move' means highlight the locus until it is moved.
* A number means highlight the locus for that many seconds, or until
the next command is executed.
* t means highlight the locus until it is moved or the next command is
executed.
* nil means do not highlight the locus at all."
:type '(choice
(number :tag "Highlight locus for specified time")
(const :tag "Highlight locus until move" until-move)
(const :tag "Highlight locus until move or next command" t)
(const :tag "Do not highlight locus" nil)
(const :tag "Indicate locus using fringe arrow" fringe-arrow))
:group 'next-error
:version "22.1"))
(when (> emacs-major-version 21)
(defcustom next-error-highlight-no-select 0.5
"*Highlighting of locations in `next-error-no-select'.
Highlighting means use face `next-error' or show a fringe arrow.
Value:
* `fringe-arrow' means indicate the locus using a fringe arrow (which
is moved when the locus is moved)..
* `until-move' means highlight the locus until it is moved.
* A number means highlight the locus for that many seconds, or until
the next command is executed.
* t means highlight the locus until it is moved or the next command is
executed.
* nil means do not highlight the locus at all."
:type '(choice
(number :tag "Highlight locus for specified time")
(const :tag "Highlight locus until move" until-move)
(const :tag "Highlight locus until move or next command" t)
(const :tag "Do not highlight locus" nil)
(const :tag "Indicate locus using fringe arrow" fringe-arrow))
:group 'next-error
:version "22.1"))
(when (> emacs-major-version 21)
(defun next-error (&optional arg reset)
"Visit next `next-error' message and corresponding source code.
If all the error messages parsed so far have been processed already,
the message buffer is checked for new ones.
A numeric prefix ARG specifies how many error messages to move;
negative means move back to previous error messages.
Plain `\\[universal-argument]' means reparse the error message buffer and start at the
first error.
`C-u C-u' means just delete the highlight overlay (if any).
The RESET argument specifies that we should restart from the beginning.
`\\[next-error]' normally uses the most recently started
compilation, grep, or occur buffer. It can also operate on any
buffer with output from the \\[compile], \\[grep] commands, or,
more generally, on any buffer in Compilation mode or with
Compilation Minor mode enabled, or any buffer in which
`next-error-function' is bound to an appropriate function.
To specify use of a particular buffer for error messages, type
`\\[next-error]' in that buffer when it is the only one displayed
in the current frame.
Once `\\[next-error]' has chosen the buffer for error messages, it
runs `next-error-hook' with `run-hooks', and stays with that buffer
until you use it in some other buffer which uses Compilation mode
or Compilation Minor mode.
See variables `compilation-parse-errors-function' and
\`compilation-error-regexp-alist' for customization ideas."
(interactive "P")
(if (and (consp arg) (= 16 (prefix-numeric-value arg))
(boundp 'compilation-highlight-overlay)
compilation-highlight-overlay)
(delete-overlay compilation-highlight-overlay)
(when (consp arg) (setq reset t
arg nil))
(when (setq next-error-last-buffer (next-error-find-buffer))
(with-current-buffer next-error-last-buffer
(funcall next-error-function (prefix-numeric-value arg) reset)
(when next-error-recenter (recenter next-error-recenter))
(run-hooks 'next-error-hook))))))
(when (< emacs-major-version 21)
(defun edit-and-eval-command (prompt command)
"Prompting with PROMPT, let user edit COMMAND and eval result.
COMMAND is a Lisp expression. Let user edit that expression in
the minibuffer, then read and evaluate the result."
(let* ((minibuffer-history-sexp-flag t)
(command (read-from-minibuffer
prompt (prin1-to-string command)
read-expression-map t '(command-history . 1))))
(when (stringp (car command-history)) (pop command-history))
(unless (equal command (car command-history)) (push command command-history))
(eval command))))
(defvar set-any-variable-value-history nil
"History of values entered with `set-any-variable'.")
(defun read-var-and-value (read-var-fn set-var-hist-var make-local-p &optional buffer)
"Read a variable name and value.
READ-VAR-FN is a function to read the variable name.
SET-VAR-HIST-VAR is a variable holding a history of variable values.
MAKE-LOCAL-P non-nil means the variable is to be local.
Optional arg BUFFER is the buffer used to determine the current value
of the variable, which is used as the default value when reading the new value."
(let* ((var (funcall read-var-fn "Set variable: "))
(current-val (format "%S"
(if (fboundp 'buffer-local-value)
(buffer-local-value var (or buffer
(current-buffer)))
(if (member var (buffer-local-variables buffer))
(with-current-buffer (or buffer
(current-buffer))
(symbol-value var))
(default-value var)))))
(minibuffer-help-form '(describe-variable var))
(prompt (format "Set %s%s to value: " var
(cond ((local-variable-p var) " (buffer-local)")
((or make-local-p
(local-variable-if-set-p var))
" buffer-locally")
(t " globally"))))
(prop (get var 'variable-interactive))
(val (if prop
(call-interactively `(lambda (arg)
(interactive ,prop) arg))
(read (read-string prompt current-val set-var-hist-var
current-val)))))
(list var val make-local-p)))
(defun set-variable (variable value &optional make-local)
"Set VARIABLE to VALUE. VALUE is a Lisp object.
When using this interactively, enter a Lisp object for VALUE.
If you want VALUE to be a string, you must surround it with doublequotes.
VALUE is used literally, not evaluated.
If VARIABLE has a `variable-interactive' property, that is used as if
it were the arg to `interactive' (which see) to interactively read VALUE.
If VARIABLE has been defined with `defcustom', then the type information
in the definition is used to check that VALUE is valid.
With a prefix argument, set VARIABLE to VALUE buffer-locally."
(interactive (read-var-and-value 'read-variable
'set-variable-value-history
current-prefix-arg
(and (boundp 'icicle-pre-minibuffer-buffer)
icicle-mode
icicle-pre-minibuffer-buffer)))
(and (or (not (fboundp 'custom-variable-p)) (custom-variable-p variable))
(not (get variable 'custom-type))
(custom-load-symbol variable))
(let ((type (get variable 'custom-type)))
(when type
(require 'cus-edit)
(setq type (widget-convert type))
(unless (widget-apply type :match value)
(error "Value `%S' does not match type %S of %S" value (car type) variable))))
(if make-local
(set (make-local-variable variable) value)
(set-default variable value))
(force-mode-line-update))
(defun set-any-variable (variable value &optional make-local)
"Set VARIABLE to VALUE. VALUE is a Lisp object.
VARIABLE can be any Lisp variable, unlike `set-variable', where it
must be a user option. Enter VALUE in Lisp syntax. For example, if
you want VALUE to be a string, you must surround it with doublequotes.
VALUE is used literally, not evaluated.
If VARIABLE has a `variable-interactive' property, that is used as if
it were the arg to `interactive' (which see) to interactively read value.
If VARIABLE has been defined with `defcustom', then the type information
in the definition is used to check that VALUE is valid.
With a prefix argument, set VARIABLE to VALUE buffer-locally."
(interactive (read-var-and-value 'read-any-variable
'set-any-variable-value-history
current-prefix-arg
(and (boundp 'icicle-pre-minibuffer-buffer)
icicle-mode
icicle-pre-minibuffer-buffer)))
(and (custom-variable-p variable)
(not (get variable 'custom-type))
(custom-load-symbol variable))
(let ((type (get variable 'custom-type)))
(when type
(require 'cus-edit)
(setq type (widget-convert type))
(unless (widget-apply type :match value)
(error "Value `%S' does not match type %S of %S" value (car type) variable))))
(if make-local
(set (make-local-variable variable) value)
(set-default variable value))
(force-mode-line-update))
(when (string< emacs-version "20.6.1")
(defun comment-region (beg end &optional arg)
"Comment or uncomment each line in the region.
With just C-u prefix arg, uncomment each line in region.
Numeric prefix arg ARG means use ARG comment characters.
If ARG is negative, delete that many comment characters instead.
Comments are terminated on each line, even for syntax in which newline does
not end the comment. Blank lines do not get comments."
(interactive "r\nP")
(or comment-start (error "No comment syntax is defined"))
(when (> beg end) (let (mid)
(setq mid beg
beg end
end mid)))
(save-excursion
(save-restriction
(let ((cs comment-start)
(ce comment-end)
(cp (and comment-padding (make-string comment-padding ? )))
numarg)
(if (consp arg)
(setq numarg t)
(setq numarg (prefix-numeric-value arg))
(while (> numarg 1)
(setq cs (concat cs comment-start)
ce (concat ce comment-end)
numarg (1- numarg))))
(narrow-to-region beg end)
(goto-char beg)
(if (or (eq numarg t) (< numarg 0))
(while (not (eobp))
(let (found-comment)
(if (eq numarg t)
(while (looking-at (regexp-quote cs))
(setq found-comment t)
(delete-char (length cs)))
(let ((count numarg))
(while (and (> 1 (setq count (1+ count)))
(looking-at (regexp-quote cs)))
(setq found-comment t)
(delete-char (length cs)))))
(when (and found-comment comment-padding (looking-at (regexp-quote cp)))
(delete-char comment-padding))
(if (string= "" ce)
nil
(if (eq numarg t)
(progn
(end-of-line)
(while (progn (skip-chars-backward " \t")
(and (>= (- (point) (point-min)) (length ce))
(save-excursion
(backward-char (length ce))
(looking-at (regexp-quote ce)))))
(delete-char (- (length ce)))))
(let ((count numarg))
(while (> 1 (setq count (1+ count)))
(end-of-line)
(skip-chars-backward " \t")
(if (>= (- (point) (point-min)) (length ce))
(save-excursion
(backward-char (length ce))
(if (looking-at (regexp-quote ce))
(delete-char (length ce)))))))))
(forward-line 1)))
(when comment-padding (setq cs (concat cs cp)))
(while (not (eobp))
(if (looking-at "[ \t]*$") ()
(insert cs)
(if (string= "" ce) ()
(end-of-line)
(insert ce)))
(search-forward "\n" nil 'move))))))))
(when (< emacs-major-version 21)
(defun kill-new (string &optional replace)
"Make STRING the latest kill in the kill ring.
Set the kill-ring-yank pointer to point to it.
If `interprogram-cut-function' is non-nil, apply it to STRING.
Optional second argument REPLACE non-nil means that STRING will replace
the front of the kill ring, rather than being added to the list."
(and (fboundp 'menu-bar-update-yank-menu)
(menu-bar-update-yank-menu string (and replace (car kill-ring))))
(if (and replace kill-ring)
(setcar kill-ring string)
(setq kill-ring (cons string kill-ring))
(when (> (length kill-ring) kill-ring-max)
(setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
(setq kill-ring-yank-pointer kill-ring)
(when interprogram-cut-function
(funcall interprogram-cut-function string (not replace)))))
(provide 'simple+)