Re-order inits because of Gnus fuckery
[syinit] / 12-misc-sy.el
1 ;; 13-misc-sy.el --- Miscellaneous Settings   -*- Emacs-Lisp -*-
2
3 ;; Copyright (C) 2007 - 2013 Steve Youngs
4
5 ;;     Author: Steve Youngs <steve@sxemacs.org>
6 ;; Maintainer: Steve Youngs <steve@sxemacs.org>
7 ;;    Created: <2007-12-02>
8 ;; Time-stamp: <Monday Jun 29, 2015 21:59:51 steve>
9 ;;   Download: <http://bastard.steveyoungs.com/~steve/SXEmacs/inits/>
10 ;;   HTMLised: <http://bastard.steveyoungs.com/~steve/SXEmacs/htmlinits/13-misc-sy.html>
11 ;;   Git Repo: git clone http://git.sxemacs.org/syinit
12 ;;   Keywords: init, compile
13
14 ;; This file is part of SYinit
15
16 ;; Redistribution and use in source and binary forms, with or without
17 ;; modification, are permitted provided that the following conditions
18 ;; are met:
19 ;;
20 ;; 1. Redistributions of source code must retain the above copyright
21 ;;    notice, this list of conditions and the following disclaimer.
22 ;;
23 ;; 2. Redistributions in binary form must reproduce the above copyright
24 ;;    notice, this list of conditions and the following disclaimer in the
25 ;;    documentation and/or other materials provided with the distribution.
26 ;;
27 ;; 3. Neither the name of the author nor the names of any contributors
28 ;;    may be used to endorse or promote products derived from this
29 ;;    software without specific prior written permission.
30 ;;
31 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
32 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
33 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
34 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
35 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
36 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
37 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
38 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
39 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
40 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
41 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
42
43 ;;; Commentary:
44 ;;
45 ;;  For stuff that just doesn't seem to fit anywhere else.
46 ;;
47
48 ;;; Credits:
49 ;;
50 ;;   The HTML version of this file was created with Hrvoje Niksic's
51 ;;   htmlize.el which is part of the XEmacs "text-modes" package.
52 ;;
53
54 ;;; Todo:
55 ;;
56 ;;     
57 ;;; Code:
58 ;:*=======================
59 ;:* Why type 'y e s RET' or 'n o RET' when 'y' or 'n' will do.
60 (fset 'yes-or-no-p 'y-or-n-p)
61
62 (setq x-allow-sendevents t)
63
64 ;:*======================
65 ;: Enable the command `narrow-to-region' ("C-x n n")
66 ;(setq narrow-to-region t)
67 (put 'narrow-to-region 'disabled nil)
68
69 ;:*======================
70 ;:* Enable `erase-buffer'
71 (put 'erase-buffer 'disabled nil)
72
73 ;:*======================
74 ;:* Put the mouse selection in the kill buffer
75 ;: Jan Vroonhof <vroonhof@frege.math.ethz.ch>
76 (defun mouse-track-drag-copy-to-kill (event count)
77   "Copy the dragged region to the kill ring"
78   (let ((region (default-mouse-track-return-dragged-selection event)))
79     (when region
80       (copy-region-as-kill (car region)
81                            (cdr region)))
82     nil))
83 (add-hook 'mouse-track-drag-up-hook 'mouse-track-drag-copy-to-kill)
84
85 ;:*======================= 
86 ;:* manual follows xref instead of opening a new buffer
87 ;: Glynn Clements <glynn@sensei.co.uk>
88 (defun Manual-follow-xref (&optional name-or-event)
89   "Invoke `manual-entry' on the cross-reference under the mouse.
90 When invoked noninteractively, the arg may be an xref string to parse
91 instead."
92   (interactive "e")
93   (if (eventp name-or-event)
94       (let* ((p (event-point name-or-event))
95              (extent (and p (extent-at p
96                              (event-buffer name-or-event)
97                              'highlight)))
98              (data (and extent (extent-property extent 'man))))
99         (if (eq (car-safe data) 'Manual-follow-xref)
100             (eval data)
101           (error "no manual cross-reference there.")))
102     (let ((buff (current-buffer)))
103       (or (and (manual-entry name-or-event)
104                (or (eq (current-buffer) buff)
105                    (kill-buffer buff)))
106           ;: If that didn't work, maybe it's in a different section than the
107           ;: man page writer expected.  For example, man pages tend assume
108           ;: that all user programs are in section 1, but X tends to generate
109           ;: makefiles that put things in section "n" instead...
110           (and (string-match "[ \t]*([^)]+)\\'" name-or-event)
111                (progn
112                  (message "No entries found for %s; checking other sections..."
113                           name-or-event)
114                  (and (manual-entry
115                        (substring name-or-event 0 (match-beginning 0)) nil t)
116                       (or (eq (current-buffer) buff)
117                           (kill-buffer buff)))))))))
118
119 ;:*======================= 
120 ;:* Frame title.
121 (setq frame-title-format
122       (concat "-={%b}=- "
123               (construct-emacs-version-name)
124               " ["
125               (and-boundp 'sxemacs-codename
126                 sxemacs-codename)
127               "]"))
128
129 ;:*======================
130 ;:* Additions to the menubar.
131 (when (featurep 'menubar)
132   (require 'big-menubar)
133   (add-menu-button nil ["Fr%_ame" make-frame t] "Help"))
134
135 ;:*======================
136 ;:* create a Kill-Ring menu
137 (when (featurep 'menubar)
138   (defvar str)
139   (defvar yank-menu-length 40
140     "*Maximum length of an item in the menu for select-and-yank.")
141   (defun select-and-yank-filter (menu)
142     (let* ((count 0))
143       (append menu
144               (mapcar
145                #'(lambda (str)
146                    (if (> (length str) yank-menu-length)
147                        (setq str (substring str 0 yank-menu-length)))
148                    (prog1
149                        (vector
150                         str
151                         (list
152                          'progn
153                          '(push-mark (point))
154                          (list 'insert (list 'current-kill count t)))
155                         t)
156                      (setq count (1+ count))))
157                kill-ring))))
158   (add-submenu nil '("Kill-Ring"
159                      :included kill-ring
160                      :filter select-and-yank-filter)))
161
162 ;:*======================
163 ;: resize-minibuffer-mode makes the minibuffer automatically
164 ;: resize as necessary when it's too big to hold its contents.
165 ;(autoload 'resize-minibuffer-mode "rsz-minibuf" nil t)
166 ;(resize-minibuffer-mode)
167 ;(setq resize-minibuffer-window-exactly nil)
168 ;(setq minibuffer-max-depth nil)
169 (setq resize-minibuffer-mode t)
170 ;:*======================
171 ;:* don't invert colors when grabbing a password
172 ;:  (because sometimes it screws up and leaves the frame 
173 ;:  with dorked up colors).
174 (setq passwd-invert-frame-when-keyboard-grabbed nil)
175
176 ;:*=======================
177 ;:* VI-style matching parenthesis
178 ;:  From Eric Hendrickson edh @ med.umn.edu
179 (defun match-paren (arg)
180   "Go to the matching parenthesis if on parenthesis otherwise insert %."
181   (interactive "p")
182   (cond ((looking-at "[([{]") (forward-sexp 1) (backward-char))
183         ((looking-at "[])}]") (forward-char) (backward-sexp 1))))
184 (global-set-key '(control f1) 'match-paren)
185
186 ;:*======================
187 ;:* Inserting elisp Comments
188 ; by Jonas Luster <mailto:jonas @ nethammer.qad.org>
189 (defun elispcomment ()
190 ;:*=====================
191   (interactive)
192   (insert ";:*=======================\n")
193   (insert ";:* " (setq str (read-input "Comment: ")) "\n")
194   (insert "\n"))
195 (global-set-key '(control f3) 'elispcomment)
196
197 ;:*======================
198 ;:* Time-Stamp
199 (require 'time-stamp)
200 (add-hook 'write-file-hooks 'time-stamp)
201 (set 'time-stamp-active t)
202 (set 'time-stamp-format "%a %3b %2d, %4y %02H:%02M:%02S %u")
203
204 ;:*======================
205 ;:* Image formats
206 (require 'image-mode)
207 (require 'ffi-wand)
208 (Wand-find-file-enable)
209
210 ;:*======================
211 ;:* Dired enhancements.
212 (require 'dired)
213 (setq dired-ls-locale "POSIX")
214
215 ;; Pack and Unpack tarballs
216 (require 'dired-tar)
217 (setq dired-tar-compress-with 'xz)
218
219 ;; FFI/libWand for image files in Dired
220 (defun sy-dired-wand ()
221   (interactive)
222   (let ((file (dired-get-filename)))
223     (Wand-display file)))
224
225 (define-key dired-mode-map [?b] #'sy-dired-wand)
226
227 ;; Play audio files directly from dired.
228 (defun sy-dired-play-audio ()
229   (interactive)
230   (let ((file (dired-get-filename)))
231     (when (string-match #r"\.\(wav\|au\|ogg\|mp3\|flac\)$" file)
232       (let ((stream (make-media-stream :file file)))
233         (play-media-stream stream)))))
234
235 (define-key dired-mode-map [(control ?c) ?p] #'sy-dired-play-audio)
236
237 ;(setq dired-use-ls-dired t)
238 ;(setq dired-listing-switches "-alih")
239
240 ;:*======================
241 ;:* Change some modeline indicators
242 (setq pending-delete-modeline-string " PD")
243 (setq filladapt-mode-line-string "")
244 (add-minor-mode 'abbrev-mode " Ab")
245 (add-hook 'lisp-interaction-mode-hook #'(lambda () (setq mode-name "LI")))
246
247 ;:*======================
248 ;:* Force efs into passive ftp because of my firewall
249 (setq efs-use-passive-mode t)
250
251 ;:*======================
252 ;:* ibuffer - replacement for buffer-menu
253 (require 'ibuffer)
254 (setq 
255  ibuffer-expert t
256  ibuffer-default-sorting-mode 'major-mode
257  ibuffer-fontification-level t
258  ibuffer-saved-filter-groups
259  ;; First match wins.
260  '(("My-ibuffer-grps"
261     ("ChangeLog"
262      (mode . change-log-mode))
263     ("Dired"
264      (mode . dired-mode))
265     ("Programming"
266      (or
267       (mode . emacs-lisp-mode)
268       (mode . cperl-mode)
269       (mode . c-mode)
270       (mode . c++-mode)
271       (mode . java-mode) 
272       (mode . idl-mode)
273       (mode . lisp-mode)))
274     ("Documentation"
275      (or
276       (mode . help-mode)
277       (mode . hyper-apropos-help-mode)
278       (mode . hyper-apropos-mode)
279       (mode . Info-mode)
280       (mode . Manual-mode)))
281     ("EMchat"
282      (or
283       (mode . emchat-buddy-mode)
284       (mode . emchat-log-mode)
285       (mode . emchat-network-mode)
286       (mode . world-mode)
287       (mode . emchat-history-mode)
288       (name . "\\*emchat-debug\\*")
289       (filename . "/home/steve/\\.emchat/history/.*")))
290     ("Riece"
291      (or
292       (mode . riece-channel-list-mode)
293       (mode . riece-channel-mode)
294       (mode . riece-command-mode)
295       (mode . riece-dialogue-mode)
296       (mode . riece-others-mode)
297       (mode . riece-user-list-mode)))
298     ("Gnus"
299      (or
300       (mode . message-mode)
301       (mode . mail-mode)
302       (mode . gnus-group-mode)
303       (mode . gnus-summary-mode) 
304       (mode . gnus-article-mode)))
305     ("Fundamental"
306      (mode . fundamental-mode))
307     )))
308
309 (add-hook 'ibuffer-mode-hooks 
310           (lambda () 
311             (ibuffer-switch-to-saved-filter-groups "My-ibuffer-grps")
312             (ibuffer-add-to-tmp-hide "\\*scratch\\*")))
313
314 ;:*======================
315 ;:* Sawfish mode
316 (require 'sawfish)
317 (add-to-list 'auto-mode-alist '("\\.sawfishrc$" . sawfish-mode))
318 (add-to-list 'auto-mode-alist '("\\.jl$" . sawfish-mode))
319
320 ;:*======================
321 ;:* from.el - check whose sent us mail
322 ;(require 'from)
323 ;(setq 
324 ; from-mailspools
325 ; '("~/mail/INBOX")
326 ; from-use-other-window nil
327 ; from-quit-command 'kill-buffer
328 ; from-highlight-regexp
329 ; #r"Merge-Req\|e\(icq\|mchat\)\|pa\(?:ckages\|tch\)\|sxemacs\|x\(?:e\(?:macs\|tla\)\|wem\)")
330
331 ;:*======================
332 ;:* PS-Print
333 ;; FIXME: make this work, it looks interesting!
334 ;(require 'ps-print)
335 ;(require 'ps-mule)
336 ;(require 'ps-bdf)
337 ;(require 'lpr)
338 ;(setq 
339 ; bdf-directory-list
340 ; '("/usr/share/fonts/bdf")
341 ; ps-multibyte-buffer 'bdf-font-except-latin
342 ; ps-paper-type 'a4
343 ; printer-name "/dev/lp0"
344 ; ps-printer-name ""
345 ; ps-print-color-p nil)
346
347 ;:*======================
348 ;:* Line and Column numbers.
349 (line-number-mode 1)
350 (column-number-mode 1)
351
352 ;:*======================
353 ;:* Setting initial default-directory.
354 (setq default-directory (file-name-as-directory (user-home-directory)))
355
356 ;:*======================
357 ;:* Sane ChangeLogs
358 (when (featurep 'mule)
359   (add-to-list 'file-coding-system-alist '("ChangeLog" . binary)))
360
361 ;:*======================
362 ;:* Directory Abbrevs
363 (setq directory-abbrev-alist
364       `(("^/instcore" . ,(concat (car emacs-roots)
365                                 "share/sxemacs-"
366                                 emacs-program-version))
367         ("^/instpkg" . ,(concat (car emacs-roots)
368                                 "share/sxemacs"))
369         ("^/prog" . "~/programming")
370         ("^/linux" . "/usr/src/kernel/linux")
371         ("^/src" . "/usr/src")
372         ("^/sxe" . "/home/steve/programming/SXEmacs")
373         ("^/core" . "/home/steve/programming/SXEmacs/core/sxemacs.git")
374         ("^/web" . "/home/steve/programming/SXEmacs/web/website")))
375
376 ;:*======================
377 ;:* The beginnings of procmail-mode.el.
378 ;;
379 ;; I can't remember who I stole this from, but if it was you, please
380 ;; let me know so I can give you the credit you deserve.
381 (defvar procmail-font-lock-keywords)
382
383 (define-derived-mode procmail-mode fundamental-mode "Procmail"
384   "Major mode for editing procmail recipes."
385
386   (setq comment-start "#")
387   (setq comment-start-skip "#[ \t]*")
388
389   ;;register keywords
390   (setq procmail-font-lock-keywords
391         (list '("#.*"
392                 . font-lock-comment-face)
393               '("^[\t ]*:.*"
394                 . font-lock-type-face)
395               '("[A-Za-z_]+=.*"
396                 . font-lock-keyword-face)
397               '("^[\t ]*\\*.*"
398                 . font-lock-doc-string-face)
399               '("\$[A-Za-z0-9_]+"
400                 . font-lock-function-name-face)))
401   (font-lock-mode))
402
403 (add-to-list 'auto-mode-alist '("\\.procmailrc$" . procmail-mode))
404
405 ;; And because my ~/.procmailrc has lots of high ASCII to defeat
406 ;; Chinese SPAM I set its coding to binary.
407 (when (featurep 'mule)
408   (add-to-list 'file-coding-system-alist '("\\.procmailrc$" . binary)))
409
410 ;:*======================
411 ;:* Build Reports
412 (setq
413  build-rpt-prompts '(("Status?: "
414                       ("Success"
415                        "Success (tests fail)"
416                        "Failure"
417                        "Failure (tests fail)"
418                        "OK (with issues)")))
419  build-rpt-use-gnus-group "nnml:sxemacs.builds"
420  build-rpt-use-gnus-p t
421  build-rpt-make-output-files
422  '("/usr/src/sxemacs/make.err"
423    "/usr/src/sxemacs/check.err"
424    "/usr/src/sxemacs/install.err"
425    ))
426
427 ;:*======================
428 ;:* Set the frame geometry
429 (unless (getenv "XWEM_RUNNING")
430   (setq initial-frame-plist '(top 23 left 26 width 95 height 40)
431         default-frame-plist '(top 3 left 26 width 95 height 40 name "SXEFrame")))
432
433 ;:*======================
434 ;:* The Beginnings of a Finance package
435 (require 'emoney)
436 (setq
437  emoney-bank-url "https://internetbanking.suncorpbank.com.au/"
438  emoney-date-format "%Y-%m-%d"
439  emoney-default-account "scorp-main.emy"
440  emoney-recalculate-on-quit t
441  emoney-save-after-recalculate t
442  emoney-use-new-frame t)
443
444 ;:*======================
445 ;:* Modeline enhancements.
446 ;;
447 ;; Reorganise the modeline so that the line and column numbers are on
448 ;; the left where you can see them.  Also add a bit of colour to the
449 ;; left and right ID extents so they stand out.
450 (when (or (< emacs-minor-version 5)
451           (featurep 'sxemacs))
452   (setq-default modeline-buffer-identification
453                 (list (cons modeline-buffer-id-left-extent
454                             (cons 10 (list
455                                       (list 'line-number-mode "L%l ")
456                                       (list 'column-number-mode "C%c ")
457                                       (list (cons -3 (list "%p")))
458                                       ":")))
459                       (cons modeline-buffer-id-right-extent "%17b")))
460
461   (setq-default
462    modeline-format
463    (list
464     ""
465     (if (boundp 'modeline-multibyte-status)
466         "%C" ;modeline-multibyte-status
467       "NoMule")
468     (cons modeline-modified-extent 'modeline-modified)
469     (cons modeline-buffer-id-extent 'modeline-buffer-identification)
470     " "
471     'global-mode-string
472     " %[("
473     (cons modeline-minor-mode-extent
474           (list "" 'mode-name 'minor-mode-alist))
475     (cons modeline-narrowed-extent "%n")
476     'modeline-process
477     ")%]----"
478     "-%-"))
479
480   (set-extent-face modeline-buffer-id-left-extent 'font-lock-warning-face)
481   (set-extent-face modeline-buffer-id-right-extent 'font-lock-comment-face))
482
483 ;:*======================
484 ;:* Enable funky completion.
485 ;;
486 ;; This allows you to do things like type "M-x b-c-f RET" and it will
487 ;; expand to `byte-compile-file'.
488 (require 'completer)
489
490 ;:*======================
491 ;:* Misc Stuff that I haven't yet put anywhere permanent
492 ;;
493 ;;  I used to have my browse-url setting here, but because of xdg that
494 ;;  really isn't necessary anymore.
495 (setq 
496  abbrev-mode t
497  allow-deletion-of-last-visible-frame t
498  bookmark-save-flag 1
499  complex-buffers-menu-p t
500  etalk-process-file "talk"
501  find-function-source-path nil
502  font-menu-ignore-scaled-fonts nil
503  ges-post-use-mime t
504  mail-user-agent 'message-user-agent
505  modeline-scrolling-method 'scrollbar
506  progress-feedback-use-echo-area t
507  report-xemacs-bug-no-explanations t
508  scroll-step 1
509  lookup-syntax-properties nil)
510
511 (quietly-read-abbrev-file)
512 (add-hook 'text-mode-hook 'turn-on-auto-fill)
513 ;(customize-set-variable 'gutter-buffers-tab-visible-p nil)
514 (setq gutter-buffers-tab-enabled nil)
515 (customize-set-variable 'user-mail-address "steve@steveyoungs.com")
516 (setq query-user-mail-address nil)
517 (blink-cursor-mode 1)
518 ;; Currently trying to live in a Unicode (UTF-8) world, so this is
519 ;; off.
520 ; (when (featurep 'mule)
521 ;   (set-language-environment "Latin-1"))
522 (unless (gnuserv-running-p)
523   (gnuserv-start))
524 (require 'mozmail)
525
526 ;:*=======================
527 ;:* Info-mode
528 (require 'info)
529
530 (setq toolbar-info-frame-plist
531       '((width . 85)
532         (name . "InfoFrame")))
533
534 (unless (fboundp 'Info-search-next)
535   (defun Info-search-next ()
536     "Repeat search starting from point with last regexp used in `Info-search'."
537     (interactive)
538     (Info-search Info-last-search))
539   (define-key Info-mode-map "z" 'Info-search-next))
540
541 (setq
542  Info-directory-list
543  '("/home/steve/.local/share/sxemacs/site-packages/info"
544    "/usr/share/info"
545    ;; "/usr/share/sxemacs/site-packages/info"
546    ;; "/usr/share/sxemacs/sxemacs-packages/info"
547    "/usr/share/sxemacs/xemacs-packages/info"
548    "/usr/share/sxemacs/mule-packages/info")
549  Info-dir-contents-directory
550  "/home/steve/.local/share/sxemacs/site-packages/info"
551  Info-save-auto-generated-dir 'always)
552
553 ;:*=======================
554 ;:* gdb-highlight
555 (add-hook 'gdb-mode-hook #'(lambda () (require 'gdb-highlight)))
556
557 ;:*=======================
558 ;:* etags
559 (require 'etags)
560 (defun sy-find-tag-regex (tagname)
561   "Use `igrep-find' command to find all occurances of tag with TAGNAME."
562   (interactive (if current-prefix-arg (list (current-word))
563                  (list (find-tag-tag "Find tag: "))))
564   (let ((dir (file-name-directory tags-file-name)))
565     (igrep-find "grep" tagname (concat dir "/*"))))
566
567 ;:*=======================
568 ;:* Google
569 (require 'google-query)
570 (setq google-query-mirror "https://www.google.com.au"
571       google-query-result-count 100)
572 (global-set-key [(control f9)] 'google-query)
573 (global-set-key [(meta f9)] 'google-query-region)
574
575 ;:*=======================
576 ;:* What the fuck does that acronym mean?
577 ;; This requires wtf(6).  No idea where you get it from, but it comes
578 ;; with Slackware.
579 ;; (wtf "lol") => LOL: laughing out loud
580 (defun wtf (acronym)
581   "What the fuck is... ACRONYM"
582   (interactive "sWhat the fuck is: ")
583   (let* ((wtf (executable-find "wtf"))
584          (term (substring (shell-command-to-string
585                            (concat wtf " " acronym)) 0 -1)))
586     (if (interactive-p)
587         (if current-prefix-arg
588             (insert term)
589           (message term))
590       term)))
591
592 ;:*=======================
593 ;:* Interactively append to the latest kill
594 ;;
595 (defun sy-add-to-kill (start end &optional prepend)
596   "Copy region START END and append it to the latest kill.
597
598 Or, PREPEND with prefix arg.
599
600 With this you could select \"THIS \" word, `\\[kill-ring-save]' to save it
601 to the kill ring, then select this \"WORD \" and do `\\[sy-add-to-kill]',
602 then select this word \"HERE\", do `\\[sy-add-to-kill]', then select these
603 words \"DON'T WANT \", do `\\[universal-argument] \\[sy-add-to-kill]', and
604 finally do `\\[yank]' and you'd get...
605
606    DON'T WANT THIS WORD HERE"
607   (interactive "r\nP")
608   (let ((prepend (or prepend
609                      current-prefix-arg)))
610     (if prepend
611         (kill-append (buffer-substring start end) 'before)
612       (kill-append (buffer-substring start end) nil))))
613
614 (global-set-key [(meta ?W)] 'sy-add-to-kill)
615
616 ;:*=======================
617 ;:* DNS
618 (add-to-list 'auto-mode-alist '("/var/chroot/named/etc/zones/.*$" . dns-mode))
619
620 (defun dig-mx (domain)
621   "View MX records for DOMAIN.
622
623 With a prefix arg, prompt for a server to query."
624   (interactive "sDomain: ")
625   (unless (interactive-p)
626     (error 'invalid-operation "`dig-mx' must be called interactively"))
627   (if current-prefix-arg
628       (dig domain "MX" nil nil nil
629            (format "%s" (read-string "Server: " nil nil "localhost")))
630     (dig domain "MX")))
631
632 (defun dig-ns (domain)
633   "View NS records for DOMAIN.
634
635 With a prefix arg, prompt for a server to query."
636   (interactive "sDomain: ")
637   (unless (interactive-p)
638     (error 'invalid-operation "`dig-ns' must be called interactively"))
639   (if current-prefix-arg
640       (dig domain "NS" nil nil nil
641            (format "%s" (read-string "Server: " nil nil "localhost")))
642     (dig domain "NS")))
643
644 (defun dig-any (domain)
645   "View DNS records for DOMAIN.
646
647 With a prefix arg, prompt for a server to query."
648   (interactive "sDomain: ")
649   (unless (interactive-p)
650     (error 'invalid-operation "`dig-any' must be called interactively"))
651   (if current-prefix-arg
652       (dig domain "ANY" nil nil nil
653            (format "%s" (read-string "Server: " nil nil "localhost")))
654     (dig domain "ANY")))
655
656 ;:*=======================
657 ;:* Hard disk temperature!
658 ;(or (ignore-errors (require 'hddtemp))
659 ;    (progn
660 ;      (load-module "cl-loop")
661 ;      (require 'hddtemp)))
662
663 ;;; get fancy and stick it in the modeline
664 ;(defvar hddtemp-global-mode-string "sda:0°C"
665 ;  "Default hddtemp modeline string.")
666 ;(setq global-mode-string (append global-mode-string
667 ;                                (list hddtemp-global-mode-string)))
668
669 ;(defun hddtemp-modeline-string ()
670 ;  (let* ((disc0 (hddtemp 0))
671 ;        (str (format "sda:%s°%s"
672 ;                     (nth 2 disc0) (nth 3 disc0))))
673 ;    (setq hddtemp-global-mode-string str)))
674
675 ;(start-itimer "hdd-modeline"
676 ;             #'(lambda ()
677 ;                 (progn
678 ;                   (setq global-mode-string
679 ;                         (delq hddtemp-global-mode-string global-mode-string))
680 ;                   (hddtemp-modeline-string)
681 ;                   (setq global-mode-string
682 ;                         (append global-mode-string
683 ;                                 (list hddtemp-global-mode-string)))))
684 ;             10 10)
685
686 ;:*=======================
687 ;:* Term
688 ; M-x term usually gives really horrid "staircase" output.  This fixes
689 ; that.
690 (add-hook 'term-exec-hook 
691           #'(lambda ()
692               (set-buffer-process-coding-system 'binary 'binary)))
693
694 ;:*=======================
695 ;:* Phonetic Alphabet
696 (defvar phonetics-hash
697   #s(hash-table test equal
698                 data ("a" "alpha"
699                       "b" "bravo"
700                       "c" "charlie"
701                       "d" "delta"
702                       "e" "echo"
703                       "f" "foxtrot"
704                       "g" "golf"
705                       "h" "hotel"
706                       "i" "india"
707                       "j" "juliet"
708                       "k" "kilo"
709                       "l" "lima"
710                       "m" "mike"
711                       "n" "november"
712                       "o" "oscar"
713                       "p" "papa"
714                       "q" "quebec"
715                       "r" "romeo"
716                       "s" "sierra"
717                       "t" "tango"
718                       "u" "uniform"
719                       "v" "victor"
720                       "w" "whiskey"
721                       "x" "x-ray"
722                       "y" "yankee"
723                       "z" "zulu"
724                       " " "SPC"
725                       "0" "zero"
726                       "1" "one"
727                       "2" "two"
728                       "3" "three"
729                       "4" "four"
730                       "5" "five"
731                       "6" "six"
732                       "7" "seven"
733                       "8" "eight"
734                       "9" "niner"))
735   "Hash table of phonetic alphabet.")
736
737 (defun phoneticise (string)
738   "Return STRING rewritten using the phonetic alphabet.
739
740 For example: \"cat\" => \"charlie alpha tango\".
741 With a prefix arg, insert phoneticised string at point.
742 It ignores punctuation."
743   (interactive "sString to phoneticise: ")
744   (let ((str (string-to-list (downcase string)))
745         phonetics)
746     (with-temp-buffer
747       (while str
748         (insert (or (gethash (char-to-string (car str)) phonetics-hash)
749                     (char-to-string (car str))) " ")
750         (setq str (cdr str)))
751       (setq phonetics (buffer-string)))
752     (if current-prefix-arg
753         (insert phonetics)
754       (if (interactive-p)
755           (message "%s" phonetics)
756         phonetics))))
757
758 ;:*=======================
759 ;:* Copy the text without the extents
760 (defun sy-extent-kill-save ()
761   "Save the extent under point's string to kill ring."
762   (interactive)
763   (kill-new (extent-string (extent-at (point)))))
764
765 ;:*=======================
766 ;:* PkgUsr tools
767 (require 'pkgusr)
768
769 ;:*=======================
770 ;:* There's a new sexy rc.d style init in SXEmacs, and this is how I
771 ;;  deal with it.
772 ;;
773 ;;  I now have my init files named with a 2 digit numerical prefix.
774 ;;  This is that I can control which order `lisp-initd-compile-and-load'
775 ;;  will load my stuff.  Consequently, finding a particular init file is
776 ;;  much harder now because I can never remember what bloody number it
777 ;;  has.  This takes the remembering out of the equation.
778 (defvar sy-init-hash (make-hash-table :test #'equal :size 20)
779   "A hash table of my numbered init files.")
780
781 (defvar sy-init-files
782   (directory-files lisp-initd-dir nil ".*\.el$" 'sorted-list t)
783   "List of my init files.")
784
785 (mapc
786  (lambda (value)
787    (let ((key (substring value 3 -3)))
788      (puthash key value sy-init-hash)))
789  sy-init-files)
790
791 (defvar sy-init-hash-vector (hash-keys-to-vector sy-init-hash)
792   "A vector from my init file hash to use for completion.")
793
794 (defvar sy-init-history nil
795   "History for `sy-init-file-other-window'.")
796
797 (defun sy-init-file-other-window (initf &optional codesys)
798   "Basically, `find-file-other-window', but for my init files.
799
800 Argument INITF is the \"base\" name of the init file.
801 Optional prefix arg, CODESYS, is to specify a coding system to use.
802
803 I have this because I've prefixed all of my init files with a 2
804 digit number so I can ensure they get loaded in the right order with
805 `lisp-initd-compile-and-load'.  And I can never remember what init
806 files are assigned what numbers."
807   (interactive (list (completing-read "Init file: "
808                                       (mapcar #'list sy-init-hash-vector)
809                                       nil nil nil sy-init-history)
810                      (when current-prefix-arg
811                        (read-coding-system "Coding System: "))))
812   (let* ((lib (gethash initf sy-init-hash))
813          (expanded (expand-file-name lib lisp-initd-dir)))
814     (find-file-other-window expanded codesys)))
815
816 (global-set-key [(control ?x) ?4 ?i] #'sy-init-file-other-window)
817 ;:*=======================
818 ;:* "Active" menubar
819 ;; Nifty little thing that hides the menubar and makes it visible when
820 ;; the rat is on the toolbar.
821 ;; but it's annoying
822 ;(require 'active-menu)
823 ;(active-menu 1)
824
825 ;:*=======================
826 ;:* LiveJournal posting thingy
827 (require 'lj)
828 (setq lj-cookie-flavour 'chrome)
829 ;(setq lj-cookie-flavour 'firefox)
830 (setq lj-user-id "bastard_blog")
831 (setq lj-archive-posts t)
832 (setq lj-bcc-address "Steve Youngs <steve@localhost>")
833 (setq lj-default-location "Brisbane, Australia")
834 (setq lj-signature
835       "<hr />
836 <p style=\"color:#FD00FD;font-size:10pt;font-weight:bold;\">
837 Till next time...<br />
838 <i>Steve</i>
839 </p>")
840 (add-hook 'lj-before-post-hook #'lj-validate)
841 (add-hook 'lj-after-post-hook #'lj-get-tags)
842
843 ;:*=======================
844 ;:* Handy kbd macros
845 ;;
846 ;; numpoints -- make numbered list points.  Before using, initialise
847 ;; numeric register `n' to zero
848 (number-to-register 0 ?n)
849 (defalias 'numpoints
850   (read-kbd-macro "2*RET 2*SPC C-x r + n C-x r i n C-e ) SPC"))
851 (global-set-key [(control ?c) (control ?n)] #'numpoints)
852 (define-key message-mode-map [(hyper ?n)] #'numpoints)
853
854 ;:*=======================
855 ;:* Do things with environment variables let-bound
856 ;;
857 ;;  (with-environment-variables (("VAR" "VALUE") ("VAR2" "VALUE2"))
858 ;;    (do-shit-here))
859 ;;
860 ;(require 'with-environment-variables)
861
862 ;:*=======================
863 ;:* Play Sudoku
864 (require 'sudoku)
865 (setq sudoku-level 'easy)
866
867 ;:*=======================
868 ;:* Stupid fucking Google Chrome is MIME-illiterate
869 (defun sy-browse-url-of-file (&optional file)
870   "Ask a WWW browser to display FILE.
871
872 Display the current buffer's file if FILE is nil or if called
873 interactively.  Turn the filename into a URL with function
874 `browse-url-file-url'.  Pass the URL to a browser using the
875 `browse-url' function then run `browse-url-of-file-hook'.
876
877 This has been reworked a little to cater for Google Chrome not knowing
878 anything about MIME types."
879   (interactive)
880   (let (oldfile)
881     (or file
882         (setq file (buffer-file-name))
883         (error "Current buffer has no file"))
884     (unless (string-match "^\\.html?$" (file-name-extension file t))
885       (setq oldfile file)
886       (rename-file file (concat file ".html"))
887       (setq file (concat file ".html")))
888     (let ((buf (get-file-buffer file)))
889       (if buf
890           (save-excursion
891             (set-buffer buf)
892             (cond ((not (buffer-modified-p)))
893                   (browse-url-save-file (save-buffer))
894                   (t (message "%s modified since last save" file))))))
895     (unwind-protect
896         (progn
897           (browse-url (browse-url-file-url file))
898           (sit-for 1))
899       (and oldfile (rename-file file oldfile))))
900   (run-hooks 'browse-url-of-file-hook))
901
902 (fset #'browse-url-of-file #'sy-browse-url-of-file)
903
904 ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::*
905 (message "miscellaneous initialised")
906