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