X-Git-Url: https://git.distorted.org.uk/~mdw/profile/blobdiff_plain/6617659f5ad35623928c5d4c68f49bab6d3f3f42..18bb0f77715d66d6ba7ec48eee7b3bdb9a5a0008:/el/dot-emacs.el?ds=inline diff --git a/el/dot-emacs.el b/el/dot-emacs.el index a3accbc..32188f9 100644 --- a/el/dot-emacs.el +++ b/el/dot-emacs.el @@ -91,6 +91,14 @@ This may be at the expense of cool features.") (concat "(" (buffer-string) ")"))))))) (cdr (assq sym mdw-config))) +;; Local variables hacking. + +(defun run-local-vars-mode-hook () + "Run a hook for the major-mode after local variables have been processed." + (run-hooks (intern (concat (symbol-name major-mode) + "-local-variables-hook")))) +(add-hook 'hack-local-variables-hook 'run-local-vars-mode-hook) + ;; Set up the load path convincingly. (dolist (dir (append (and (boundp 'debian-emacs-flavor) @@ -321,6 +329,43 @@ Evil key bindings are defined in `mdw-evil-keymap-keys'." org-export-docbook-xslt-stylesheet "/usr/share/xml/docbook/stylesheet/docbook-xsl/fo/docbook.xsl") +;; Some hacks to do with window placement. + +(defun mdw-clobber-other-windows-showing-buffer (buffer-or-name) + "Arrange that no windows on other frames are showing BUFFER-OR-NAME." + (interactive "bBuffer: ") + (let ((home-frame (selected-frame)) + (buffer (get-buffer buffer-or-name)) + (safe-buffer (get-buffer "*scratch*"))) + (mapc (lambda (frame) + (or (eq frame home-frame) + (mapc (lambda (window) + (and (eq (window-buffer window) buffer) + (set-window-buffer window safe-buffer))) + (window-list frame)))) + (frame-list)))) + +(defvar mdw-inhibit-walk-windows nil + "If non-nil, then `walk-windows' does nothing. +This is used by advice on `switch-to-buffer-other-frame' to inhibit finding +buffers in random frames.") + +(defadvice walk-windows (around mdw-inhibit activate) + "If `mdw-inhibit-walk-windows' is non-nil, then do nothing." + (and (not mdw-inhibit-walk-windows) + ad-do-it)) + +(defadvice switch-to-buffer-other-frame + (around mdw-always-new-frame activate) + "Always make a new frame. +Even if an existing window in some random frame looks tempting." + (let ((mdw-inhibit-walk-windows t)) ad-do-it)) + +(defadvice display-buffer (before mdw-inhibit-other-frames activate) + "Don't try to do anything fancy with other frames. +Pretend they don't exist. They might be on other display devices." + (ad-set-arg 2 nil)) + ;;;-------------------------------------------------------------------------- ;;; Mail and news hacking. @@ -573,10 +618,10 @@ If NEW-SESSION-P, start a new session." (select-window window))))) (defvar mdw-good-url-browsers - '(browse-url-generic + '(browse-url-mozilla + browse-url-generic (w3m . mdw-w3m-browse-url) - browse-url-w3 - browse-url-mozilla) + browse-url-w3) "List of good browsers for mdw-good-url-browsers. Each item is a browser function name, or a cons (CHECK . FUNC). A symbol FOO stands for (FOO . FOO).") @@ -835,6 +880,97 @@ doesn't match any of the regular expressions in (add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights) ;;;-------------------------------------------------------------------------- +;;; Where is point? + +(defvar mdw-point-overlay + (let ((ov (make-overlay 0 0)) + (s ".")) + (overlay-put ov 'priority 2) + (put-text-property 0 1 'display '(left-fringe vertical-bar) s) + (overlay-put ov 'before-string s) + (delete-overlay ov) + ov) + "An overlay used for showing where point is in the selected window.") + +(defun mdw-remove-point-overlay () + "Remove the current-point overlay." + (delete-overlay mdw-point-overlay)) + +(defun mdw-update-point-overlay () + "Mark the current point position with an overlay." + (if (not mdw-point-overlay-mode) + (mdw-remove-point-overlay) + (overlay-put mdw-point-overlay 'window (selected-window)) + (if (bolp) + (move-overlay mdw-point-overlay + (point) (1+ (point)) (current-buffer)) + (move-overlay mdw-point-overlay + (1- (point)) (point) (current-buffer))))) + +(defvar mdw-point-overlay-buffers nil + "List of buffers using `mdw-point-overlay-mode'.") + +(define-minor-mode mdw-point-overlay-mode + "Indicate current line with an overlay." + :global nil + (let ((buffer (current-buffer))) + (setq mdw-point-overlay-buffers + (mapcan (lambda (buf) + (if (and (buffer-live-p buf) + (not (eq buf buffer))) + (list buf))) + mdw-point-overlay-buffers)) + (if mdw-point-overlay-mode + (setq mdw-point-overlay-buffers + (cons buffer mdw-point-overlay-buffers)))) + (cond (mdw-point-overlay-buffers + (add-hook 'pre-command-hook 'mdw-remove-point-overlay) + (add-hook 'post-command-hook 'mdw-update-point-overlay)) + (t + (mdw-remove-point-overlay) + (remove-hook 'pre-command-hook 'mdw-remove-point-overlay) + (remove-hook 'post-command-hook 'mdw-update-point-overlay)))) + +(define-globalized-minor-mode mdw-global-point-overlay-mode + mdw-point-overlay-mode + (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t)))) + +;;;-------------------------------------------------------------------------- +;;; Fullscreen-ness. + +(defvar mdw-full-screen-parameters + '((menu-bar-lines . 0) + ;(vertical-scroll-bars . nil) + ) + "Frame parameters to set when making a frame fullscreen.") + +(defvar mdw-full-screen-save + '(width height) + "Extra frame parameters to save when setting fullscreen.") + +(defun mdw-toggle-full-screen (&optional frame) + "Show the FRAME fullscreen." + (interactive) + (when window-system + (cond ((frame-parameter frame 'fullscreen) + (set-frame-parameter frame 'fullscreen nil) + (modify-frame-parameters + nil + (or (frame-parameter frame 'mdw-full-screen-saved) + (mapcar (lambda (assoc) + (assq (car assoc) default-frame-alist)) + mdw-full-screen-parameters)))) + (t + (let ((saved (mapcar (lambda (param) + (cons param (frame-parameter frame param))) + (append (mapcar #'car + mdw-full-screen-parameters) + mdw-full-screen-save)))) + (set-frame-parameter frame 'mdw-full-screen-saved saved)) + (modify-frame-parameters frame mdw-full-screen-parameters) + (set-frame-parameter frame 'fullscreen 'fullboth))))) + +;;;-------------------------------------------------------------------------- ;;; General fontification. (defmacro mdw-define-face (name &rest body) @@ -865,6 +1001,10 @@ doesn't match any of the regular expressions in (((type tty) (class color)) :background "blue") (((type tty) (class mono)) :inverse-video t) (t :background "grey30")) +(mdw-define-face match + (((type tty) (class color)) :background "blue") + (((type tty) (class mono)) :inverse-video t) + (t :background "blue")) (mdw-define-face mc/cursor-face (((type tty) (class mono)) :inverse-video t) (t :background "red")) @@ -1903,7 +2043,6 @@ doesn't match any of the regular expressions in ;; Perl indentation style. -(fset 'perl-mode 'cperl-mode) (setq cperl-indent-level 2) (setq cperl-continued-statement-offset 2) (setq cperl-continued-brace-offset 0) @@ -2070,99 +2209,26 @@ strip numbers instead." (mdw-post-config-mode-hack)) ;;;-------------------------------------------------------------------------- -;;; ARM assembler programming configuration. - -;; There doesn't appear to be an Emacs mode for this yet. -;; -;; Better do something about that, I suppose. - -(defvar arm-assembler-mode-map nil) -(defvar arm-assembler-abbrev-table nil) -(defvar arm-assembler-mode-syntax-table (make-syntax-table)) - -(or arm-assembler-mode-map - (progn - (setq arm-assembler-mode-map (make-sparse-keymap)) - (define-key arm-assembler-mode-map "\C-m" 'arm-assembler-newline) - (define-key arm-assembler-mode-map [C-return] 'newline) - (define-key arm-assembler-mode-map "\t" 'tab-to-tab-stop))) - -(defun arm-assembler-mode () - "Major mode for ARM assembler programs" - (interactive) - - ;; Do standard major mode things. - (kill-all-local-variables) - (use-local-map arm-assembler-mode-map) - (setq local-abbrev-table arm-assembler-abbrev-table) - (setq major-mode 'arm-assembler-mode) - (setq mode-name "ARM assembler") - - ;; Set up syntax table. - (set-syntax-table arm-assembler-mode-syntax-table) - (modify-syntax-entry ?; ; Nasty hack - "<" arm-assembler-mode-syntax-table) - (modify-syntax-entry ?\n ">" arm-assembler-mode-syntax-table) - (modify-syntax-entry ?_ "_" arm-assembler-mode-syntax-table) - (modify-syntax-entry ?' "\"'" arm-assembler-mode-syntax-table) - - (make-local-variable 'comment-start) - (setq comment-start ";") - (make-local-variable 'comment-end) - (setq comment-end "") - (make-local-variable 'comment-column) - (setq comment-column 48) - (make-local-variable 'comment-start-skip) - (setq comment-start-skip ";+[ \t]*") - - ;; Play with indentation. - (make-local-variable 'indent-line-function) - (setq indent-line-function 'indent-relative-maybe) - - ;; Set fill prefix. - (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)") - - ;; Fiddle with fontification. - (make-local-variable 'font-lock-keywords) - (setq font-lock-keywords - (list - - ;; Handle numbers too. - ;; - ;; The following isn't quite right, but it's close enough. - (list (concat "\\(" - "&[0-9a-fA-F]+\\|" - "\\<[0-9]+\\(\\.[0-9]*\\|_[0-9a-zA-Z]+\\|\\)" - "\\)") - '(0 mdw-number-face)) - - ;; Do something about operators. - (list "^[^ \t]*[ \t]+\\(GET\\|LNK\\)[ \t]+\\([^;\n]*\\)" - '(1 font-lock-keyword-face) - '(2 font-lock-string-face)) - (list ":[a-zA-Z]+:" - '(0 font-lock-keyword-face)) - - ;; Do menemonics and directives. - (list "^[^ \t]*[ \t]+\\([a-zA-Z]+\\)" - '(1 font-lock-keyword-face)) - - ;; And anything else is punctuation. - (list "\\(\\s.\\|\\s(\\|\\s)\\|\\s\\\\|\\s/\\)" - '(0 mdw-punct-face)))) - - (mdw-post-config-mode-hack) - (run-hooks 'arm-assembler-mode-hook)) - -;;;-------------------------------------------------------------------------- ;;; Assembler mode. (defun mdw-fontify-asm () (modify-syntax-entry ?' "\"") (modify-syntax-entry ?. "w") + (modify-syntax-entry ?; "." + ) + (modify-syntax-entry asm-comment-char "") (setf fill-prefix nil) (mdw-standard-fill-prefix "\\([ \t]*;+[ \t]*\\)")) +(define-derived-mode x86-asm-mode asm-mode "x86 assembler" + "Assembler mode variant which uses `#' as the comment character." + (set (make-variable-buffer-local 'asm-comment-char) ?#)) + +(define-derived-mode arm-asm-mode asm-mode "ARM assembler" + "Assembler mode variant which uses `@' as the comment character." + (set (make-variable-buffer-local 'asm-comment-char) ?@)) + ;;;-------------------------------------------------------------------------- ;;; TCL configuration. @@ -2675,8 +2741,8 @@ that character only to be normal punctuation.") (or (booleanp value) (every (lambda (v) (memq v '(?\" ?'))) (if (listp value) value (list value))))) -(put 'mdw-conf-quote-normal 'safe-local-variable ' - mdw-conf-quote-normal-acceptable-value-p) +(put 'mdw-conf-quote-normal 'safe-local-variable + 'mdw-conf-quote-normal-acceptable-value-p) (defun mdw-fix-up-quote () "Apply the setting of `mdw-conf-quote-normal'." @@ -2691,15 +2757,7 @@ that character only to be normal punctuation.") (if (listp flag) flag (list flag))) (set-syntax-table table) (and font-lock-mode (font-lock-fontify-buffer))))))) -(defun mdw-fix-up-quote-hack () - "Unpleasant hack to call `mdw-fix-up-quote' at the right time. -Annoyingly, `hack-local-variables' is done after `set-auto-mode' -so we wouldn't see a local-variable setting of -`mdw-conf-quote-normal' in `conf-mode-hook'. Instead, wire -ourselves onto `hack-local-variables-hook' here, and check the -setting once it's actually been made." - (add-hook 'hack-local-variables-hook 'mdw-fix-up-quote t t)) -(add-hook 'conf-mode-hook 'mdw-fix-up-quote-hack t) +(add-hook 'conf-mode-local-variables-hook 'mdw-fix-up-quote t t) ;;;-------------------------------------------------------------------------- ;;; Shell scripts. @@ -2721,6 +2779,9 @@ setting once it's actually been made." (let ((executable-set-magic #'(lambda (s &rest r) s))) (sh-set-shell shell-name))) + ;; Don't insert here-document scaffolding automatically. + (local-set-key "<" 'self-insert-command) + ;; Now enable my keys and the fontification. (mdw-misc-mode-config) @@ -3153,6 +3214,19 @@ This allows you to pass a list of arguments through `ansi-term'." (interactive "sHost: ") (ansi-term (list "ssh" host) (format "ssh@%s" host))) +(defvar git-grep-command + "env PAGER=cat git grep --no-color -nH -e " + "*The default command for \\[git-grep].") + +(defvar git-grep-history nil) + +(defun git-grep (command-args) + "Run `git grep' with user-specified args and collect output in a buffer." + (interactive + (list (read-shell-command "Run git grep (like this): " + git-grep-command 'git-grep-history))) + (grep command-args)) + ;;;-------------------------------------------------------------------------- ;;; Inferior Emacs Lisp.