cgit.sxemacs.org Git - syinit/blob - 13-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