Advertisement
nrnrnr

A crufty .emacs file

Apr 20th, 2016
202
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 61.67 KB | None | 0 0
  1. (when (require 'package nil t)
  2.   (when (< emacs-major-version 24)
  3.     ;; For important compatibility libraries like cl-lib
  4.     (add-to-list 'package-archives '("gnu" . "https://elpa.gnu.org/packages/")))
  5.   (add-to-list 'package-archives
  6.            '("melpa" . "https://melpa.org/packages/") t)
  7.   (package-initialize))
  8.  
  9.  
  10. (if (string-equal (cadr command-line-args) "debug")
  11.     (setq debug-on-error t))
  12.  
  13.  
  14. ; The following make emacs behave like emacs even for the Mac mappings of the
  15. ; external keyboard
  16. ;  Command is control, alt and control become meta
  17. ;
  18.  
  19. ; This deals with the horror of what xterm does do meta pageup and meta pagedown
  20. (global-set-key "\e[5;" (make-sparse-keymap))
  21. (global-set-key "\e[6;" (make-sparse-keymap))
  22. (global-set-key "\e[5;3" (make-sparse-keymap))
  23. (global-set-key "\e[6;3" (make-sparse-keymap))
  24. (global-set-key "\e[5;3~" 'beginning-of-buffer)
  25. (global-set-key "\e[6;3~" 'end-of-buffer)
  26.  
  27. (global-set-key [C-return] 'set-mark-command) ;; Mac OSX steals command-space as Spotlight
  28.  
  29. (unless (string= emacs-version "23.1.1")
  30.   (unless (display-graphic-p)
  31.     (set-keyboard-coding-system nil)))
  32.  
  33. (unless (display-graphic-p)
  34.   ;; deal with the Unicode sequences that xterm sends when Alt (meta) keys
  35.   ;; are used. N.B. Works with Alt-letter, Alt-\, Alt-space, and Alt-Shift-:
  36.   (defun make-meta-key ()
  37.     (interactive)
  38.     (let ((e (read-event)))
  39.       ;; (message "Got event %s; basic event is %s" e (event-basic-type e))
  40.       (if (numberp e)
  41.           (let* ((basic (event-basic-type e))
  42.                  (shifted (+ basic 64))
  43.                  (basecode (if (<= shifted 127) shifted basic))
  44.                  (keys (vector (event-convert-list (list 'meta basecode))))
  45.                  (command (key-binding keys)))
  46.               ;; (message "Result is %s; commandp says %s" command (commandp command))
  47.               (command-execute command))
  48.         (error "this can't happen"))))
  49.   (global-set-key [?\M-C] 'make-meta-key)
  50.   (defun do-nothing () (interactive) nil)
  51.   (global-set-key [?\M-B] 'do-nothing))
  52.  
  53.  
  54. (when (display-graphic-p)
  55.   (global-set-key "" 'undo))
  56. (global-set-key (kbd "C-`") 'undo)
  57. (global-set-key "\e" 'suspend-emacs) ; maybe 'suspend-frame ?
  58.  
  59. (setq mac-command-modifier 'control)
  60. (setq mac-option-modifier 'meta)
  61. (setq mac-control-modifier 'meta)
  62. (setq x-select-enable-clipboard 't)
  63.  
  64. (add-to-list 'load-path "~nr/emacs")
  65. (add-to-list 'load-path "/usr/share/emacs/site-lisp/emacs-goodies-el")
  66.  
  67. (add-to-list 'auto-mode-alist (cons "\\.rkt$" 'scheme-mode))
  68. (defun force-compile-key ()
  69.   (interactive)
  70.   (local-set-key (kbd "C-c C-C") 'compile))
  71. (add-hook 'scheme-mode-hook 'force-compile-key)
  72.  
  73. (require 'tex-mode)
  74. (setq tex-indent-arg 0)
  75. (setq tex-indent-basic 0)
  76. (setq tex-indent-item tex-indent-basic)
  77.  
  78. ;;(require 'electric)  ;; tried to turn off using customization
  79. ;;(electric-indent-mode -1) ;; weird way to turn it off
  80.  
  81. (add-to-list 'auto-mode-alist (cons "\\.tex$" 'latex-mode))
  82. (condition-case nil
  83.     (load-library "quack")
  84.   (error nil))
  85. (when (fboundp 'quack-install)
  86.   (quack-install))
  87.  
  88.  
  89. (defvar noweb-support 'mini
  90.   "Internal configuration in NR's .emacs file to control whether noweb files
  91. are edited using mmm-mode or noweb-mode.  Value is a symbol and should be
  92. either mmm or noweb or love or mini.")
  93.  
  94. (setq noweb-support 'love)
  95.  
  96.  
  97. (defun turn-off-electric-indent-mode ()
  98.   (electric-indent-local-mode t))
  99.  
  100. (add-hook 'text-mode-hook 'turn-off-electric-indent-mode)
  101.  
  102. (defun disable-compile-shortcut ()
  103.   (local-set-key (kbd "C-c C-c") 'with-editor-finish))
  104.  
  105. (add-hook 'text-mode-hook 'disable-compile-shortcut t)
  106.  
  107. (unless (= emacs-major-version 23)
  108.   (when (require 'filladapt nil t)
  109.     (add-hook 'text-mode-hook 'turn-on-filladapt-mode)
  110.     (global-set-key (kbd "C-x f") 'filladapt-mode)
  111.   ;(setq noweb-support 'ess)) ;; not working on yorkie
  112.   ))
  113.  
  114.  
  115. (if nil
  116.     (when
  117.         (require 'polymode nil 'no-error)
  118.       (when
  119.           (load "noweb-poly" 'no-error 'no-message)
  120.         (setq noweb-support 'poly)
  121.         (load-library "noweb-love"))) ;; for old files not yet converted
  122. )
  123.  
  124. (if (eq noweb-support 'noweb)
  125.     (progn
  126.       (defun open-line-and-reparse (arg)
  127.         "Insert a newline and leave point before it.
  128. If there is a fill prefix and/or a left-margin, insert them on the new line
  129. if the line would have been blank.
  130. With arg N, insert N newlines.
  131. After the insertion, reparse the boundaries between code and documentation."
  132.         (interactive "*p")
  133.         (open-line arg)
  134.         (noweb-update-chunk-vector))
  135.  
  136.       ;(autoload 'noweb-mode "~/emacs/noweb-mode" "Editing noweb files." t)
  137.       (add-to-list 'auto-mode-alist (cons "\\.nw$" 'noweb-mode))
  138.  
  139.       (defun set-up-noweb-mode () "set preferences for noweb" (interactive)
  140.         (font-lock-mode 0)
  141.         (local-set-key "\C-o" 'open-line-and-reparse)
  142.         (noweb-update-chunk-vector)
  143.         )
  144.       (add-hook 'noweb-mode-hook 'set-up-noweb-mode)
  145.  
  146.       (if (or (string-match "20\\.4\\(\\.[0-9]+\\)?" emacs-version)
  147.               (string-match "21\\.[0-9]+\\(\\.[0-9]+\\)?" emacs-version))
  148.           (add-hook 'noweb-select-mode-hook
  149.                     '(lambda () (hack-local-variables-prop-line)))
  150.         (message "Not sure about noweb-select-mode-hook in emacs version %s"
  151.                  emacs-version))
  152.      
  153.       (require 'cc-mode)
  154.       (c-set-offset 'brace-list-entry 0) ; makes noweb happy
  155.      
  156.     ))
  157.  
  158. (defun filter-not (f xs)
  159.   (if (null xs)
  160.       xs
  161.     (if (funcall f (car xs))
  162.         (filter-not f (cdr xs))
  163.       (cons (car xs) (filter-not f (cdr xs))))))
  164.  
  165.  
  166. (defun this-para-fill-prefix ()
  167.   "Show the fill prefix for this paragraph"
  168.   (interactive)
  169.   (fill-context-prefix
  170.    (save-excursion (fill-forward-paragraph -1) (point))
  171.    (save-excursion (fill-forward-paragraph 1) (point))))
  172.  
  173.  
  174. ;; (require 'desktop)
  175. ;; (defvar old-desktop-save)
  176. ;; (fset 'old-desktop-save (symbol-function 'desktop-save))
  177. ;; (if (string-match "23\\.2\\(\\.[0-9]+\\)?" emacs-version)
  178. ;;     (let ((old-buffer-list (symbol-function 'buffer-list)))
  179. ;;       (fset 'old-buffer-list old-buffer-list)
  180. ;;       (defun desktop-save (dirname &optional release)
  181. ;;         "Save the desktop in a desktop file.
  182. ;; Parameter DIRNAME specifies where to save the desktop file.
  183. ;; Optional parameter RELEASE says whether we're done with this desktop.
  184. ;; See also `desktop-base-file-name'."
  185. ;;         (interactive "DDirectory to save desktop file in: ")
  186. ;;         (flet ((buffer-list ()
  187. ;;                             (filter-not 'buffer-base-buffer
  188. ;;                                         (funcall 'old-buffer-list))))
  189. ;;           (funcall 'old-desktop-save dirname release)))))
  190.  
  191. (add-hook 'kill-emacs-hook 'kill-indirect-buffers)
  192. (defun kill-indirect-buffers ()
  193.   "Kill all indirect buffers"
  194.   (interactive)
  195.   (dolist (b (buffer-list))
  196.     (if (buffer-base-buffer b)
  197.         (kill-buffer b))))
  198.  
  199.  
  200.  
  201. (require 'compile)
  202. (setq compile-command "mk")
  203.  
  204.  
  205. (autoload 'knoweb-mode "knoweb")
  206. ;; (add-hook 'mmm-noweb-class-hook 'knoweb-mode)
  207.  
  208.  
  209. (when (eq noweb-support 'mmm)
  210.   (require 'mmm-mode)
  211.   (setq mmm-global-mode 'buffers-with-submode-classes)
  212.   (mmm-add-mode-ext-class 'latex-mode "\\.nw\\'" 'noweb)
  213.   (add-to-list 'auto-mode-alist '("\\.nw$" . latex-mode))
  214.   (setq mmm-submode-decoration-level 2)
  215.   (defun emulate-noweb-reparse-in-mmm
  216.       () "Set noweb reparse key to reparse in mmm-mode"
  217.       (local-set-key "\M-n\M-l" 'mmm-parse-buffer)
  218.       (local-set-key "\M-n\M-n" 'mmm-narrow-to-submode-region)
  219.       )
  220.   (add-hook 'mmm-noweb-class-hook 'emulate-noweb-reparse-in-mmm)
  221.   )
  222.  
  223.  
  224. (if (eq noweb-support 'love)
  225.     (progn
  226.       (load-library "noweb-love")
  227.       ;(add-to-list 'auto-mode-alist '("\\.nw$" . noweb-mode))
  228.       ))
  229.  
  230. (when (eq noweb-support 'ess)
  231.   (require 'ess-noweb-mode)
  232.   (require 'ess-noweb-font-lock-mode)
  233.   (add-to-list 'auto-mode-alist '("\\.nw$" . ess-noweb-mode))
  234.   )
  235.  
  236. (autoload 'mini-noweb-mode "mini-noweb-mode" "Bare-bones noweb support." t)
  237. (if (eq noweb-support 'mini)
  238.     (progn
  239.       (load-library "mini-noweb-mode")
  240.       (add-to-list 'auto-mode-alist '("\\.nw$" . mini-noweb-mode))
  241.       (defun noweb-mode (mini-noweb-mode))
  242.       ))
  243.  
  244.  
  245.  
  246. ; work around haskell-ghci bug
  247.  
  248.  
  249. (setq inhibit-site-startup-message t)
  250. (setq inhibit-splash-screen t)
  251. (setq inhibit-site-start t)
  252. (setq vc-handle-cvs nil)
  253.  
  254. (if (fboundp 'one-buffer-one-frame-mode)
  255.     (one-buffer-one-frame-mode nil))
  256.  
  257. (or (fboundp 'add-to-list)
  258.     ;; Introduced in Emacs 19.29.
  259.     (defun add-to-list (list-var element)
  260.       "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
  261. If you want to use `add-to-list' on a variable that is not defined
  262. until a certain package is loaded, you should put the call to `add-to-list'
  263. into a hook function that will be run only after loading the package.
  264. `eval-after-load' provides one way to do this.  In some cases
  265. other hooks, such as major mode hooks, can do the job."
  266.       (or (member element (symbol-value list-var))
  267.           (set list-var (cons element (symbol-value list-var))))))
  268.  
  269.  
  270. (setq automounter-pattern "/automounter")
  271.  
  272.  
  273. ; (add-to-list 'load-path "/usr/lib/emacs/site-lisp")
  274.  
  275.  
  276. (require 'scroll-in-place)
  277. (global-set-key [mouse-5] 'scroll-up)
  278. (global-set-key [mouse-4] 'scroll-down)
  279. ;(load "~nr/emacs/flow-control")
  280. ;(no-flow-control) ; PC/IC doesn't require it!
  281. ;(load "~nr/emacs/arrow") ; arrow keys for WYSE
  282. ;(load-file "/usr/local/src/clu/elisp/setup.el")
  283.  
  284.   (if (file-readable-p "/usr/local/teTeX/info/dir")
  285.      (setq Info-default-directory-list
  286.         (append Info-default-directory-list '("/usr/local/teTeX/info/"))))
  287.  
  288.   (if (file-readable-p "/usr/share/info/dir")
  289.      (setq Info-default-directory-list
  290.         (append Info-default-directory-list '("/usr/share/info/"))))
  291.  
  292.  
  293.  
  294.  
  295. (setq twelf-root "/home/nr/net/twelf/")
  296. ;(load (concat twelf-root "emacs/twelf-init.el"))
  297.  
  298. (if (not (fboundp 'add-hook))
  299.     (defun add-hook (hook function &optional append)
  300.       "Add to the value of HOOK the function FUNCTION unless already present.
  301. \(It becomes the first hook on the list unless optional APPEND is non-nil, in
  302. which case it becomes the last).  HOOK should be a symbol, and FUNCTION may be
  303. any valid function.  HOOK's value should be a list of functions, not a single
  304. function.  If HOOK is void, it is first set to nil."
  305.       (or (boundp hook) (set hook nil))
  306.       (set hook
  307.        (if append
  308.            (nconc (symbol-value hook) (list function))
  309.          (cons function (symbol-value hook))))))
  310.  
  311.  
  312. (defun require-comint ()
  313.   (require 'comint))
  314.  
  315.  
  316. (setq sl2h-ok-without-prompting nil)
  317. (defun sl2h (p1 p2)
  318.    "Convert latex to html in region"
  319.    (interactive "r")
  320.    (if (or sl2h-ok-without-prompting
  321.        (y-or-n-p "Convert region from LaTeX to HTML? "))
  322.        (shell-command-on-region p1 p2 "sl2h" nil 't))
  323. )
  324. (defun sl2h-without-prompting ()
  325.    "Make sl2h work without prompting (local to buffer)"
  326.    (interactive)
  327.    (make-local-variable 'sl2h-ok-without-prompting)
  328.    (setq sl2h-ok-without-prompting 't)
  329. )
  330. (setq pandoc-without-prompting nil)
  331. (defun pandoc (p1 p2)
  332.    "Convert markdown to html in region using pandoc"
  333.    (interactive "r")
  334.    (if (or pandoc-without-prompting
  335.        (y-or-n-p "Convert region from Pandoc Markdown to HTML? "))
  336.        (shell-command-on-region p1 p2 "pandoc -S --columns=72" nil 't))
  337. )
  338.      
  339. (defun m2l (p1 p2)
  340.    "Convert markdown to latex in region"
  341.    (interactive "r")
  342.    (when (y-or-n-p "Convert region from Markdown to LaTeX? ")
  343.      (shell-command-on-region p1 p2 "m2l" nil 't)))
  344.  
  345.  
  346. (defun html2ascii (p1 p2)
  347.    "Convert html to ascii in region"
  348.    (interactive "r")
  349.    (shell-command-on-region p1 p2 "html2ascii" nil 't)
  350. )
  351. (global-set-key "\M-s" 'sl2h)  
  352.  
  353. (defun change-meta-s ()
  354.   (local-set-key "\M-s" 'sl2h))
  355.  
  356. (defun change-close-block ()
  357.   (define-skeleton latex-close-block
  358.     "Create an \\end{...} to match the last unclosed \\begin{...}."
  359.     (save-excursion
  360.       (tex-last-unended-begin)
  361.       (if (not (looking-at "\\\\begin\\(\\s *{[^}\n]*}\\)")) '("{" _ "}")
  362.         (match-string 1)))
  363.     "\\end" str "\n"))
  364.  
  365.  
  366.  
  367. ;;  (when (boundp 'adaptive-fill-first-line-regexp)
  368. ;;    (setq adaptive-fill-first-line-regexp
  369. ;;          (purecopy "\\`\\([ \t]*\\|[ \t]*[-.*>]+[ \t]+\\|[ \t]*[0-9]+\\.[ \t]+\\)\\'")))
  370. ;;  
  371. ;;  (setq adaptive-fill-regexp "[   ]*\\([-|#;>*.]+ *\\|(?[0-9]+[.):] *\\)*")
  372.  
  373.  
  374. (add-hook 'text-mode-hook 'turn-on-auto-fill)
  375.  
  376. (add-hook 'text-mode-hook
  377.           (function (lambda ()
  378.                       (require 'flyspell)
  379.                       (unless flyspell-mode
  380.                         (flyspell-mode)))))
  381.  
  382. ;;*---------------------------------------------------------------------*/
  383. ;;*    flyspell-goto-previous-word ...                          */
  384. ;;*---------------------------------------------------------------------*/
  385. (defun flyspell-goto-previous-word (position)
  386.   "Go to the first misspelled word that occurs before point.
  387. But don't look beyond what's visible on the screen."
  388.   (interactive "d")
  389.  
  390.   (let ((top (window-start))
  391.     (bot (window-end)))
  392.     (save-restriction
  393.       (narrow-to-region top bot)
  394.       (overlay-recenter (point))
  395.  
  396.       (add-hook 'pre-command-hook
  397.                 (function flyspell-auto-correct-previous-hook) t t)
  398.  
  399.       (unless flyspell-auto-correct-previous-pos
  400.         ;; only reset if a new overlay exists
  401.         (setq flyspell-auto-correct-previous-pos nil)
  402.  
  403.         (let ((overlay-list (overlays-in (point-min) position))
  404.               (new-overlay 'dummy-value))
  405.  
  406.           ;; search for previous (new) flyspell overlay
  407.           (while (and new-overlay
  408.                       (or (not (flyspell-overlay-p new-overlay))
  409.                           ;; check if its face has changed
  410.                           (not (eq (get-char-property
  411.                                     (overlay-start new-overlay) 'face)
  412.                                    'flyspell-incorrect))))
  413.             (setq new-overlay (car-safe overlay-list))
  414.             (setq overlay-list (cdr-safe overlay-list)))
  415.  
  416.           ;; if nothing new exits new-overlay should be nil
  417.           (if new-overlay ;; the length of the word may change so go to the start
  418.               (setq flyspell-auto-correct-previous-pos
  419.                     (overlay-start new-overlay)))))
  420.  
  421.       (if (not flyspell-auto-correct-previous-pos)
  422.           nil
  423.         (goto-char flyspell-auto-correct-previous-pos)
  424.         t))))
  425.  
  426.  
  427. (add-hook 'text-mode-hook (function (lambda () (abbrev-mode 1))))
  428.  
  429.  
  430. (add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex))))
  431. (add-hook 'tex-mode-hook
  432.           (function (lambda ()
  433.                       (set (make-local-variable 'search-whitespace-regexp)
  434.                            "[ \t\r\n\f~]+"))))
  435.  
  436. (add-hook 'TeX-mode-hook 'set-up-tex-mode)
  437. (add-hook 'tex-mode-hook 'set-up-tex-mode)
  438. (add-hook 'text-mode-hook 'change-meta-s)
  439. (add-hook 'latex-mode-hook 'change-meta-s)
  440. (add-hook 'TeX-mode-hook 'change-meta-s)
  441. (add-hook 'latex-mode-hook 'set-up-tex-mode)
  442. ;(add-hook 'haskell-mode-hook 'turn-off-haskell-font-lock)
  443. (add-hook 'haskell-mode-hook 'turn-on-haskell-indent)
  444. (add-hook 'haskell-mode-hook 'require-comint)  ;; bug workaround
  445. ;(global-set-key "" 'previous-line)
  446. ;(global-set-key "" 'suspend-emacs)
  447. ;(global-set-key "s" 'save-buffer)
  448. ;(global-set-key "\er" 'isearch-backward)
  449. (global-set-key "c" 'center-line)
  450. (global-set-key "" 'auto-fill-mode)
  451.  
  452. (global-set-key [M-C-y] 'clipboard-yank)
  453.  
  454.  
  455.  
  456. ; use M-pageup and M-oagedown to go to start and end of document
  457.  
  458. (global-set-key [M-prior] 'beginning-of-buffer)
  459. (global-set-key [M-next] 'end-of-buffer)
  460.  
  461. ;(setq Info-default-directory-list
  462. ;      (append Info-default-directory-list
  463. ;              '("/p/TeX/info")))
  464.  
  465. (autoload 'html-helper-mode "tempo.el" "Tempo Template Library" t)
  466. (autoload 'html-helper-mode "html-helper-mode.el" "HTML Helper Mode" t)
  467.  
  468. (autoload 'longlines-mode "longlines.el" "Minor mode for editing long lines." t)
  469.  
  470. (defun newline-back () "enter a newline; then go back"
  471.   (interactive)
  472.   (newline)
  473.   (backward-char))
  474.  
  475. (defun make-C-o-newline-back () "rebind C-o for longlines mode"
  476.   (interactive)
  477.   (local-set-key "" 'newline-back))
  478.  
  479. (add-hook 'longlines-mode-hook 'make-C-o-newline-back)
  480.  
  481. ;(autoload 'camldebug "camldebug.el" "OCaml debugger" t)
  482. (autoload 'tuareg-mode "tuareg" "Major mode for editing Caml code" t)
  483. (autoload 'camldebug "camldebug-tuareg.el" "Run the Caml debugger" t)
  484.  
  485. ; Necessary customizations for html-helper-mode
  486. (setq html-helper-do-write-file-hooks t)
  487. (setq html-helper-build-new-buffer t)
  488.  
  489. (put 'eval-expression 'disabled nil)
  490.  
  491. (set-variable 'spell-command "ispell -l")
  492.  
  493. (defun omegamacs () "Load omega macros" (interactive)
  494.   (load "~nr/emacs/omega")
  495. )
  496.  
  497.  
  498. ; Underline a section title with ~~~~ or another car, as per SLPJ
  499. (defun underline-with-char (char)
  500.    "Underline the previous line with copies of the character passed as argument"
  501.    (forward-line -1)
  502.    (let* ((bol (point))
  503.           (eol (progn (end-of-line) (point)))
  504.           (n   (- eol bol)))
  505.      (forward-line 1)
  506.      (insert-char char n)
  507.      (insert-char ?\n 1))
  508. )
  509.  
  510. (defun underline-with-tildes () "Underline the previous line with tildes"
  511.   (interactive)
  512.   (underline-with-char ?~))
  513.  
  514. (defun underline-with-dashes (c) "Underline the previous line with dashes"
  515.   (interactive "P")
  516.   (underline-with-char (if (consp c) ?= ?-)))
  517.  
  518. ; Highlight words
  519. (defun highlight-word () "Put stars around the current word (a little bogus)"
  520.   (interactive)
  521.   (backward-word 1)
  522.   (insert-char ?* 1)
  523.   (forward-word 1)
  524.   (insert-char ?* 1)
  525.   (forward-word 1)
  526.   (backward-word 1)
  527.   (forward-char 1)
  528. )
  529.  
  530. (load-library "lua-mode")
  531.  
  532. (add-hook 'lua-mode-hook 'font-lock-fontify-buffer)
  533.  
  534.  
  535. (defun lua-header-comment ()
  536.   "Make current line a 'section header' Lua comment"
  537.   (interactive)
  538.   (let* ((bol (progn (beginning-of-line) (point)))
  539.          (bos (if (not (looking-at "[ \t]+"))
  540.                   (point)
  541.                 (re-search-forward "[ \t]+")))
  542.          (eos (progn
  543.                 (end-of-line) (point)))
  544.          (spaces (- bos bol))
  545.          (width (- 72 spaces))
  546.          (string-width (- width (- eos bos)))
  547.          (dashes (- (/ string-width 2) 1))  ; leave room for space
  548.          (extra (if (= (* 2 (+ 1 dashes)) string-width) "" "-")))
  549.     (goto-char bos)
  550.     (insert-char ?- dashes)
  551.     (insert-char ?\  1)
  552.     (end-of-line)
  553.     (insert-char ?\  1)
  554.     (insert-char ?- dashes)
  555.     (insert extra)
  556.     (beginning-of-line)
  557.     (insert-char ?\  spaces)
  558.     (insert-char ?- width)
  559.     (insert-char ?\n 1)
  560.     (end-of-line)
  561.     (insert-char ?\n 1)
  562.     (insert-char ?\  spaces)
  563.     (insert-char ?- width)
  564.     (beginning-of-line)
  565.     (forward-line 1))
  566. )
  567.  
  568. (global-set-key "\C-X~" 'underline-with-tildes)
  569. (global-set-key "\C-X-" 'underline-with-dashes)
  570. (global-set-key "\M-*" 'highlight-word)
  571. (global-set-key "\M-8" 'highlight-word)
  572.  
  573. (defun ccc () "Short form of M-x compile" (interactive)
  574.   (compile)
  575. )
  576.  
  577. (defun learn-spam (&optional classification) "Change reply to learn spam" (interactive)
  578.      (goto-char (point-min))
  579.      (if (re-search-forward "^To:[  ]*" nil t)
  580.          (let ((beg (point)))
  581.            (end-of-line)
  582.            (delete-region beg (point))
  583.            (insert " nr")))
  584.      (goto-char (point-min))
  585.      (if (re-search-forward "^Subject:[     ]" nil t)
  586.          (let ((beg (point)))
  587.            (end-of-line)
  588.            (delete-region beg (point))
  589.            (insert " learn antiSpam! ")
  590.            (if classification (insert classification) (insert "spam"))))
  591.      (if (re-search-forward "^----" nil t)
  592.          (progn (beginning-of-line 2)
  593.                 (let ((beg (point)))
  594.                   (goto-char (point-max))
  595.                   (delete-region beg (point)))))
  596.      (goto-char (point-min))
  597.      (re-search-forward "^Subject:.*antiSpam! " nil t)
  598. )
  599. (defun learn-ham () "Change reply to learn ham/nonspam" (interactive)
  600.   (learn-spam "nonspam"))
  601. (defun learn-nonspam () "Change reply to learn ham/nonspam" (interactive)
  602.   (learn-spam "nonspam"))
  603.  
  604.  
  605.  
  606. (defun tag-subject-ANSWER () "Make [ANSWER] sole tag on subject line"
  607.   (interactive)
  608.   (save-excursion
  609.     (goto-char (point-min))
  610.     (if (re-search-forward "^Subject:[  ]" nil t)
  611.         (progn
  612.           (save-excursion
  613.             (let ((my-eol (save-excursion (end-of-line) (point))))
  614.               (while (re-search-forward "\\[[^]]*\\]\\( Re:\\)? *" my-eol t)
  615.                 (replace-match ""))))
  616.           (insert "[ANSWER] ")))))
  617.    
  618.  
  619. (defun cs152 () "Insert cs152 headers" (interactive)
  620.   (save-excursion
  621.      (goto-char (point-min))
  622.      (if (re-search-forward "^To:" nil t) (replace-match "Bcc:" t))
  623.      (goto-line 3)
  624.      (insert "To: cs152, cs152-news\nReply-to: cs152@fas.harvard.edu\n")
  625.      (tag-subject-ANSWER)))
  626.  
  627.  
  628. (defun x-np152-not-operative-now () "Insert cs152 headers but don't post" (interactive)
  629.   (save-excursion
  630.      (goto-line 3)
  631.      (insert "Cc: cs152\nReply-to: cs152@fas.harvard.edu\n")
  632.      (tag-subject-ANSWER)
  633.      (goto-char (point-min))
  634.      (if (re-search-forward "^--------\n" nil t) (insert "[not posted]\n\n"))))
  635.      
  636. (defun x-comp40-inactive () "Insert comp40 headers" (interactive)
  637.   (save-excursion
  638.      (goto-char (point-min))
  639.      (if (re-search-forward "^To:" nil t) (replace-match "Bcc:" t))
  640.      (if (re-search-forward "^Comments: In-reply-to.*") (replace-match "Comments: [redacted]"))
  641.      (goto-line 3)
  642.      (insert "To: comp40\nReply-to: comp40-staff@cs.tufts.edu\n")
  643.      (tag-subject-ANSWER)))
  644.  
  645. (defun x-comp40-old () "Old Insert comp40 headers" (interactive)
  646.   (save-excursion
  647.      (goto-char (point-min))
  648.      (if (re-search-forward "^To:" nil t) (replace-match "Bcc:" t))
  649.      (if (re-search-forward "^Comments: In-reply-to.*") (replace-match "Comments: [redacted]"))
  650.      (goto-line 3)
  651.      (insert "To: comp40\nReply-to: comp40-staff@cs.tufts.edu\n")
  652.      (goto-char (point-min))
  653.      (if (re-search-forward "^Subject:[     ]" nil t) (insert "[ANSWER] "))))
  654.  
  655.  
  656. (defun x-np40-inactive () "Insert comp40 headers but don't post" (interactive)
  657.   (save-excursion
  658.      (goto-line 3)
  659.      (insert "Cc: comp40-staff@cs.tufts.edu\nReply-to: comp40-staff@cs.tufts.edu\n")
  660.      (tag-subject-ANSWER)
  661.      (goto-char (point-min))
  662.      (if (re-search-forward "^--------\n" nil t) (insert "[private response]\n\n"))))
  663.      
  664. (defun comp105 () "Insert comp105 headers" (interactive)
  665.   (save-excursion
  666.      (goto-char (point-min))
  667.      (if (re-search-forward "^To:" nil t) (replace-match "Bcc:" t))
  668.      (if (re-search-forward "^Comments: In-reply-to.*") (replace-match "Comments: [redacted]"))
  669.      (goto-line 3)
  670.      (insert "To: comp105\nReply-to: comp105-staff@cs.tufts.edu\n")
  671.      (tag-subject-ANSWER)))
  672.  
  673. (defun np105 () "Insert comp105 headers but don't post" (interactive)
  674.   (save-excursion
  675.      (goto-line 3)
  676.      (insert "Cc: comp105-staff@cs.tufts.edu\nReply-to: comp105-staff@cs.tufts.edu\n")
  677.      (tag-subject-ANSWER)
  678.      (goto-char (point-min))
  679.      (if (re-search-forward "^--------\n" nil t) (insert "[private response]\n\n"))))
  680.      
  681.  
  682.  
  683.  
  684. (defun better-transpose (number)
  685.   "Transpose characters before point" (interactive "p")
  686.   (backward-char)
  687.   (transpose-chars number)
  688. )
  689. (defun better-transpose-words (number)
  690.   "Transpose words before point" (interactive "p")
  691.   (forward-word -1)
  692.   (transpose-words 1)
  693. )
  694. (global-set-key "\C-t" 'better-transpose)
  695. (global-set-key "\M-t" 'better-transpose-words)
  696. (defun better-up-list (number)
  697.   "Move forward out of one level of parentheses, setting mark. Vide up-list"
  698.   (interactive "p")
  699.   (point-to-register 64)
  700.   (exchange-point-and-mark)
  701.   (register-to-point 64)
  702.   (up-list number)
  703. )
  704. (defun double-quote () "Insert a double quote" (interactive)
  705.   (tex-insert-quote 1)
  706. )
  707. (defun recognize-ocaml-error-messages
  708.  ()
  709.    "Add regexp for OCaml error messages to the regexp list used by M-x compile and compilation-mode"
  710.   (interactive)
  711.   (add-to-list 'compilation-error-regexp-alist
  712.     '(
  713.       ;; OCaml
  714.       ;; File "foo.nw", line 4, characters 9-24:
  715.       "^File \"\\(.+\\)\", line \\([0-9]+\\), characters? \\([0-9]+\\).*:"
  716.        1 2 3
  717.      )
  718.   )
  719. )
  720.  
  721. (defun recognize-utlnx-error-messages
  722.  ()
  723.    "Add regexp for validate-utlnx error messages to the regexp list used by M-x compile and compilation-mode"
  724.   (interactive)
  725.   (add-to-list 'compilation-error-regexp-alist
  726.     '(
  727.       ;; validate-utlnx
  728.       ;; scheme.grades, line 418: column scm5 for mleise01 does not include a grade
  729.       "^\\([^[:space:]]+\\), line  *\\([0-9]+\\):"
  730.        1 2
  731.      )
  732.   )
  733. )
  734.  
  735. (defun recognize-lint-error-messages
  736.  ()
  737.    "Add regexp for ml-lint error messages to the regexp list used by M-x compile and compilation-mode"
  738.   (interactive)
  739.   (add-to-list 'compilation-error-regexp-alist
  740.     '(
  741.       ;; sml-lint
  742.       ;; top.sml, line 418, column 50: redundant parentheses around name
  743.       "^\\([^[:space:]]+\\), line  *\\([0-9]+\\),  *column  *\\([0-9]+\\):"
  744.        1 2 3
  745.      )
  746.   )
  747. )
  748.  
  749. (defun recognize-gcc-error-messages
  750.  ()
  751.    "Add regexp for gcc error messages to the regexp list used by M-x compile and compilation-mode"
  752.   (interactive)
  753.   (add-to-list 'compilation-error-regexp-alist
  754.     '(
  755.       ;; gcc
  756.       ;; impcore.nw:2039:1: error: unknown type name ‘Def’
  757.       ;;
  758.       "^\\([^ \t\n:.][^ \n\t:]*\\):\\([0-9]+\\):\\([0-9]+\\): error"
  759.        1 2 3
  760.      )
  761.   ))
  762.  
  763. (recognize-gcc-error-messages)
  764.  
  765.  
  766. (defun recognize-lua-error-messages
  767.  ()
  768.    "Add regexp for Lua error messages to the regexp list used by M-x compile and compilation-mode"
  769.   (interactive)
  770.   (add-to-list 'compilation-error-regexp-alist
  771.     '(
  772.       ;; Lua
  773.       ;; <tab>File:line: in function:
  774.       "^\t\\(.+\\):\\([0-9]+\\): in \\(function\\|method\\|main chunk\\|string\\|field\\|local\\| \n\\)"
  775.        1 2
  776.      )
  777.   )
  778.   (add-to-list 'compilation-error-regexp-alist
  779.     '(
  780.       ;; Lua
  781.       ;; <tab>File:line: ...
  782.       "^\t\\(.+lua\\):\\([0-9]+\\):"
  783.        1 2
  784.      )
  785.   )
  786.   (add-to-list 'compilation-error-regexp-alist
  787.     '(
  788.       ;; Lua
  789.       ;; /usr/bin/lua[0-9.]*: file:line:
  790.       "^/usr/bin/lua[0-9\\.]*: \\(.+\\):\\([0-9]+\\): "
  791.        1 2
  792.      )
  793.   )
  794. )
  795.  
  796. (defun recognize-sml-nj-error-messages ()
  797.    "Add regexps for SML/NJ or \-RTL error messages to the regexp list used by M-x compile and compilation-mode"
  798.   (interactive)
  799.   (add-to-list 'compilation-error-regexp-alist
  800.     '(
  801.       ;; Standard ML of New Jersey, \-RTL
  802.       ;; usm.nw:8217.5...usm.nw:8228.6 Error: case object and rules don't agree...
  803.       "^\\([^<>\n\t].*\\):\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\.\\..+\\(Error\\|Warning\\):"
  804.        1 2 3
  805.      )
  806.   )
  807.   (add-to-list 'compilation-error-regexp-alist
  808.     '(
  809.       ;; Standard ML of New Jersey, \-RTL
  810.       ;; unifailed.rtl:49.26-49.56 Error:
  811.       ;;           Function
  812.       ;;             byte
  813.       ;;           expected  >>> #8 bits <<<  but argument was  >>> #64 loc <<<
  814.       ;;            --> failed to unify  >>> #8 <<<  and  >>> #64 <<<
  815.       "^\\([^<>\n\t][^\n\t .]*\\(\\.[^.\n\t\ ]+\\)*\\):\\([0-9]+\\)\\.\\([0-9]+\\).+\\(Error\\|Warning\\):"
  816.        1 3 4
  817.      )
  818.   )
  819.  
  820. )
  821.  
  822. (defun recognize-mlton-error-messages ()
  823.    "Add regexp for MLton error messages to the regexp list used by M-x compile and compilation-mode"
  824.   (interactive)
  825.   (add-to-list 'compilation-error-regexp-alist
  826.     '(
  827.       ;; MLton
  828.       ;; Error: mlschemea.nw 289.25.
  829.       "^Error: \\([^<>\n\t].*\\) \\([0-9]+\\)\\.\\([0-9]+\\)\\."
  830.        1 2 3
  831.      )
  832.   )
  833. )
  834.  
  835. (defun recognize-lcc-error-messages
  836.  ()
  837.    "Add regexp for lcc error messages to the regexp list used by M-x compile and compilation-mode"
  838.   (interactive)
  839.   (add-to-list 'compilation-error-regexp-alist
  840.     '(
  841.       ;; lcc
  842.       ;; gc1.c: gc1.nw:1584: warning: missing prototype
  843.       ;;
  844.       "^\\([^:<>\n\t ].*: \\)* \\([^:\n]+\\):\\([0-9]+\\):"
  845.        2 3
  846.      )
  847.   )
  848. )
  849.  
  850.  
  851. (defun recognize-ghc-error-messages
  852.  ()
  853.    "Add regexp for ghc error messages to the regexp list used by M-x compile and compilation-mode"
  854.   (interactive)
  855.   (add-to-list 'compilation-error-regexp-alist
  856.     '(
  857.       ;; ghc
  858.       ;; DiceUnknown.hs:38:24:
  859.       ;;
  860.       "^\\([^<>: \n\t][^\n: <>]*\\):\\([0-9]+\\):\\([0-9]+\\):"
  861.        1 2 3
  862.      )
  863.   )
  864.   (add-to-list 'compilation-error-regexp-alist
  865.     '(
  866.       ;; ghc
  867.       ;; codeGen/CgInfoTbls.hs:260: Variable not in scope: `orElse'
  868.       ;;
  869.       "^\\([^<>: \n\t][^\n: <>]*\\):\\([0-9]+\\):[^0-9]"
  870.        1 2
  871.      )
  872.   )
  873.   (add-to-list 'compilation-search-path "..")
  874. )
  875.  
  876.  
  877. (defun recognize-lua-stack-traces
  878.  ()
  879.    "Add regexp for Lua stack-trace error messages to the regexp list used by M-x compile and compilation-mode"
  880.   (interactive)
  881.   (add-to-list 'compilation-error-regexp-alist
  882.     '(
  883.       ;; lua
  884.       ;;    /home/nr/cs/105/server/evaluation/sml.lua:144: '}' expected (to close '{' at line 138) near 'F'
  885.       ;;
  886.       "^\t\\([^ \t\n:.][^ \t\n:]*\\):\\([0-9]+\\):"
  887.        1 2
  888.      )
  889.   )
  890.   (add-to-list 'compilation-search-path "..")
  891. )
  892.  
  893.  
  894. (defun recognize-icon-error-messages ()
  895.    "Add regexp for Icon error messages to the regexp list used by M-x compile and compilation-mode"
  896.   (interactive)
  897.   (add-to-list 'compilation-error-regexp-alist
  898.     '(
  899.       ;; Icon
  900.       ;; File foo.nw; Line 4 # ")" : missing right bracket
  901.       "^File \\(.+\\); Line \\([0-9]+\\) #.*:"
  902.        1 2
  903.      )
  904.   )
  905. )
  906.  
  907.  
  908.  
  909. (defun recognize-no-error-messages ()
  910.    "Remove all regexps for error messages"
  911.   (interactive)
  912.   (setq compilation-error-regexp-alist '()))
  913.  
  914.  
  915.  
  916. (defun recognize-all-ml-error-messages ()
  917.    "Add regexp for SML/NJ or \-RTL or OCaml error messages to the regexp list used by M-x compile and compilation-mode"
  918.   (interactive)
  919.   (recognize-sml-nj-error-messages)
  920.   (recognize-mlton-error-messages)
  921.   (recognize-lcc-error-messages)
  922.   (recognize-ocaml-error-messages))
  923.  
  924. (defun set-up-tex-mode () "Put better-up-list in" (interactive)
  925.   (local-set-key "\e}" 'better-up-list)
  926.   (local-set-key "\e\"" 'double-quote)
  927.   (local-set-key "\C-j" 'newline-and-indent)
  928.   (local-set-key "\C-c\C-c" 'compile)
  929.   (abbrev-mode 1)
  930. )
  931.  
  932.  
  933. (defun c-c-compiles () "Make C-c run M-x compile" (interactive)
  934.   (local-set-key "\C-c\C-c" 'compile)
  935. )
  936.  
  937. (defun set-up-tuareg-mode () "Customize tuareg-mode" (interactive)
  938.   (setq tuareg-in-indent 0) ; no indentation after `in' keywords
  939. )
  940. (add-hook 'tuareg-mode-hook 'set-up-tuareg-mode)
  941.  
  942.  
  943. (defun makefile-mode-preferences () "set preferences for makefile mode" (interactive)
  944.   (local-set-key "\C-c\C-c" 'compile)
  945. )
  946. (add-hook 'makefile-mode-hook 'makefile-mode-preferences)
  947.  
  948. (add-hook 'after-change-major-mode-hook
  949.           (function (lambda ()
  950.                       (unless (or (equal major-mode 'text-mode)
  951.                                   (derived-mode-p 'special-mode))
  952.                         (c-c-compiles)))))
  953.  
  954.  
  955. (set-variable 'icon-indent-level 2)
  956. (defun icon-mode-preferences () "set preferences for icon mode" (interactive)
  957.   (set-variable 'icon-indent-level 2)
  958.   (local-set-key "\C-c\C-c" 'compile)
  959. )
  960. (add-hook 'icon-mode-hook 'icon-mode-preferences)
  961.  
  962. (defun hanson () "Use Hanson's indentation conventions" (interactive)
  963.  (set-variable 'c-indent-level 8)
  964.  (set-variable 'c-continued-statement-offset 8)
  965.  (set-variable 'c-label-offset -4)
  966. )
  967. ;(global-set-key "" 'suspend-emacs)
  968. (setq default-abbrev-file "~nr/emacs/abbrevs")
  969. (setq default-abbrev-file "~nr/.abbrev_defs")
  970. (defun new-abbrevs () "read the default abbrev file" (interactive)
  971.   (read-abbrev-file default-abbrev-file)
  972.   (setq save-abbrevs nil)  ; don't bleat every time I run mk
  973.   (setq save-abbrevs t)    ; but don't lose my new abbrevs!
  974. )
  975. (defun edit-abbrevs() "edit the default abbrev file" (interactive)
  976.   (find-file default-abbrev-file)
  977. )
  978. (new-abbrevs)
  979. (global-set-key "\C-X\C-A" 'abbrev-mode)
  980.  
  981. (put 'minibuffer-complete-and-exit 'disabled nil)
  982.  
  983. (defun ignore-completion-extension (s) "ignore an extension"
  984.   (if (member s completion-ignored-extensions)
  985.       completion-ignored-extensions
  986.     (setq completion-ignored-extensions
  987.       (cons s completion-ignored-extensions))))
  988.  
  989. (ignore-completion-extension ".ps")
  990. (ignore-completion-extension ".pdf")
  991. (ignore-completion-extension ".pro")
  992. (ignore-completion-extension ".hi")
  993. (ignore-completion-extension ".hc")
  994.  
  995. (defun bad-rev () "Revert buffer, with shorter querty" (interactive)
  996.   (if (y-or-n-p "Revert buffer, losing undo information? ")
  997.       (save-excursion ;; not sufficient to restore point!
  998.          (revert-buffer 't 't)))
  999. )
  1000.  
  1001. (defun rev () "Revert buffer, with shorter querty" (interactive)
  1002.   (if (y-or-n-p "Revert buffer, losing undo information? ")
  1003.       (let ((cur (point)))
  1004.         (unwind-protect
  1005.             (save-excursion
  1006.               (revert-buffer 't 't)
  1007.               (goto-char cur))
  1008.           (goto-char cur))))
  1009. )
  1010.  
  1011. (global-set-key "\er" 'rev)
  1012.  
  1013.  
  1014. (defun flow-control () "Remap keys for flow control" (interactive)
  1015.   (load "~nr/emacs/xon")
  1016. )
  1017. (defun no-flow-control () "Undo effects of flow-control" (interactive)
  1018.   (load "~nr/emacs/xoff")
  1019. )
  1020. (set-variable 'c-indent-level 2)
  1021. (defun mark-mail () "Put arrows in mail" (interactive)
  1022.   (replace-regexp "^[   ]" "> "))
  1023. (defun unmark-mail () "Remove arrows from mail" (interactive)
  1024.   (replace-regexp "^> " ""))
  1025. (defun insert-arrows () "Add arrows in column 1" (interactive)
  1026.   (replace-regexp "^" "> "))
  1027. (defun print-current-line () "Print current line and column number" (interactive)
  1028.   (message "On line %d, column %d.   (bogus ml-lex yypos %d, column %d)"
  1029.        (+ (count-lines 1 (point))
  1030.           (if (= (current-column) 0) 1 0))
  1031.        (- (point)
  1032.           (save-excursion
  1033.         (beginning-of-line)
  1034.         (point)))
  1035.        (+ (- (point) (point-min)) 2)
  1036.        (+ (- (point)
  1037.          (save-excursion
  1038.            (beginning-of-line)
  1039.            (point)))
  1040.           1)))
  1041.  
  1042. (defun shell-command-replace (command)
  1043.   "Run shell command on region and replace it"
  1044.   (interactive "sCommand to run on region: ")
  1045.   (shell-command-on-region (mark) (point) command nil 't)
  1046. )
  1047.  
  1048. (defvar nr-block-string "/*nr*/" "*string inserted by nr-block function")
  1049. (defun nr-block (count) "(nr-block count) inserts count lins of nr-block-string"
  1050.   (interactive "Nnumber of lines to insert? ")
  1051.   (let ((col (current-column)))
  1052.      (while (> count 0)
  1053.         (progn
  1054.        (insert nr-block-string)
  1055.        (forward-line)
  1056.        (move-to-column col 't)
  1057.        (setq count (- count 1))))
  1058.      (if (eolp) (delete-horizontal-space))))
  1059.  
  1060.  
  1061.      
  1062.  
  1063.  
  1064.  
  1065. (defun unquote ()
  1066.    "Unquote quoted-printable = sign escapes"
  1067.    (interactive)
  1068.    (shell-command-on-region (mark) (point)
  1069.                             "sed 's/^ > //g' | unquote | sed 's/^/ > /'" nil 't)
  1070. )
  1071.  
  1072. (defun filed-with-reprints () "Insert where= in bibtex file" (interactive)
  1073.   (beginning-of-line)
  1074.   (insert "  where=\"filed with reprints\",\n")
  1075. )
  1076. (global-set-key "\eg" 'goto-line)
  1077. (global-set-key "\C-Xl" 'print-current-line)
  1078.  
  1079. (defun adjust-lua-indent-level ()
  1080.   (set-variable 'lua-indent-level 2))
  1081.  
  1082.  
  1083.  
  1084.  
  1085. (autoload 'html-mode "~/emacs/html-mode" "Editing HTML files." t)
  1086. (defun html-mode-c-c-compile () "Make C-c C-c call M-x compile" (interactive)
  1087.   (define-key html-mode-map "\C-c\C-c" 'compile))
  1088.  
  1089. (add-hook 'html-hook 'html-mode-c-c-compile t)
  1090. (setq auto-mode-alist (append (list (cons "\\.html$" 'html-mode))
  1091.                   auto-mode-alist))
  1092.  
  1093.      (setq auto-mode-alist
  1094.            (append auto-mode-alist
  1095.                    '(("\\.[hg]s$"  . haskell-mode)
  1096.                      ("\\.hi$"     . haskell-mode)
  1097.                      ("\\.l[hg]s$" . literate-haskell-mode))))
  1098.      (autoload 'haskell-mode "haskell-mode"
  1099.         "Major mode for editing Haskell scripts." t)
  1100.      (autoload 'literate-haskell-mode "haskell-mode"
  1101.         "Major mode for editing literate Haskell scripts." t)
  1102.  
  1103.  ;; (add-hook 'haskell-mode-hook 'turn-on-haskell-font-lock)
  1104.  ;; (add-hook 'haskell-mode-hook 'turn-on-haskell-decl-scan)
  1105.   (add-hook 'haskell-mode-hook 'turn-on-haskell-doc-mode)
  1106.   (add-hook 'haskell-mode-hook 'turn-on-haskell-indent)
  1107.  ;; (add-hook 'haskell-mode-hook 'turn-on-haskell-simple-indent)
  1108. ;;  (add-hook 'haskell-mode-hook 'turn-on-haskell-hugs)
  1109.   (add-hook 'haskell-mode-hook 'bind-compile-key)
  1110.   (add-hook 'c-mode-hook 'bind-compile-key)
  1111.   (add-hook 'c++-mode-hook 'bind-compile-key)
  1112.   (add-hook 'sml-mode-hook 'bind-compile-key)
  1113.   (add-hook 'lua-mode-hook 'adjust-lua-indent-level)
  1114.   (add-hook 'lua-mode-hook '(lambda () (setq lua-electric-flag nil)))
  1115.   (add-hook 'lua-mode-hook 'bind-compile-key)
  1116.   (add-hook 'lua-mode-hook 'bind-lua-header-key)
  1117.  
  1118. (defun bind-lua-header-key ()
  1119.   (local-set-key "\C-c-" 'lua-header-comment))
  1120.  
  1121.      (autoload 'lua-mode "lua-mode"
  1122.         "Major mode for editing Lua scripts." t)
  1123.  
  1124.      (setq auto-mode-alist
  1125.            (append auto-mode-alist
  1126.                    '(("\\.lua$"  . lua-mode)
  1127.                      ("\\.nbs$"  . lua-mode)
  1128.                      ("\\.tracksl$"  . lua-mode)
  1129.                      ("\\.nws$"  . lua-mode))))
  1130.  
  1131. (add-to-list 'interpreter-mode-alist '("lua5.1" . lua-mode))
  1132. (add-to-list 'interpreter-mode-alist '("/usr/bin/lua5.1" . lua-mode))
  1133. (add-to-list 'interpreter-mode-alist '("lua40" . lua-mode))
  1134. (add-to-list 'interpreter-mode-alist '("lua50" . lua-mode))
  1135. (add-to-list 'interpreter-mode-alist '("lua" . lua-mode))
  1136. (add-to-list 'interpreter-mode-alist '("lua5.1-courseware" . lua-mode))
  1137.  
  1138. (defun bind-compile-key ()
  1139.   (local-set-key "\C-c\C-c" 'compile))
  1140.  
  1141. (global-set-key "\C-c\C-c" 'compile)
  1142.  
  1143. (setq auto-mode-alist
  1144.       (cons '("\\.ml[iylpb]?$" . caml-mode) auto-mode-alist))
  1145. (autoload 'caml-mode "caml" "Major mode for editing Caml code." t)
  1146. (autoload 'run-caml "inf-caml" "Run an inferior Caml process." t)
  1147.  
  1148.  
  1149. ;(autoload 'odin "/usr/public/src/cmd/Odin/etc/odin" nil t)
  1150. (setq auto-mode-alist (append (list (cons "\\.tib$" 'tex-mode))
  1151.                   auto-mode-alist))
  1152.  
  1153. (autoload 'sml-mode "sml-mode" "Major mode for editing ML programs." t)
  1154. (setq auto-mode-alist
  1155.       (append '(("\\.sml$" . sml-mode) ("\\.cm$" . sml-mode) ("\\.rtl$" . sml-mode)
  1156.         ("\\.lrtl$" . sml-mode)
  1157.         ("\\.sled$" . sml-mode) ("\\.sig$"  . sml-mode)) auto-mode-alist))
  1158. (setq sml-mode-info "~nr/emacs/sml-mode.info")
  1159. (defun sml-new-prompt () "skip errors and go to prompt" (interactive)
  1160.   (sml-skip-errors)
  1161.   (sml-next-error)
  1162. )
  1163. (defun set-up-sml-mode () "set preferences for sml" (interactive)
  1164. ;   (setq sml-indent-level 2)
  1165.   (setq sml-case-indent t)
  1166.   (setq indent-tabs-mode nil)
  1167.   (local-set-key "\C-ck" 'sml-new-prompt)
  1168. )
  1169. (add-hook 'sml-mode-hook 'set-up-sml-mode)
  1170.  
  1171. (defun set-up-caml-mode () "set preferences for caml" (interactive)
  1172.   (setq caml-case-indent t)
  1173.   (setq indent-tabs-mode nil)
  1174.   (local-set-key "\C-ck" 'caml-new-prompt)
  1175. )
  1176. (add-hook 'caml-mode-hook 'set-up-caml-mode)
  1177.  
  1178. (setq sml-program-name "sml-nw")
  1179. (setq sml-program-name "sml")
  1180.  
  1181. (defun search-list (x l) "look up in a list"
  1182.   (cond
  1183.    ((null l) nil)
  1184.    ((equal (car l) x) t)
  1185.    (t (search-list x (cdr l)))))
  1186.  
  1187. (defun search-list (x l)
  1188.   "Search for x on l"
  1189.   (let ((list l)
  1190.         found)
  1191.     (while (not (or found (null l)))
  1192.       (if (equal x (car list))
  1193.       (setq found t)
  1194.     (setq list (cdr list))))
  1195.     found))
  1196.  
  1197. (defun exists-buffer (n) "search for buffer" (interactive "sName of buffer?")
  1198.   (search-list n (buffer-list)))
  1199.  
  1200.  
  1201.  
  1202. ;(autoload 'mud "/u/norman/emacs/mud" nil t)
  1203. (autoload 'mud "/usr/public/lib/emacs/mud" nil t)
  1204. (setq mud-use-entire-window t)
  1205. (setq mud-default-default-server "LambdaMOO")
  1206.  
  1207. ;;;     (push auto-mode-alist '( "\\.fw" . funnelweb-mode))
  1208.  
  1209.  
  1210. ;(load-library "assoc")
  1211.  
  1212.  
  1213. (defun keymaps-at-point ()
  1214.   "List entire keymaps present at point."
  1215.   (interactive)
  1216.   (let ((map-list
  1217.          (list
  1218.           (mapcar (lambda (overlay)
  1219.                     (overlay-get overlay 'keymap))
  1220.                   (overlays-at (point)))
  1221.           (mapcar (lambda (overlay)
  1222.                     (overlay-get overlay 'local-map))
  1223.                   (overlays-at (point)))
  1224.           (get-text-property (point) 'keymap)
  1225.           (get-text-property (point) 'local-map))))
  1226.     (apply #'message
  1227.            (concat
  1228.             "Overlay keymap: %s\n"
  1229.             "Overlay local-map: %s\n"
  1230.             "Text-property keymap: %s\n"
  1231.             "Text-property local-map: %s")
  1232.            map-list)))
  1233.  
  1234. (defun key-binding-at-point (key)
  1235.   (mapcar (lambda (keymap) (when (keymapp keymap)
  1236.                              (lookup-key keymap key)))
  1237.           (list
  1238.            ;; More likely
  1239.            (get-text-property (point) 'keymap)
  1240.            (mapcar (lambda (overlay)
  1241.                      (overlay-get overlay 'keymap))
  1242.                    (overlays-at (point)))
  1243.            ;; Less likely
  1244.            (get-text-property (point) 'local-map)
  1245.            (mapcar (lambda (overlay)
  1246.                      (overlay-get overlay 'local-map))
  1247.                    (overlays-at (point))))))
  1248.  
  1249. (defun locate-key-binding (key)
  1250.   "Determine in which keymap KEY is defined."
  1251.   (interactive "kPress key: ")
  1252.   (let ((ret
  1253.          (list
  1254.           (key-binding-at-point key)
  1255.           (minor-mode-key-binding key)
  1256.           (local-key-binding key)
  1257.           (global-key-binding key))))
  1258.     (when (called-interactively-p 'any)
  1259.       (message "At Point: %s\nMinor-mode: %s\nLocal: %s\nGlobal: %s"
  1260.                (or (nth 0 ret) "")
  1261.                (or (mapconcat (lambda (x) (format "%s: %s" (car x) (cdr x)))
  1262.                               (nth 1 ret) "\n             ")
  1263.                    "")
  1264.                (or (nth 2 ret) "")
  1265.                (or (nth 3 ret) "")))
  1266.     ret))
  1267.  
  1268.  
  1269.  
  1270. (defun aput (alist-symbol key &optional value)
  1271.   "Inserts a key-value pair into an alist.
  1272. The alist is referenced by ALIST-SYMBOL.  The key-value pair is made
  1273. from KEY and optionally, VALUE.  Returns the altered alist or nil if
  1274. ALIST is nil.
  1275.  
  1276. If the key-value pair referenced by KEY can be found in the alist, and
  1277. VALUE is supplied non-nil, then the value of KEY will be set to VALUE.
  1278. If VALUE is not supplied, or is nil, the key-value pair will not be
  1279. modified, but will be moved to the head of the alist.  If the key-value
  1280. pair cannot be found in the alist, it will be inserted into the head
  1281. of the alist (with value nil if VALUE is nil or not supplied)."
  1282.   (let ((a (assq key (eval alist-symbol))))
  1283.     (if a
  1284.         (setcdr a value)
  1285.       (set alist-symbol (cons (cons key value) (eval alist-symbol))))))
  1286.  
  1287. (setq auto-mode-case-fold nil)
  1288.  
  1289. (aput 'auto-mode-alist "^[0-9]+\\'" 'text-mode)
  1290. (aput 'auto-mode-alist "/[0-9]+\\'" 'text-mode)
  1291. (aput 'auto-mode-alist "^[-A-Z]+\\'" 'text-mode)
  1292. (aput 'auto-mode-alist "/[-A-Z]+\\'" 'text-mode)
  1293. (aput 'auto-mode-alist "/nr/todo/[-a-z]+$" 'text-mode)
  1294. (aput 'auto-mode-alist "draft$" 'text-mode)
  1295. (aput 'auto-mode-alist "/notes$" 'text-mode)
  1296. (aput 'auto-mode-alist "\\.grades$" 'text-mode)
  1297. (aput 'auto-mode-alist "^notes$" 'text-mode)
  1298. (aput 'auto-mode-alist "\\.page$" 'text-mode)
  1299. (aput 'auto-mode-alist "^template$" 'text-mode)
  1300. (aput 'auto-mode-alist "/template$" 'text-mode)
  1301. (aput 'auto-mode-alist "\\.md$" 'text-mode)
  1302. (aput 'auto-mode-alist "^mail\\.Re" 'text-mode)
  1303. (aput 'auto-mode-alist "/mail\\.Re" 'text-mode)
  1304. (aput 'auto-mode-alist "^cvs[a-zA-Z0-9]+$" 'text-mode)
  1305. (aput 'auto-mode-alist "/cvs[a-zA-Z0-9]+$" 'text-mode)
  1306. (aput 'auto-mode-alist "svn-commit\\.tmp$" 'text-mode)
  1307. (aput 'auto-mode-alist "next-actions" 'text-mode)
  1308. (aput 'auto-mode-alist "grades/emails/[0-9][0-9]" 'text-mode)
  1309.  
  1310. (aput 'auto-mode-alist "\\.ig$" 'modula-3-mode)
  1311. (aput 'auto-mode-alist "\\.mg$" 'modula-3-mode)
  1312. (aput 'auto-mode-alist "\\.i3$" 'modula-3-mode)
  1313. (aput 'auto-mode-alist "\\.m3$" 'modula-3-mode)
  1314.  
  1315. (aput 'auto-mode-alist "\\.latex$" 'tex-mode)
  1316. (aput 'auto-mode-alist "\\.sty$" 'tex-mode)
  1317.  
  1318. (aput 'auto-mode-alist "\\.html$" 'text-mode)
  1319.  
  1320. (assq-delete-all "\\.bib$"   auto-mode-alist)
  1321. (assq-delete-all "\\.bib\\'" auto-mode-alist)
  1322.  
  1323. (setq my-awful-emacs-test (assq "\\.bib\\'" auto-mode-alist))
  1324.  
  1325. (autoload 'modula-3-mode "/usr/local/m3/lib/elisp/modula3" nil t)
  1326.  
  1327. (defun m3-mode-hook-function ()
  1328.   (setq m3-abbrev-enabled 'polite)
  1329.   (setq m3-electric-end 'all) ;; or 'proc-mod if you find this too intrusive   
  1330.   (setq m3-blink-end-matchers t))
  1331.  
  1332. (add-hook 'm3-mode-hook 'm3-mode-hook-function)
  1333.  
  1334. ; try this only on an older emacs---presumably a newer is built in?
  1335. (if (and (string< "20" emacs-version) (string< emacs-version "22"))
  1336.    ; (load "mwheel.el")
  1337.   0)
  1338.  
  1339. (setq-default indent-tabs-mode nil)
  1340. (defun my-tab-key ()
  1341.   "Tab that always tabs in Fundamental mode" (interactive)
  1342.   (if (string= "Fundamental" mode-name)
  1343.       (insert "\t")
  1344.     (if (and (boundp 'noweb-mode) noweb-mode
  1345.              (not (and (boundp 'mini-noweb-mode) mini-noweb-mode)))
  1346.         (save-restriction
  1347.           (noweb-update-chunk-vector)
  1348.           (noweb-narrow-to-chunk)
  1349.           (indent-for-tab-command))
  1350.       (indent-for-tab-command))))
  1351. (defun my-newline-and-indent ()
  1352.   "Newline and indent that works better with noweb mode"
  1353.   (interactive "*")
  1354.   (if (and (boundp 'noweb-mode) noweb-mode
  1355.            (not (and (boundp 'mini-noweb-mode) mini-noweb-mode)))
  1356.       (save-restriction
  1357.         (noweb-update-chunk-vector)
  1358.         (noweb-narrow-to-chunk)
  1359.         (newline-and-indent))
  1360.       (newline-and-indent)))
  1361. (defun use-my-indent-keys ()
  1362.   "Locally bind tab and ^J to keys that indent better" (interactive)
  1363.   (local-set-key "\t" 'my-tab-key)
  1364.   (local-set-key "\C-j" 'my-newline-and-indent))
  1365.  
  1366. (global-set-key "\t" 'my-tab-key)
  1367. (add-hook 'noweb-select-code-mode-hook 'use-my-indent-keys)
  1368.  
  1369.  
  1370.  
  1371.  
  1372.  
  1373. ;;;;;;;;;;;;;;;; joys of emacs 19 ;;;;;;;;;;;;;;;;
  1374. (if (string< emacs-version "19")
  1375.     0
  1376.   (progn
  1377.     (require 'rect)
  1378.     (if (fboundp 'apply-on-rectangle)
  1379.       (progn
  1380.         (defun my-open-rectangle (start end)
  1381.           "Blank out rectangle with corners at point and mark, shifting text right.
  1382. The text previously in the region is not overwritten by the blanks,
  1383. but instead winds up to the right of the rectangle.
  1384. And then run untabify for NO tabs"
  1385.           (interactive "r")
  1386.           (apply-on-rectangle 'open-rectangle-line start end nil)
  1387.           (untabify start end)
  1388.           (goto-char start))
  1389.         (autoload 'operate-on-rectangle "rect.el"))
  1390.       (progn
  1391.         (defun my-open-rectangle (start end)
  1392.           "Blank out rectangle with corners at point and mark, shifting text right.
  1393. The text previously in the region is not overwritten by the blanks,
  1394. but instead winds up to the right of the rectangle.
  1395. And DON'T insert any tabs"
  1396.           (interactive "r")
  1397.           (operate-on-rectangle 'open-rectangle-line start end nil)
  1398.           (untabify start end))))
  1399.     (autoload 'operate-on-rectangle "rect.el")
  1400.     (global-set-key "\C-xro" 'my-open-rectangle)
  1401.     (defun my-delete-rectangle (start end)
  1402.       "Delete (don't save) text in rectangle with point and mark as corners.
  1403. The same range of columns is deleted in each line starting with the line
  1404. where the region begins and ending with the line where the region ends."
  1405.       (interactive "r")
  1406.       (operate-on-rectangle 'delete-rectangle-line start end t)
  1407.       (untabify start end))
  1408.     (defun indent-paragraph () "Indent current paragraph by paragraph-indent-level"
  1409.       (interactive)
  1410.       (mark-paragraph)
  1411.       (while (eolp) (forward-char 1))
  1412.       (forward-char paragraph-indent-level)
  1413.       (exchange-point-and-mark)
  1414.       (beginning-of-line)
  1415.       (my-open-rectangle (mark) (point)))
  1416.    
  1417.     (defun my-find-alternate-file (filename)
  1418.       "Find file FILENAME, select its buffer, kill previous buffer.
  1419. If the current buffer now contains an empty file that you just visited
  1420. \(presumably by mistake), use this command to visit the file you really want."
  1421.       (interactive
  1422.        (let ((file buffer-file-name)
  1423.          (file-name nil)
  1424.          (file-dir nil))
  1425.      (and file
  1426.           (setq file-name (file-name-nondirectory file)
  1427.             file-dir (file-name-directory file)))
  1428.      (list (read-file-name
  1429.         "Find alternate file: " file-dir))))
  1430.       (and (buffer-modified-p)
  1431.        ;; (not buffer-read-only)
  1432.        (not (yes-or-no-p (format "Buffer %s is modified; kill anyway? "
  1433.                      (buffer-name))))
  1434.        (error "Aborted"))
  1435.       (let ((obuf (current-buffer))
  1436.         (ofile buffer-file-name)
  1437.         (onum buffer-file-number)
  1438.         (otrue buffer-file-truename)
  1439.         (oname (buffer-name)))
  1440.     (rename-buffer " **lose**")
  1441.     (setq buffer-file-name nil)
  1442.     (setq buffer-file-number nil)
  1443.     (setq buffer-file-truename nil)
  1444.     (unwind-protect
  1445.         (progn
  1446.           (unlock-buffer)
  1447.           (find-file filename))
  1448.       (cond ((eq obuf (current-buffer))
  1449.          (setq buffer-file-name ofile)
  1450.          (setq buffer-file-number onum)
  1451.          (setq buffer-file-truename otrue)
  1452.          (lock-buffer)
  1453.          (rename-buffer oname))))
  1454.     (or (eq (current-buffer) obuf)
  1455.     (kill-buffer obuf))))
  1456.  
  1457.  
  1458. (global-unset-key "\C-xm") ;; don't launch mail
  1459.  
  1460. (when (fboundp 'set-auto-mode)
  1461.   (defun my-set-auto-mode ()
  1462.     "Set the current buffer's mode automatically"
  1463.     (interactive)
  1464.     (set-auto-mode))
  1465.   (global-set-key "\M-m" 'my-set-auto-mode))
  1466.  
  1467.  
  1468.     (set-variable 'paragraph-indent-level 2)
  1469.     (global-set-key "\M-p" 'indent-paragraph)
  1470.     (global-set-key "\C-xrd" 'my-delete-rectangle)
  1471.     (global-set-key "\C-x\C-q" 'toggle-read-only)
  1472.     (global-set-key "\C-x\e" 'repeat-complex-command)
  1473.     (global-set-key "\C-x\C-v" 'my-find-alternate-file)
  1474.     (global-set-key "\M-i" 'indented-text-mode)
  1475.     (global-unset-key [C-down-mouse-2])
  1476.     (global-set-key [C-mouse-2] 'mouse-kill)
  1477.     (global-set-key [S-mouse-2] 'mouse-kill-ring-save)
  1478.     (global-set-key [end] 'end-of-line)
  1479.     (global-set-key [home] 'beginning-of-line)
  1480.     (global-set-key [M-end] 'end-of-buffer)
  1481.     (global-set-key [M-home] 'beginning-of-buffer)))
  1482.  
  1483.  
  1484. (menu-bar-mode -1)
  1485.  
  1486. (if (fboundp 'scroll-bar-mode)
  1487.     (scroll-bar-mode -1))
  1488.  
  1489. (if (fboundp 'tool-bar-mode)
  1490.     (tool-bar-mode -1))
  1491.  
  1492.  
  1493. (put 'downcase-region 'disabled nil)
  1494.  
  1495. (defalias 'unblock-comments (read-kbd-macro
  1496. "C-s 4** C-a 2*C-k C-n 2*C-k C-p 3*C-d M-\\ C-e 3*DEL M-\\ C-SPC C-a
  1497. <<capitalize-region>> C-a \\ section{ C-e } RET < *"))
  1498.  
  1499. (auto-compression-mode 't)
  1500.  
  1501. (global-set-key [S-delete] 'keyboard-quit)
  1502.  
  1503. (eval-after-load "compile"
  1504.   '(add-hook 'compilation-mode-hook 'recognize-ghc-error-messages))
  1505.  
  1506. (eval-after-load "compile"
  1507.   '(add-hook 'compilation-mode-hook 'recognize-lua-stack-traces))
  1508.  
  1509.  (eval-after-load "compile"
  1510.    '(add-hook 'compilation-mode-hook 'recognize-icon-error-messages))
  1511.  
  1512.  (eval-after-load "compile"
  1513.     '(add-hook 'compilation-mode-hook 'recognize-all-ml-error-messages))
  1514.  
  1515.  (eval-after-load "compile"
  1516.     '(add-hook 'compilation-mode-hook 'recognize-lint-error-messages))
  1517.  
  1518.  (eval-after-load "compile"
  1519.     '(add-hook 'compilation-mode-hook 'recognize-lua-error-messages))
  1520.  
  1521.  (eval-after-load "compile"
  1522.     '(add-hook 'compilation-mode-hook 'recognize-utlnx-error-messages))
  1523.  
  1524. ;; (eval-after-load "compile"
  1525. ;;    '(setq compilation-search-path (cons ".." compilation-search-path)))
  1526.  
  1527.  
  1528. (custom-set-variables
  1529.  ;; custom-set-variables was added by Custom.
  1530.  ;; If you edit it by hand, you could mess it up, so be careful.
  1531.  ;; Your init file should contain only one such instance.
  1532.  ;; If there is more than one, they won't work right.
  1533.  '(adaptive-fill-regexp "[  ]*\\([-–!|#%;>*·•‣⁃◦]+[  ]*\\)*")
  1534.  '(compilation-search-path (quote (nil "..")))
  1535.  '(default-input-method "TeX")
  1536.  '(desktop-globals-to-save
  1537.    (quote
  1538.     (desktop-missing-file-warning tags-file-name tags-table-list search-ring regexp-search-ring register-alist file-name-history compile-command)))
  1539.  '(desktop-path (quote ("~")))
  1540.  '(electric-indent-mode nil)
  1541.  '(filladapt-token-table
  1542.    (quote
  1543.     (("^" beginning-of-line)
  1544.      (">+" citation->)
  1545.      ("\\(\\w\\|[0-9]\\)[^'`\"<    
  1546. ]*>[    ]*" supercite-citation)
  1547.      (";+" lisp-comment)
  1548.      ("#+" sh-comment)
  1549.      ("%+" postscript-comment)
  1550.      ("///*" c++-comment)
  1551.      ("@c[  ]" texinfo-comment)
  1552.      ("@comment[    ]" texinfo-comment)
  1553.      ("\\\\item[    ]" bullet)
  1554.      ("[0-9]+\\.[   ]" bullet)
  1555.      ("[0-9]+\\(\\.[0-9]+\\)+[  ]" bullet)
  1556.      ("[A-Za-z]\\.[     ]" bullet)
  1557.      ("(?[0-9]+)[   ]" bullet)
  1558.      ("(?[@A-Za-z])[    ]" bullet)
  1559.      ("[0-9]+[A-Za-z]\\.[   ]" bullet)
  1560.      ("(?[0-9]+[A-Za-z])[   ]" bullet)
  1561.      ("[-~*+]+[     ]" bullet)
  1562.      ("o[   ]" bullet)
  1563.      ("[    ]+" space)
  1564.      ("$" end-of-line))))
  1565.  '(ispell-personal-dictionary "~/.ispell_words")
  1566.  '(ispell-program-name "ispell")
  1567.  '(paragraph-separate "\\([     ]*\\|~*\\|-*\\|=*\\|[  >]*\\)$")
  1568.  '(paragraph-start " \\|[   ]*$\\|~*$")
  1569.  '(quack-programs
  1570.    (quote
  1571.     ("drracket" "bigloo" "csi" "csi -hygienic" "gosh" "gsi" "gsi ~~/syntax-case.scm -" "guile" "kawa" "mit-scheme" "mred -z" "mzscheme" "mzscheme -M errortrace" "mzscheme -il r6rs" "mzscheme -il typed-scheme" "mzscheme3m" "mzschemecgc" "racket" "rs" "scheme" "scheme48" "scsh" "sisc" "stklos" "sxi")))
  1572.  '(quack-remap-find-file-bindings-p nil)
  1573.  '(safe-local-variable-values
  1574.    (quote
  1575.     ((c-indent-level . 4)
  1576.      (TeX-master . "paper.ltx")
  1577.      (mmm-noweb-code-mode . scheme-mode)
  1578.      (mmm-noweb-code-mode . c)
  1579.      (mmm-noweb-code-mode . c-mode)
  1580.      (old-mode . poly-noweb+c)
  1581.      (old-mode . Noweb)
  1582.      (tab-width . 4)
  1583.      (ess-noweb-default-code-mode . scheme-mode)
  1584.      (bogus-mode . poly-noweb+fundamental-mode)
  1585.      (noweb-code-mode . scheme-mode)
  1586.      (ess-noweb-default-code-mode . c-mode)
  1587.      (default-ess-noweb-code-mode . sml-mode)
  1588.      (noweb-default-code-mode . c-mode)
  1589.      (tex-main-file . guide\.tex)
  1590.      (TeX-master . "proposal")
  1591.      (mini-noweb-code-mode . scheme-mode)
  1592.      (mini-noweb-code-mode . sml-mode)
  1593.      (noweb-doc-mode . fundamental-mode)
  1594.      (noweb-code-mode . tex-mode)
  1595.      (noweb-code-mode . icon-mode)
  1596.      (noweb-doc-mode . text-mode)
  1597.      (noweb-code-mode . caml-mode)
  1598.      (noweb-code-mode . c-mode)
  1599.      (noweb-code-mode . fundamental-mode)
  1600.      (tex-main-file . book\.nw)
  1601.      (noweb-code-mode . sml-mode))))
  1602.  '(sh-basic-offset 2)
  1603.  '(sml-nested-if-indent t)
  1604.  '(x-select-enable-clipboard t))
  1605. (custom-set-faces
  1606.  ;; custom-set-faces was added by Custom.
  1607.  ;; If you edit it by hand, you could mess it up, so be careful.
  1608.  ;; Your init file should contain only one such instance.
  1609.  ;; If there is more than one, they won't work right.
  1610.  '(flyspell-duplicate ((t (:foreground "blue" :underline t :weight bold))))
  1611.  '(flyspell-duplicate-face ((t (:foreground "blue" :underline t :weight bold))) t)
  1612.  '(mmm-default-submode-face ((t (:background "gray96"))))
  1613.  '(mmm-special-submode-face ((t (:background "honeydew2")))))
  1614.  
  1615.  
  1616. (put 'upcase-region 'disabled nil)
  1617.  
  1618. ;;;; (require 'darcsum)
  1619.  
  1620. (when (string-equal (cadr command-line-args) "/home/nr/todo")
  1621.   (require 'desktop)
  1622.   (if (boundp 'desktop-restore-eager)
  1623.       (setq desktop-restore-eager 10))
  1624.   (setq desktop-dirname "/home/nr")
  1625.   (if (string< emacs-version "22")
  1626.       (progn
  1627.         (defun save-nr-desktop ()
  1628.           (desktop-save "/home/nr"))
  1629.         (desktop-load-default)
  1630.         (desktop-read "/home/nr")
  1631.         (add-hook 'kill-emacs-hook 'save-nr-desktop t)))
  1632.   ;; emacs 23 and later
  1633.   (setq desktop-save t)  ; 'ask-if-new was causing too much hassle
  1634.   (setq desktop-base-file-name ".emacs23.desktop")
  1635.   (setq desktop-save-mode t)
  1636.   (desktop-save-mode 1)
  1637.   ; (desktop-read desktop-dirname)
  1638. )
  1639.  
  1640.  
  1641. (defun renumber-list (start end &optional num)
  1642.       "Renumber the list items in the current START..END region.
  1643.    If optional prefix arg NUM is given, start numbering from that number
  1644.    instead of 1."
  1645.       (interactive "*r\np")
  1646.       (save-excursion
  1647.         (goto-char start)
  1648.         (setq num (or num 1))
  1649.         (save-match-data
  1650.           (while (re-search-forward "^\\([ \t]*\\)[0-9]+" end t)
  1651.             (replace-match (concat "\\1" (number-to-string num)))
  1652.             (setq num (1+ num))))))
  1653.  
  1654.  
  1655. (defun count-words-nr (begin end)
  1656.   "Count the number of words in the buffer (or with prefix arg, the region)."
  1657.   (interactive (list (point-min) (point-max)))
  1658.   (if current-prefix-arg
  1659.       (progn
  1660.         (setq begin (region-beginning))
  1661.         (setq end   (region-end))))
  1662.   (save-excursion
  1663.     (goto-char begin)
  1664.     (let ((count 0))
  1665.       (while (and (< (point) end) (re-search-forward "\\<" end t))
  1666.         (progn
  1667.           (incf count)
  1668.           (forward-char 1)))
  1669.       (message "%s words (%s)" count (if current-prefix-arg "region" "buffer")))))
  1670.  
  1671. (defalias 'wc-w 'count-words-nr)
  1672.  
  1673. (defun current-fill-context-prefix ()
  1674.   "Call `fill-context-prefix` on the current paragraph"
  1675.   (interactive)
  1676.   (message "Fill context prefix is '%s'" (fill-context-prefix
  1677.    (save-excursion (backward-paragraph 1) (point))
  1678.    (save-excursion (forward-paragraph 1) (point)))))
  1679.  
  1680. (put 'narrow-to-region 'disabled nil)
  1681.  
  1682. (when (fboundp 'electric-indent-mode)
  1683.   (electric-indent-mode -1)  ; turn it off
  1684.   (add-hook 'after-change-major-mode-hook (lambda() (electric-indent-mode -1)))
  1685.      ; keep it off
  1686. )
  1687. (defun yank-primary ()
  1688.   "Yank primary selection"
  1689.   (interactive)
  1690.   (let ((primary
  1691.      (cond
  1692.       ((eq system-type 'windows-nt)
  1693.        ;; MS-Windows emulates PRIMARY in x-get-selection, but not
  1694.        ;; in x-get-selection-value (the latter only accesses the
  1695.        ;; clipboard).  So try PRIMARY first, in case they selected
  1696.        ;; something with the mouse in the current Emacs session.
  1697.        (or (x-get-selection 'PRIMARY)
  1698.            (x-get-selection-value)))
  1699.       ((fboundp 'x-get-selection-value) ; MS-DOS and X.
  1700.        ;; On X, x-get-selection-value supports more formats and
  1701.        ;; encodings, so use it in preference to x-get-selection.
  1702.        (or (x-get-selection-value)
  1703.            (x-get-selection 'PRIMARY)))
  1704.       ;; FIXME: What about xterm-mouse-mode etc.?
  1705.       (t
  1706.        (x-get-selection 'PRIMARY)))))
  1707.     (unless primary
  1708.       (error "No selection is available"))
  1709.     (push-mark (point))
  1710.     (insert primary)))
  1711.  
  1712. (defun delete-horizontal-space-forward ()
  1713.   "Delete all spaces following point."
  1714.   (interactive)
  1715.   (let ((orig-pos (point)))
  1716.     (delete-region
  1717.      orig-pos
  1718.        (progn
  1719.          (skip-chars-forward " \t")
  1720.          (point)))))
  1721.  
  1722.  
  1723. (when (and
  1724.        (= (display-pixel-height) 2160)
  1725.        (member "Droid Sans Mono" (font-family-list)))
  1726.   (set-face-attribute 'default nil :font "Droid Sans Mono" :height 130))
  1727.  
  1728. (global-set-key (kbd "C-x g") 'magit-status)
  1729.  
  1730.  
  1731. (defun insert-fixed-fonts ()
  1732.   "Insert sample uses of all fixed-width fonts"
  1733.   (interactive)
  1734.   (let ((case-fold-search t)
  1735.         (str "The quick brown fox jumps over the lazy dog ´`''\"\"1lI|¦!Ø0Oo{[()]}.,:; ")
  1736.         (font-families
  1737.          (remove-if-not (lambda (s)
  1738.                           (or (string-match "fixed" s) (string-match "mono" s)))
  1739.                         (cl-remove-duplicates
  1740.                          (sort (font-family-list)
  1741.                                (lambda(x y) (string< (upcase x) (upcase y))))
  1742.                          :test 'string=))))
  1743.   (dolist (ff font-families)
  1744.     (insert
  1745.      (propertize str 'font-lock-face `(:family ,ff))               ff "\n"
  1746.      (propertize str 'font-lock-face `(:family ,ff :slant italic)) ff "\n"))))
  1747.  
  1748.  
  1749. (defvar compilation-error-data nil)
  1750.  
  1751. (defun compilation-error-search ()
  1752.   "Search for matching compilation error regexp"
  1753.   (interactive)
  1754.   (setq compilation-error-data
  1755.         (enumerate-first-match 1 compilation-error-regexp-alist)))
  1756.  
  1757. (defun enumerate-first-match (i rules)
  1758.   (if (null rules)
  1759.       nil
  1760.     (let ((item (car rules)))
  1761.       (if (symbolp item)
  1762.           (setq item (cdr (assq item
  1763.                                 compilation-error-regexp-alist-alist))))
  1764.       (let ((file (nth 1 item))
  1765.             (line (nth 2 item))
  1766.             (col (nth 3 item))
  1767.             (type (nth 4 item))
  1768.             (pat (car item))
  1769.             end-line end-col fmt
  1770.           props)
  1771.  
  1772.         (cond
  1773.          ((not (memq 'omake compilation-error-regexp-alist)) nil)
  1774.          ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat)
  1775.           nil) ;; Not anchored or anchored but already allows empty spaces.
  1776.          (t (setq pat (concat "^ *" (substring pat 1)))))
  1777.  
  1778.         (if (consp file)    (setq fmt (cdr file)      file (car file)))
  1779.         (if (consp line)    (setq end-line (cdr line) line (car line)))
  1780.         (if (consp col) (setq end-col (cdr col)   col (car col)))
  1781.  
  1782.         (unless (or (null (nth 5 item)) (integerp (nth 5 item)))
  1783.           (error "HYPERLINK should be an integer: %s" (nth 5 item)))
  1784.  
  1785.         (if (re-search-forward pat (point-max) t)
  1786.             (list 'INDEX i 'PAT pat 'MATCHED (match-string 0) 'FULL-ITEM item)
  1787.           (enumerate-first-match (+ 1 i) (cdr rules)))))))
  1788.  
  1789.  
  1790. (defun do-nothing (&rest args)
  1791.   (interactive)
  1792.   nil)
  1793.  
  1794.  
  1795. ; http://endlessparentheses.com/ispell-and-abbrev-the-perfect-auto-correct.html
  1796. (defun endless/ispell-word-then-abbrev (p)
  1797.   "Call `ispell-word', then create an abbrev for it.
  1798. With prefix P, create local abbrev. Otherwise it will
  1799. be global."
  1800.   (interactive "P")
  1801.   (let ((bef (downcase (or (thing-at-point 'word)
  1802.                            "")))
  1803.         aft)
  1804.     (call-interactively 'ispell-word)
  1805.     (setq aft (downcase
  1806.                (or (thing-at-point 'word) "")))
  1807.     (unless (or (string= aft bef)
  1808.                 (string= aft "")
  1809.                 (string= bef ""))
  1810.       (message "\"%s\" now expands to \"%s\" %sally"
  1811.                bef aft (if p "loc" "glob"))
  1812.       (define-abbrev
  1813.         (if p local-abbrev-table global-abbrev-table)
  1814.         bef aft))))
  1815.  
  1816. (defun endless/flyspell-word-then-abbrev (p)
  1817.   "Call `ispell-word', then create an abbrev for it.
  1818. With prefix P, create local abbrev. Otherwise it will
  1819. be global."
  1820.   (interactive "P")
  1821.   (save-excursion
  1822.     (if (flyspell-goto-previous-word (point))
  1823.         (let ((bef (downcase (or (thing-at-point 'word)
  1824.                                  "")))
  1825.               aft)
  1826.           (call-interactively 'ispell-word)
  1827.           (setq aft (downcase
  1828.                      (or (thing-at-point 'word) "")))
  1829.           (unless (or (string= aft bef)
  1830.                       (string= aft "")
  1831.                       (string= bef ""))
  1832.             (message "\"%s\" now expands to \"%s\" %sally"
  1833.                      bef aft (if p "loc" "glob"))
  1834.             (define-abbrev
  1835.               (if p local-abbrev-table global-abbrev-table)
  1836.               bef aft)))
  1837.       (message "Cannot find a misspelled word"))))
  1838.  
  1839. (define-key ctl-x-map "\C-i"
  1840.   #'endless/flyspell-word-then-abbrev)
  1841.  
  1842. (add-to-list 'initial-frame-alist '(sticky . nil))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement