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