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