Download
(eval-when-compile (when (< emacs-major-version 21) (require 'cl)))
(provide 'misc-fns)
(require 'misc-fns)
(defcustom mode-line-reminder-duration 10
"*Maximum number of seconds to display a reminder in the mode-line."
:type 'integer)
(defun display-in-mode-line (text)
"Display TEXT in mode line for `mode-line-reminder-duration' seconds."
(let ((mode-line-format (list text)))
(force-mode-line-update)
(sit-for mode-line-reminder-duration))
(force-mode-line-update))
(defun force-time-redisplay ()
"Force a redisplay.
This is probably obsolete now. Use `force-mode-line-update'."
(save-excursion (set-buffer (other-buffer)))
(set-buffer-modified-p (buffer-modified-p))
(sit-for 0))
(defun another-buffer (&optional buffer visible-ok)
"First buffer in `buffer-list' whose name does not start with a space.
This is the first buffer in the list.
Arg BUFFER is excepted if another can be found, besides \"*scratch*\".
Arg VISIBLE-OK is as for `other-buffer'.
Differs from `other-buffer' in:
1) If BUFFER is nil, `current-buffer' is used as the excepted BUFFER.
2) BUFFER is used, not *scratch* buffer, if no other buffer exists
(unless BUFFER starts with a space). That is, BUFFER is excepted
only if another, besides *scratch*, can be found."
(setq buffer (or buffer (current-buffer)))
(let ((buf (other-buffer buffer visible-ok)))
(if (and (eq (get-buffer-create "*scratch*") buf)
(not (eq 0 (string-match " " (buffer-name buffer)))))
buffer
buf)))
(defun live-buffer-name (buffer)
"Return BUFFER's name if a buffer that has not been deleted, else nil.
BUFFER may be either a buffer or its name (a string)."
(setq buffer (and buffer (get-buffer buffer)))
(and buffer (buffer-name buffer)))
(defun interesting-buffer-p (buffer)
"Non-nil if BUFFER is a live buffer whose name does not start with SPC."
(and buffer (setq buffer (live-buffer-name buffer))
(or (zerop (length buffer))
(not (char-equal ?\ (aref buffer 0))))))
(defun unique-name (name existing-names &optional min use-base-p maxp)
"Return NAME or NAME<N>, a name that is not in EXISTING-NAMES.
Return NAME if NAME is not a member of EXISTING-NAMES.
Otherwise, return NAME or its base name, suffixed by `<N>', where N is
an integer.
The optional args are used only when NAME is in EXISTING-NAMES.
MIN is the minimum integer N to use in the new suffix. Default: 1.
Non-nil USE-BASE-P means use only the base name of NAME. The value
returned is of the form `BASENAME<N>' (only a single suffix).
BASENAME is NAME truncated at the right starting with the first suffix
`<M>'. The base name of `a<2>' and `a<2><3>' is `a'.
For example, if NAME is `a<2>', then with nil USE-BASE-P we might
return `a<2><1>' (depending on MIN, MAX etc.). With non-nil
USE-BASE-P we might return `a<3>', since the base name `a' gets
suffixed, not the full NAME `a<2>'.
Optional arg MAXP is used only if USE-BASE-P is non-nil.
If MAXP is nil then N is the smallest integer greater than or equal to
MIN such that `BASENAME<N>' is not in EXISTING-NAMES.
If MAXP is non-nil then N is the smallest integer greater than or
equal to MIN and greater than the largest integer M used in a suffix
`<M>' that immediately follows BASENAME in a name in EXISTING-NAMES.
As an example, `generate-new-buffer-name' could be defined this way:
(defun generate-new-buffer-name (buf)
(let ((buffs (mapcar #'buffer-name (buffer-list))))
(unique-name buf buffs 2)))"
(unless min (setq min 1))
(if (and (not (member name existing-names)) (not maxp))
name
(let ((indx min)
(baselen (string-match "\<\\(-?[0-9]+\\)\>" name))
try)
(when (and use-base-p baselen)
(setq name (substring name 0 baselen)))
(if maxp
(format
"%s<%d>" name
(1+ (apply
#'max
(mapcar (lambda (nn)
(if (string-match "\<\\(-?[0-9]+\\)\>" nn)
(string-to-number (match-string 1 nn))
min))
existing-names))))
(catch 'unique-name
(while t
(unless (member (setq try (concat name "<" indx ">"))
existing-names)
(throw 'unique-name try))
(setq indx (max min (1+ indx)))))))))
(defun current-line ()
"Current line number of cursor."
(+ (count-lines (point-min) (point))
(if (= (current-column) 0) 1 0)))
(defun fontify-buffer (buffer &rest ignore)
"Fontify buffer BUFFER.
Usable as a candidate for `compilation-finish-functions'.
Any arguments besides BUFFER (IGNORE list) are ignored."
(with-current-buffer buffer (font-lock-fontify-buffer)))
(defun make-transient-mark-mode-buffer-local (&optional default)
"Make variable `transient-mark-mode' permanent-local everywhere.
Set default value to arg DEFAULT, if non-nil, else `default-value' of
`transient-mark-mode'. This means that if already buffer-local, its
default value is not changed."
(make-variable-buffer-local 'transient-mark-mode)
(put 'transient-mark-mode 'permanent-local t)
(setq-default transient-mark-mode (or default
(default-value 'transient-mark-mode))))
(defun region-or-buffer-limits ()
"Return the start and end of the region as a list, smallest first.
If the region is not active or is empty, then bob and eob are used."
(if (or (not mark-active) (null (mark)) (= (point) (mark)))
(list (point-min) (point-max))
(if (< (point) (mark)) (list (point) (mark)) (list (mark) (point)))))
(defcustom notifying-user-of-mode-flag t
"*Non-nil means to display messages notifying user of mode changes.
See function `notify-user-of-mode'."
:type 'boolean)
(defface notify-user-of-mode '((((background dark)) (:foreground "cyan"))
(t (:foreground "dark blue")))
"*Face used for notifying user of current major mode.
See function `notify-user-of-mode'.")
(defun notify-user-of-mode (&optional buffer anyway)
"Display msg naming major mode of BUFFER (default: current buffer).
A message is never displayed if the minibuffer is active. Otherwise:
No msg is displayed if not `notifying-user-of-mode-flag' or BUFFER
is internal, unless optional 2nd arg ANYWAY is non-nil.
In that case, msg is displayed anyway.
Useful as a mode hook. For example:
\(add-hook 'c-mode-hook 'notify-user-of-mode)"
(setq buffer (buffer-name (and buffer (get-buffer buffer))))
(when (and buffer
(not (active-minibuffer-window))
(or (and notifying-user-of-mode-flag
(interesting-buffer-p buffer))
anyway))
(message "Buffer `%s' is in mode `%s'. For info on the mode: `%s'."
buffer (if (fboundp 'format-mode-line)
(format-mode-line mode-name)
mode-name)
(substitute-command-keys "\\[describe-mode]"))))
(defun mode-ancestors (mode)
"Return the ancestor modes, a list of symbols, for symbol MODE.
Uses symbol property `derived-mode-parent' to trace backwards."
(let ((parent (get mode 'derived-mode-parent))
(modes ()))
(while parent
(push parent modes)
(setq parent (get parent 'derived-mode-parent)))
modes))
(defun do-files (files fn &optional kill-buf-after)
"Visit each file in list FILES, executing function FN once in each.
Optional arg KILL-BUF-AFTER non-nil means kill buffer after saving it."
(let ((notifying-user-of-mode-flag nil))
(dolist (file files)
(set-buffer (find-file-noselect file))
(funcall fn)
(setq buffer-backed-up t)
(save-buffer)
(when kill-buf-after
(kill-buffer (current-buffer))))))
(defcustom buffer-modifying-cmds
(append
(and (or (not (boundp 'kill-read-only-ok)) kill-read-only-ok)
'(backward-kill-paragraph backward-kill-sentence backward-kill-sexp
backward-kill-word clipboard-kill-region comint-kill-input comment-kill
kill-backward-up-list kill-comment kill-line kill-paragraph
kill-rectangle kill-region kill-region-wimpy kill-sentence kill-sexp
kill-whole-line kill-word mouse-kill))
'(align-newline-and-indent backward-delete-char backward-delete-char-untabify
bookmark-insert bookmark-insert-location canonically-space-region
capitalize-region capitalize-word c-backslash-region
c-context-line-break center-line center-paragraph center-region
c-fill-paragraph c-hungry-delete-backwards c-hungry-delete-forward
c-indent-command c-indent-defun c-indent-exp clear-rectangle
comint-truncate-buffer comment-dwim comment-indent-new-line comment-region
comment-or-uncomment-region complete-symbol compose-last-chars
compose-region dabbrev-completion dabbrev-expand decompose-region
delete-backward-char delete-blank-lines delete-char
delete-horizontal-space delete-indentation delete-matching-lines
delete-non-matching-lines delete-pair delete-rectangle delete-region
delete-trailing-whitespace delete-whitespace-rectangle delimit-columns-region
downcase-region downcase-word edit-picture expand-abbrev expand-region-abbrevs
fill-individual-paragraphs fill-nonuniform-paragraphs fill-paragraph
fill-region fill-region-as-paragraph format-insert-file flush-lines
ido-insert-buffer ido-insert-file increase-left-margin increase-right-margin
indent-code-rigidly indent-for-comment indent-for-tab-command
indent-line-function indent-new-comment-line indent-pp-sexp indent-region
indent-rigidly insert-abbrevs insert-buffer insert-file insert-file-literally
insert-kbd-macro insert-pair insert-parentheses insert-register
insert-zippyism join-line justify-current-line just-one-space keep-lines
lisp-complete-symbol lisp-fill-paragraph lisp-indent-line morse-region
newline newline-and-indent open-line open-rectangle query-replace
query-replace-regexp quoted-insert reindent-then-newline-and-indent
replace-regexp replace-string repunctuate-sentences reverse-region rot13-region
self-insert-command set-justification-center set-justification-full
set-justification-left set-justification-none set-justification-right
set-left-margin set-right-margin skeleton-pair-insert-maybe smiley-region
sort-columns sort-fields sort-lines sort-numeric-fields sort-pages
sort-paragraphs split-line string-insert-rectangle string-rectangle
studlify-region table-delete-column table-delete-row table-heighten-cell
table-insert table-insert-column table-insert-row table-insert-sequence
table-justify table-shorten-cell table-span-cell table-split-cell
table-split-cell-horizontally table-split-cell-vertically table-widen-cell
tab-to-tab-stop tabify texinfo-format-region tildify-region time-stamp
todo-insert-item translate-region transpose-chars transpose-lines
transpose-paragraphs transpose-sentences transpose-sexps transpose-words
ucs-insert uncomment-region unmorse-region untabify upcase-region
upcase-word vc-insert-headers whitespace-cleanup
whitespace-cleanup-region yank yank-pop yank-rectangle zap-to-char))
"*Buffer-modifying commands used in `undefine-killer-commands'."
:type '(repeat symbol))
(defun undefine-keys-bound-to (command keymap)
"Undefine all keys bound only by inheritance to COMMAND in KEYMAP.
If a key is bound to COMMAND in KEYMAP, but it is not bound directly
in KEYMAP, then bind it to `undefined' in KEYMAP."
(dolist (key (where-is-internal command keymap))
(when (and key (not (lookup-key keymap key)))
(define-key keymap key 'undefined))))
(defun undefine-killer-commands (keymap)
"Undefine KEYMAP keys that are bound to buffer-modifying commands.
For each key in KEYMAP that is indirectly bound to one of the commands in
`buffer-modifying-cmds', rebind it to `undefined'."
(mapcar (lambda (cmd) (undefine-keys-bound-to cmd keymap)) buffer-modifying-cmds))
(defun mod-signed (num base)
"Return NUM modulo BASE, irrespective of the sign of NUM.
BASE is always non-negative.
Examples: (mod-signed 5 3) => 2
(mod-signed -5 3) => -2."
(if (natnump num)
(mod num base)
(- (mod (- num) base))))
(defun flatten (list)
"Flatten LIST, returning a list with the atoms in LIST at any level.
Also works for a consp whose cdr is non-nil."
(cond ((null list) nil)
((atom list) list)
(t
(let ((old list)
(new ())
item)
(while old
(if (atom old)
(setq item old
old nil)
(setq item (car old)
old (cdr old)))
(while (consp item)
(if (cdr item)
(setq old (cons (cdr item) old)))
(setq item (car item)))
(setq new (cons item new)))
(reverse new)))))
(when (fboundp 'color-defined-p)
(defun color-named-at (&optional position)
"Return the color named at POSITION (default: point), as a string.
The name is anything recognized by `color-defined-p', which includes
an RGB color code prefixed by `#'.
Return nil if no color is named at point."
(unless position (setq position (point)))
(let ((word (with-syntax-table (copy-syntax-table (syntax-table))
(modify-syntax-entry ?# "w")
(word-at-point))))
(and word (color-defined-p word) word))))