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: <Thursday Jan 31, 2013 12:36:29 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 name "SXEFrame")))
 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 ;;
 511 ;;  I used to have my browse-url setting here, but because of xdg that
 512 ;;  really isn't necessary anymore.
 513 (setq
 514  abbrev-mode t
 515  allow-deletion-of-last-visible-frame t
 516  bookmark-save-flag 1
 517  complex-buffers-menu-p t
 518  etalk-process-file "talk"
 519  find-function-source-path nil
 520  font-menu-ignore-scaled-fonts nil
 521  ges-post-use-mime t
 522  mail-user-agent 'message-user-agent
 523  modeline-scrolling-method 'scrollbar
 524  progress-feedback-use-echo-area t
 525  report-xemacs-bug-no-explanations t
 526  scroll-step 1
 527  lookup-syntax-properties nil)
 528
 529 (quietly-read-abbrev-file)
 530 (add-hook 'text-mode-hook 'turn-on-auto-fill)
 531 ;(customize-set-variable 'gutter-buffers-tab-visible-p nil)
 532 (setq gutter-buffers-tab-enabled nil)
 533 (customize-set-variable 'user-mail-address "steve@sxemacs.org")
 534 (setq query-user-mail-address nil)
 535 (blink-cursor-mode 1)
 536 (when (featurep 'mule)
 537   (set-language-environment "Latin-1"))
 538 (when (eq 0 (length (shell-command-to-string "ps -U steve|grep gnuserv||false")))
 539   (gnuserv-start))
 540 (require 'mozmail)
 541
 542 ;:*=======================
 543 ;:* Info-mode
 544 (require 'info)
 545
 546 (setq toolbar-info-frame-plist
 547       '((width . 85)
 548         (name . "InfoFrame")))
 549
 550 (unless (fboundp 'Info-search-next)
 551   (defun Info-search-next ()
 552     "Repeat search starting from point with last regexp used in `Info-search'."
 553     (interactive)
 554     (Info-search Info-last-search))
 555   (define-key Info-mode-map "z" 'Info-search-next))
 556
 557 (setq
 558  Info-directory-list
 559  '("/home/steve/.sxemacs/site-packages/info"
 560    "/usr/share/info"
 561    "/usr/share/sxemacs/site-packages/info"
 562    "/usr/share/sxemacs/sxemacs-packages/info"
 563    "/usr/share/sxemacs/xemacs-packages/info"
 564    "/usr/share/sxemacs/mule-packages/info")
 565  Info-dir-contents-directory
 566  "/home/steve/.sxemacs/site-packages/info"
 567  Info-save-auto-generated-dir 'always)
 568
 569 ;:*=======================
 570 ;:* gdb-highlight
 571 (add-hook 'gdb-mode-hook #'(lambda () (require 'gdb-highlight)))
 572
 573 ;:*=======================
 574 ;:* etags
 575 (require 'etags)
 576 (defun sy-find-tag-regex (tagname)
 577   "Use `igrep-find' command to find all occurances of tag with TAGNAME."
 578   (interactive (if current-prefix-arg (list (current-word))
 579                  (list (find-tag-tag "Find tag: "))))
 580   (let ((dir (file-name-directory tags-file-name)))
 581     (igrep-find "grep" tagname (concat dir "/*"))))
 582
 583 ;:*=======================
 584 ;:* Google
 585 (require 'google-query)
 586 (setq google-query-mirror "www.google.com.au"
 587       google-query-result-count 100)
 588 (global-set-key [(control f9)] 'google-query)
 589 (global-set-key [(meta f9)] 'google-query-region)
 590
 591 ;:*=======================
 592 ;:* What the fuck does that acronym mean?
 593 ;; This requires wtf(6).  No idea where you get it from, but it comes
 594 ;; with Slackware.
 595 ;; (wtf "lol") => LOL: laughing out loud
 596 (defun wtf (acronym)
 597   "What the fuck is... ACRONYM"
 598   (interactive "sWhat the fuck is: ")
 599   (let* ((wtf (executable-find "wtf"))
 600          (term (substring (shell-command-to-string
 601                            (concat wtf " " acronym)) 0 -1)))
 602     (if (interactive-p)
 603         (if current-prefix-arg
 604             (insert term)
 605           (message term))
 606       term)))
 607
 608 ;:*=======================
 609 ;:* Interactively append to the latest kill
 610 ;;
 611 (defun sy-add-to-kill (start end &optional prepend)
 612   "Copy region START END and append it to the latest kill.
 613
 614 Or, PREPEND with prefix arg.
 615
 616 With this you could select \"THIS \" word, `\\[kill-ring-save]' to save it
 617 to the kill ring, then select this \"WORD \" and do `\\[sy-add-to-kill]',
 618 then select this word \"HERE\", do `\\[sy-add-to-kill]', then select these
 619 words \"DON'T WANT \", do `\\[universal-argument] \\[sy-add-to-kill]', and
 620 finally do `\\[yank]' and you'd get...
 621
 622    DON'T WANT THIS WORD HERE"
 623   (interactive "r\nP")
 624   (let ((prepend (or prepend
 625                      current-prefix-arg)))
 626     (if prepend
 627         (kill-append (buffer-substring start end) 'before)
 628       (kill-append (buffer-substring start end) nil))))
 629
 630 (global-set-key [(meta ?W)] 'sy-add-to-kill)
 631
 632 ;:*=======================
 633 ;:* DNS
 634 (add-to-list 'auto-mode-alist '("/var/chroot/named/etc/zones/.*$" . dns-mode))
 635
 636 (defun dig-mx (domain)
 637   "View MX records for DOMAIN.
 638
 639 With a prefix arg, prompt for a server to query."
 640   (interactive "sDomain: ")
 641   (unless (interactive-p)
 642     (error 'invalid-operation "`dig-mx' must be called interactively"))
 643   (if current-prefix-arg
 644       (dig domain "MX" nil nil nil
 645            (format "%s" (read-string "Server: " nil nil "localhost")))
 646     (dig domain "MX")))
 647
 648 (defun dig-ns (domain)
 649   "View NS records for DOMAIN.
 650
 651 With a prefix arg, prompt for a server to query."
 652   (interactive "sDomain: ")
 653   (unless (interactive-p)
 654     (error 'invalid-operation "`dig-ns' must be called interactively"))
 655   (if current-prefix-arg
 656       (dig domain "NS" nil nil nil
 657            (format "%s" (read-string "Server: " nil nil "localhost")))
 658     (dig domain "NS")))
 659
 660 (defun dig-any (domain)
 661   "View DNS records for DOMAIN.
 662
 663 With a prefix arg, prompt for a server to query."
 664   (interactive "sDomain: ")
 665   (unless (interactive-p)
 666     (error 'invalid-operation "`dig-any' must be called interactively"))
 667   (if current-prefix-arg
 668       (dig domain "ANY" nil nil nil
 669            (format "%s" (read-string "Server: " nil nil "localhost")))
 670     (dig domain "ANY")))
 671
 672 ;:*=======================
 673 ;:* Hard disk temperature!
 674 ;(or (ignore-errors (require 'hddtemp))
 675 ;    (progn
 676 ;      (load-module "cl-loop")
 677 ;      (require 'hddtemp)))
 678
 679 ;;; get fancy and stick it in the modeline
 680 ;(defvar hddtemp-global-mode-string "sda:0°C"
 681 ;  "Default hddtemp modeline string.")
 682 ;(setq global-mode-string (append global-mode-string
 683 ;                                (list hddtemp-global-mode-string)))
 684
 685 ;(defun hddtemp-modeline-string ()
 686 ;  (let* ((disc0 (hddtemp 0))
 687 ;        (str (format "sda:%s°%s"
 688 ;                     (nth 2 disc0) (nth 3 disc0))))
 689 ;    (setq hddtemp-global-mode-string str)))
 690
 691 ;(start-itimer "hdd-modeline"
 692 ;             #'(lambda ()
 693 ;                 (progn
 694 ;                   (setq global-mode-string
 695 ;                         (delq hddtemp-global-mode-string global-mode-string))
 696 ;                   (hddtemp-modeline-string)
 697 ;                   (setq global-mode-string
 698 ;                         (append global-mode-string
 699 ;                                 (list hddtemp-global-mode-string)))))
 700 ;             10 10)
 701
 702 ;:*=======================
 703 ;:* Term
 704 ; M-x term usually gives really horrid "staircase" output.  This fixes
 705 ; that.
 706 (add-hook 'term-exec-hook
 707           #'(lambda ()
 708               (set-buffer-process-coding-system 'binary 'binary)))
 709
 710 ;:*=======================
 711 ;:* Phonetic Alphabet
 712 (defvar phonetics-hash
 713   #s(hash-table test equal
 714                 data ("a" "alpha"
 715                       "b" "bravo"
 716                       "c" "charlie"
 717                       "d" "delta"
 718                       "e" "echo"
 719                       "f" "foxtrot"
 720                       "g" "golf"
 721                       "h" "hotel"
 722                       "i" "india"
 723                       "j" "juliet"
 724                       "k" "kilo"
 725                       "l" "lima"
 726                       "m" "mike"
 727                       "n" "november"
 728                       "o" "oscar"
 729                       "p" "papa"
 730                       "q" "quebec"
 731                       "r" "romeo"
 732                       "s" "sierra"
 733                       "t" "tango"
 734                       "u" "uniform"
 735                       "v" "victor"
 736                       "w" "whiskey"
 737                       "x" "x-ray"
 738                       "y" "yankee"
 739                       "z" "zulu"
 740                       " " "SPC"
 741                       "0" "zero"
 742                       "1" "one"
 743                       "2" "two"
 744                       "3" "three"
 745                       "4" "four"
 746                       "5" "five"
 747                       "6" "six"
 748                       "7" "seven"
 749                       "8" "eight"
 750                       "9" "niner"))
 751   "Hash table of phonetic alphabet.")
 752
 753 (defun phoneticise (string)
 754   "Return STRING rewritten using the phonetic alphabet.
 755
 756 For example: \"cat\" => \"charlie alpha tango\".
 757 With a prefix arg, insert phoneticised string at point.
 758 It ignores punctuation."
 759   (interactive "sString to phoneticise: ")
 760   (let ((str (string-to-list (downcase string)))
 761         phonetics)
 762     (with-temp-buffer
 763       (while str
 764         (insert (or (gethash (char-to-string (car str)) phonetics-hash)
 765                     (char-to-string (car str))) " ")
 766         (setq str (cdr str)))
 767       (setq phonetics (buffer-string)))
 768     (if current-prefix-arg
 769         (insert phonetics)
 770       (if (interactive-p)
 771           (message "%s" phonetics)
 772         phonetics))))
 773
 774 ;:*=======================
 775 ;:* Copy the text without the extents
 776 (defun sy-extent-kill-save ()
 777   "Save the extent under point's string to kill ring."
 778   (interactive)
 779   (kill-new (extent-string (extent-at (point)))))
 780
 781 ;:*=======================
 782 ;:* PkgUsr tools
 783 (require 'pkgusr)
 784
 785 ;:*=======================
 786 ;:* There's a new sexy rc.d style init in SXEmacs, and this is how I
 787 ;;  deal with it.
 788 ;;
 789 ;;  I now have my init files named with a 2 digit numerical prefix.
 790 ;;  This is that I can control which order `lisp-initd-compile-and-load'
 791 ;;  will load my stuff.  Consequently, finding a particular init file is
 792 ;;  much harder now because I can never remember what bloody number it
 793 ;;  has.  This takes the remembering out of the equation.
 794 (defvar sy-init-hash (make-hash-table :test #'equal :size 20)
 795   "A hash table of my numbered init files.")
 796
 797 (defvar sy-init-files
 798   (directory-files lisp-initd-dir nil ".*\.el$" 'sorted-list t)
 799   "List of my init files.")
 800
 801 (mapc
 802  (lambda (value)
 803    (let ((key (substring value 3 -3)))
 804      (puthash key value sy-init-hash)))
 805  sy-init-files)
 806
 807 (defvar sy-init-hash-vector (hash-keys-to-vector sy-init-hash)
 808   "A vector from my init file hash to use for completion.")
 809
 810 (defvar sy-init-history nil
 811   "History for `sy-init-file-other-window'.")
 812
 813 (defun sy-init-file-other-window (initf &optional codesys)
 814   "Basically, `find-file-other-window', but for my init files.
 815
 816 Argument INITF is the \"base\" name of the init file.
 817 Optional prefix arg, CODESYS, is to specify a coding system to use.
 818
 819 I have this because I've prefixed all of my init files with a 2
 820 digit number so I can ensure they get loaded in the right order with
 821 `lisp-initd-compile-and-load'.  And I can never remember what init
 822 files are assigned what numbers."
 823   (interactive (list (completing-read "Init file: "
 824                                       (mapcar #'list sy-init-hash-vector)
 825                                       nil nil nil sy-init-history)
 826                      (when current-prefix-arg
 827                        (read-coding-system "Coding System: "))))
 828   (let* ((lib (gethash initf sy-init-hash))
 829          (expanded (expand-file-name lib lisp-initd-dir)))
 830     (find-file-other-window expanded codesys)))
 831
 832 (global-set-key [(control ?x) ?4 ?i] #'sy-init-file-other-window)
 833 ;:*=======================
 834 ;:* "Active" menubar
 835 ;; Nifty little thing that hides the menubar and makes it visible when
 836 ;; the rat is on the toolbar.
 837 ;; but it's annoying
 838 ;(require 'active-menu)
 839 ;(active-menu 1)
 840
 841 ;:*=======================
 842 ;:* LiveJournal posting thingy
 843 (require 'lj)
 844 (setq lj-cookie-flavour 'chrome)
 845 ;(setq lj-cookie-flavour 'firefox)
 846 (setq lj-user-id "bastard_blog")
 847 (setq lj-archive-posts t)
 848 (setq lj-bcc-address "Steve Youngs <steve@localhost>")
 849 (setq lj-default-location "Brisbane, Australia")
 850 (setq lj-signature
 851       "<hr />
 852 <p style=\"color:#FD00FD;font-size:10pt;font-weight:bold;\">
 853 Till next time...<br />
 854 <i>Steve</i>
 855 </p>")
 856 (add-hook 'lj-before-post-hook #'lj-validate)
 857 (add-hook 'lj-after-post-hook #'lj-get-tags)
 858
 859 ;:*=======================
 860 ;:* Handy kbd macros
 861 ;;
 862 ;; numpoints -- make numbered list points.  Before using, initialise
 863 ;; numeric register `n' to zero
 864 (number-to-register 0 ?n)
 865 (defalias 'numpoints
 866   (read-kbd-macro "2*RET 2*SPC C-x r + n C-x r i n C-f ) SPC"))
 867 (global-set-key [(control ?c) (control ?n)] #'numpoints)
 868
 869 ;:*=======================
 870 ;:* Do things with environment variables let-bound
 871 ;;
 872 ;;  (with-environment-variables (("VAR" "VALUE") ("VAR2" "VALUE2"))
 873 ;;    (do-shit-here))
 874 ;;
 875 ;(require 'with-environment-variables)
 876
 877 ;:*=======================
 878 ;:* Play Sudoku
 879 (require 'sudoku)
 880 (setq sudoku-level 'easy)
 881
 882 ;:*=======================
 883 ;:* Stupid fucking Google Chrome is MIME-illiterate
 884 (defun sy-browse-url-of-file (&optional file)
 885   "Ask a WWW browser to display FILE.
 886
 887 Display the current buffer's file if FILE is nil or if called
 888 interactively.  Turn the filename into a URL with function
 889 `browse-url-file-url'.  Pass the URL to a browser using the
 890 `browse-url' function then run `browse-url-of-file-hook'.
 891
 892 This has been reworked a little to cater for Google Chrome not knowing
 893 anything about MIME types."
 894   (interactive)
 895   (let (oldfile)
 896     (or file
 897         (setq file (buffer-file-name))
 898         (error "Current buffer has no file"))
 899     (unless (string-match "^\\.html?$" (file-name-extension file t))
 900       (setq oldfile file)
 901       (rename-file file (concat file ".html"))
 902       (setq file (concat file ".html")))
 903     (let ((buf (get-file-buffer file)))
 904       (if buf
 905           (save-excursion
 906             (set-buffer buf)
 907             (cond ((not (buffer-modified-p)))
 908                   (browse-url-save-file (save-buffer))
 909                   (t (message "%s modified since last save" file))))))
 910     (unwind-protect
 911         (progn
 912           (browse-url (browse-url-file-url file))
 913           (sit-for 1))
 914       (and oldfile (rename-file file oldfile))))
 915   (run-hooks 'browse-url-of-file-hook))
 916
 917 (when (equal browse-url-generic-program "google-chrome")
 918   (fset #'browse-url-of-file #'sy-browse-url-of-file))
 919
 920 ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::*
 921 (message "miscellaneous initialised")