--- /dev/null
+;; 12-misc --- Miscellaneous Settings
+
+;; Copyright (C) 2007 - 2020 Steve Youngs
+
+;; Author: Steve Youngs <steve@sxemacs.org>
+;; Maintainer: Steve Youngs <steve@sxemacs.org>
+;; Created: <2007-12-02>
+;; Time-stamp: <Thursday Apr 9, 2020 18:46:14 steve>
+;; Download: <https://downloads.sxemacs.org/SYinits>
+;; HTMLised: <https://www.sxemacs.org/SYinits/12-misc.html>
+;; Git Repo: git clone https://git.sxemacs.org/syinit
+;; Keywords: init, compile
+
+;; This file is part of SYinit
+
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;;
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in the
+;; documentation and/or other materials provided with the distribution.
+;;
+;; 3. Neither the name of the author nor the names of any contributors
+;; may be used to endorse or promote products derived from this
+;; software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
+;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+;; DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
+;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;; Commentary:
+;;
+;; For stuff that just doesn't seem to fit anywhere else.
+;;
+
+;;; Credits:
+;;
+;; The HTML version of this file was created with Hrvoje Niksic's
+;; htmlize.el which is part of the XEmacs "text-modes" package.
+;;
+
+;;; Todo:
+;;
+;;
+;;; Code:
+;:*=======================
+;:* Why type 'y e s RET' or 'n o RET' when 'y' or 'n' will do.
+(fset 'yes-or-no-p 'y-or-n-p)
+
+(setq x-allow-sendevents t)
+
+;:*======================
+;: Enable the command `narrow-to-region' ("C-x n n")
+;(setq narrow-to-region t)
+(put 'narrow-to-region 'disabled nil)
+
+;:*======================
+;:* Enable `erase-buffer'
+(put 'erase-buffer 'disabled nil)
+
+;:*======================
+;:* Put the mouse selection in the kill buffer
+;: Jan Vroonhof <vroonhof@frege.math.ethz.ch>
+(defun mouse-track-drag-copy-to-kill (event count)
+ "Copy the dragged region to the kill ring"
+ (let ((region (default-mouse-track-return-dragged-selection event)))
+ (when region
+ (copy-region-as-kill (car region)
+ (cdr region)))
+ nil))
+(add-hook 'mouse-track-drag-up-hook 'mouse-track-drag-copy-to-kill)
+
+;:*=======================
+;:* Keep the mouse pointer away from the text cursor
+(require 'avoid)
+(mouse-avoidance-mode 'banish)
+
+;:*=======================
+;:* Frame title.
+(setq frame-title-format
+ (concat "-={%b}=- "
+ (construct-emacs-version-name)
+ " ["
+ (and-boundp 'sxemacs-codename
+ sxemacs-codename)
+ "]"))
+
+;:*======================
+;:* Additions to the menubar.
+(when (featurep 'menubar)
+ (require 'big-menubar)
+
+ ;; Get rid of stuff from big-menubar that I don't like/use
+ (delete-menu-item '("Top"))
+ (delete-menu-item '("<<"))
+ (delete-menu-item '(" | "))
+ (delete-menu-item '(">>"))
+ (delete-menu-item '("Bot"))
+ (delete-menu-item '("Motion"))
+
+ ;; Add back the "Motion" menu, but as a submenu under "Cmds"
+ ;; Motion menu.
+ (add-submenu
+ '("Cmds")
+ '("Motion"
+ ["Goto Mark" exchange-point-and-mark (mark t)]
+ ["Goto Line..." goto-line t]
+ "---"
+ ["End of Balanced Parentheses ( )" forward-list t]
+ ["Beginning of Balanced Parentheses ( )" backward-list t]
+ ["Next Opening Parenthesis (" down-list t]
+ ["Previous Opening Parenthesis (" backward-up-list t]
+ ["Next Closing Parenthesis )" up-list t]
+ "---"
+ ["End of Balanced Expression" forward-sexp t]
+ ["Beginning of Balanced Expression" backward-sexp t]
+ "---"
+ ["End of Function" end-of-defun t]
+ ["Beginning of Function" beginning-of-defun t]
+ "---"
+ ["Next Page" forward-page t]
+ ["Previous Page" backward-page t]
+ "---"
+ ["End of Buffer" end-of-buffer t]
+ ["Beginning of Buffer" beginning-of-buffer t]
+ "---"
+ ["Save Current Position..." point-to-register t]
+ ["Goto Saved Position..." register-to-point t]
+ "---"
+ ["Set Marker..." set-user-marker t]
+ ["Goto Marker..." goto-user-marker t]
+ ["List Markers" list-markers t]
+ "---"
+ ["Set Goal Column" set-goal-column t]
+ ["Cancel Goal Column" (set-goal-column t) goal-column])
+ "Abbrev"))
+
+
+;:*======================
+;:* create a Kill-Ring menu
+(when (featurep 'menubar)
+ (defvar str)
+ (defvar yank-menu-length 40
+ "*Maximum length of an item in the menu for select-and-yank.")
+ (defun select-and-yank-filter (menu)
+ (let* ((count 0))
+ (append menu
+ (mapcar
+ #'(lambda (str)
+ (if (> (length str) yank-menu-length)
+ (setq str (substring str 0 yank-menu-length)))
+ (prog1
+ (vector
+ str
+ (list
+ 'progn
+ '(push-mark (point))
+ (list 'insert (list 'current-kill count t)))
+ t)
+ (setq count (1+ count))))
+ kill-ring))))
+ (add-submenu '("Edit") '("Kill-Ring"
+ :included kill-ring
+ :filter select-and-yank-filter)))
+
+;:*======================
+;: resize-minibuffer-mode makes the minibuffer automatically
+;: resize as necessary when it's too big to hold its contents.
+;(autoload 'resize-minibuffer-mode "rsz-minibuf" nil t)
+;(resize-minibuffer-mode)
+;(setq resize-minibuffer-window-exactly nil)
+;(setq minibuffer-max-depth nil)
+(setq resize-minibuffer-mode t)
+;:*======================
+;:* don't invert colors when grabbing a password
+;: (because sometimes it screws up and leaves the frame
+;: with dorked up colors).
+(setq passwd-invert-frame-when-keyboard-grabbed nil)
+
+;:*=======================
+;:* VI-style matching parenthesis
+;: From Eric Hendrickson edh @ med.umn.edu
+(defun match-paren (arg)
+ "Go to the matching parenthesis if on parenthesis."
+ (interactive "p")
+ (cond ((looking-at "[([{]") (forward-sexp 1) (backward-char))
+ ((looking-at "[])}]") (forward-char) (backward-sexp 1))))
+(global-set-key '(control f1) 'match-paren)
+
+;:*======================
+;:* Inserting elisp Comments
+; by Jonas Luster <mailto:jonas @ nethammer.qad.org>
+(defun elispcomment ()
+;:*=====================
+ (interactive)
+ (insert ";:*=======================\n")
+ (insert ";:* " (setq str (read-input "Comment: ")) "\n")
+ (insert "\n"))
+(global-set-key '(control f3) 'elispcomment)
+
+;:*======================
+;:* Time-Stamp
+(require 'time-stamp)
+(add-hook 'write-file-hooks 'time-stamp)
+(set 'time-stamp-active t)
+(set 'time-stamp-format "%a %3b %2d, %4y %02H:%02M:%02S %u")
+
+;:*======================
+;:* Image formats
+(require 'image-mode)
+;; Needed to load this earlier for some reason that I have long since
+;; forgotten, so it is now in 01-vars-sy.el
+;;(require 'ffi-wand)
+
+;; If you want to use #'Wand-display whenever you C-x C-f imagefile
+;; uncomment this. It's cool and all, but there are definitely times
+;; when you don't want to view images with #'Wand-display. Editing
+;; XPM files for example. Have you seen xpm-mode? it's awesome.
+;(Wand-find-file-enable)
+;; But sometimes you do want it so...
+(global-set-key [(super ?x) (super ?f)] #'Wand-display)
+
+;:*=======================
+;:* ffi-magic
+;; Automatic coding-system detection via libmagic
+(require 'ffi-magic)
+(magic:find-file-magic-alist-enable)
+
+;:*======================
+;:* Dired enhancements.
+(require 'dired)
+(setq dired-ls-locale "POSIX")
+
+;; Pack and Unpack tarballs
+(require 'dired-tar)
+(setq dired-tar-compress-with 'xz)
+
+;; FFI/libWand for image files in Dired
+(defun sy-dired-wand ()
+ (interactive)
+ (let ((file (dired-get-filename)))
+ (Wand-display file)))
+
+(define-key dired-mode-map [?b] #'sy-dired-wand)
+
+;; Play audio files directly from dired.
+(defun sy-dired-play-audio ()
+ (interactive)
+ (let ((file (dired-get-filename)))
+ (when (magic:file-audio-p file)
+ (let ((stream (make-media-stream :file file)))
+ (play-media-stream stream)))))
+
+(define-key dired-mode-map [(control ?c) ?p] #'sy-dired-play-audio)
+
+;(setq dired-use-ls-dired t)
+;(setq dired-listing-switches "-alih")
+
+;:*======================
+;:* Change some modeline indicators
+(setq pending-delete-modeline-string nil)
+(setq fume-mode-line-string nil)
+(setq filladapt-mode-line-string nil)
+(setq mouse-avoidance-mode-line-string nil)
+(add-minor-mode 'abbrev-mode " Ab")
+(add-hook 'lisp-interaction-mode-hook #'(lambda () (setq mode-name "LI")))
+
+;:*======================
+;:* Force efs into passive ftp because of my firewall
+(setq efs-use-passive-mode t)
+
+;:*======================
+;:* ibuffer - replacement for buffer-menu
+(require 'ibuffer)
+(setq
+ ibuffer-expert t
+ ibuffer-default-sorting-mode 'major-mode
+ ibuffer-fontification-level t
+ ibuffer-saved-filter-groups
+ ;; First match wins.
+ '(("My-ibuffer-grps"
+ ("ChangeLog"
+ (mode . change-log-mode))
+ ("Dired"
+ (mode . dired-mode))
+ ("Programming"
+ (or
+ (mode . emacs-lisp-mode)
+ (mode . cperl-mode)
+ (mode . c-mode)
+ (mode . c++-mode)
+ (mode . java-mode)
+ (mode . idl-mode)
+ (mode . lisp-mode)))
+ ("Documentation"
+ (or
+ (mode . help-mode)
+ (mode . hyper-apropos-help-mode)
+ (mode . hyper-apropos-mode)
+ (mode . Info-mode)
+ (mode . Manual-mode)))
+ ("Riece"
+ (or
+ (mode . riece-channel-list-mode)
+ (mode . riece-channel-mode)
+ (mode . riece-command-mode)
+ (mode . riece-dialogue-mode)
+ (mode . riece-others-mode)
+ (mode . riece-user-list-mode)))
+ ("Gnus"
+ (or
+ (mode . message-mode)
+ (mode . mail-mode)
+ (mode . gnus-group-mode)
+ (mode . gnus-summary-mode)
+ (mode . gnus-article-mode)))
+ ("Fundamental"
+ (mode . fundamental-mode))
+ )))
+
+(add-hook 'ibuffer-mode-hooks
+ (lambda ()
+ (ibuffer-switch-to-saved-filter-groups "My-ibuffer-grps")
+ (ibuffer-add-to-tmp-hide "\\*scratch\\*")))
+
+;:*======================
+;:* Sawfish mode
+(require 'sawfish)
+(add-to-list 'auto-mode-alist '("\\.sawfishrc$" . sawfish-mode))
+(add-to-list 'auto-mode-alist '("\\.jl$" . sawfish-mode))
+
+;:*======================
+;:* from.el - check whose sent us mail
+;; Not that much use anymore now that most of my mail is via IMAP so
+;; doesn't go through my local server or spool.
+(require 'from)
+(setq
+ from-mailspools '("~/mail/INBOX")
+ from-use-other-window nil
+ from-quit-command 'kill-buffer
+ from-highlight-regexp
+ #r"Merge-Req\(?:uest\)?\|P\(?:-Req\|atch\|ull-Req\)\|SXEmacs\|patch")
+
+;:*======================
+;:* PS-Print
+(require 'ps-print)
+(require 'ps-mule)
+(require 'ps-bdf)
+(require 'lpr)
+(setq
+ bdf-directory-list '("/usr/share/fonts/bdf")
+ ps-multibyte-buffer 'bdf-font-except-latin
+ ps-paper-type 'a4
+ printer-name "Duplex_Colour")
+
+;:*======================
+;:* Line and Column numbers.
+(line-number-mode 1)
+(column-number-mode 1)
+
+;:*======================
+;:* Setting initial default-directory.
+(setq default-directory (file-name-as-directory (user-home-directory)))
+
+;:*======================
+;:* Sane ChangeLogs
+(when (featurep 'mule)
+ ;; Cater for the majority of the World who don't have names and
+ ;; languages that fit nicely into US-ASCII.
+ (add-to-list 'file-coding-system-alist
+ (cons "ChangeLog\\(.?[[:alnum:][:punct:]]+\\)?"
+ '(utf-8 . utf-8))))
+
+;; Try to have even the oddly named ChangeLogs in change-log-mode
+(add-to-list
+ 'auto-mode-alist
+ '("ChangeLog\\(.?[[:alnum:][:punct:]]+\\)?" . change-log-mode))
+
+;; My sy-git.el has nice font-locking for git logs, so use it outside
+;; of sy-git-mode as well.
+(defun sy-change-log-mode-hook ()
+ (save-excursion
+ (when (re-search-forward "^commit [0-9a-f]+" 1000 t)
+ (set (make-local-variable 'font-lock-defaults)
+ '(sy-git-log-font-lock-keywords t t)))))
+
+(add-hook 'change-log-mode-hook #'sy-change-log-mode-hook)
+
+;:*======================
+;:* Directory Abbrevs
+;; Love this. It saves me so much time.
+(setq directory-abbrev-alist
+ `(("^/instcore" . ,(concat (car emacs-roots)
+ "share/sxemacs-"
+ emacs-program-version))
+ ("^/instpkg" . ,(concat (car emacs-roots)
+ "share/sxemacs"))
+ ("^/prog" . "~/programming")
+ ("^/linux" . "/usr/src/kernel/linux")
+ ("^/src" . "/usr/src")
+ ("^/sxe" . "/home/steve/programming/SXEmacs")
+ ("^/core" . "/home/steve/programming/SXEmacs/core/sxemacs.git")
+ ("^/web" . "/home/steve/programming/SXEmacs/web/website")
+ ("^/init" . ,(expand-file-name "init.d" user-init-directory))
+ ("^/blds" . "/home/steve/programming/SXEmacs/core/BUILDS")
+ ("^/lisp" . "/home/steve/programming/lisp")
+ ("^/pkgs" . "/home/steve/programming/SXEmacs/packages")
+ ("^/xpkgs" . "/home/steve/programming/SXEmacs/packages/xemacs-packages")
+ ("^/mpkgs" . "/home/steve/programming/SXEmacs/packages/mule-packages")))
+
+;:*======================
+;:* The beginnings of procmail-mode.el.
+;;
+;; I can't remember who I stole this from, but if it was you, please
+;; let me know so I can give you the credit you deserve.
+(defvar procmail-font-lock-keywords)
+
+(define-derived-mode procmail-mode fundamental-mode "Procmail"
+ "Major mode for editing procmail recipes."
+
+ (setq comment-start "#")
+ (setq comment-start-skip "#[ \t]*")
+
+ ;;register keywords
+ (setq procmail-font-lock-keywords
+ (list '("#.*"
+ . font-lock-comment-face)
+ '("^[\t ]*:.*"
+ . font-lock-type-face)
+ '("[A-Za-z_]+=.*"
+ . font-lock-keyword-face)
+ '("^[\t ]*\\*.*"
+ . font-lock-doc-string-face)
+ '("\$[A-Za-z0-9_]+"
+ . font-lock-function-name-face)))
+ (font-lock-mode))
+
+(add-to-list 'auto-mode-alist '("\\.procmailrc$" . procmail-mode))
+
+;; And because my ~/.procmailrc has lots of high ASCII to defeat
+;; Chinese SPAM I set its coding to binary.
+(when (featurep 'mule)
+ (add-to-list 'file-coding-system-alist '("\\.procmailrc$" . binary)))
+
+;:*======================
+;:* Build Reports
+(setq
+ build-rpt-prompts '(("Status?: "
+ ("Success"
+ "Success (tests fail)"
+ "Failure"
+ "Failure (tests fail)"
+ "OK (with issues)")))
+ build-rpt-use-gnus-group "nnml:sxemacs.builds"
+ build-rpt-use-gnus-p t
+ build-rpt-make-output-files
+ '("/usr/src/sxemacs/make.err"
+ "/usr/src/sxemacs/check.err"
+ "/usr/src/sxemacs/install.err"
+ ))
+
+;:*======================
+;:* Set the frame geometry
+(unless (getenv "XWEM_RUNNING")
+ (setq default-frame-plist
+ '(name "SXEFrame" width 90))
+ (setq initial-frame-plist '(width 90)))
+
+
+;:*======================
+;:* The Beginnings of a Finance package
+(setq
+ emoney-accounts-directory
+ (file-name-as-directory
+ (expand-file-name "emoney" user-init-directory))
+ emoney-bank-url "https://internetbanking.suncorpbank.com.au/"
+ emoney-date-format "%Y-%m-%d"
+ emoney-default-account "scorp-main.emy"
+ emoney-recalculate-on-quit t
+ emoney-save-after-recalculate t
+ emoney-use-new-frame t)
+
+(require 'emoney)
+
+;:*======================
+;:* Modeline enhancements.
+;;
+;; Reorganise the modeline so that the line and column numbers are on
+;; the left where you can see them. Also add a bit of colour to the
+;; left and right ID extents so they stand out.
+(when (or (< emacs-minor-version 5)
+ (featurep 'sxemacs))
+ (setq-default modeline-buffer-identification
+ (list (cons modeline-buffer-id-left-extent
+ (cons 10 (list
+ (list 'line-number-mode "L%l ")
+ (list 'column-number-mode "C%c ")
+ (list (cons -3 (list "%p")))
+ ":")))
+ (cons modeline-buffer-id-right-extent "%17b")))
+
+ (setq-default
+ modeline-format
+ (list
+ ""
+ (if (boundp 'modeline-multibyte-status)
+ "%C" ;modeline-multibyte-status
+ "NoMule")
+ (cons modeline-modified-extent 'modeline-modified)
+ (cons modeline-buffer-id-extent 'modeline-buffer-identification)
+ " "
+ 'global-mode-string
+ " %[("
+ (cons modeline-minor-mode-extent
+ (list "" 'mode-name 'minor-mode-alist))
+ (cons modeline-narrowed-extent "%n")
+ 'modeline-process
+ ")%]----"
+ "-%-"))
+
+ (set-extent-face modeline-buffer-id-left-extent 'font-lock-warning-face)
+ (set-extent-face modeline-buffer-id-right-extent 'font-lock-comment-face))
+
+;:*======================
+;:* Enable funky completion.
+;;
+;; This allows you to do things like type "M-x b-c-f RET" and it will
+;; expand to `byte-compile-file'.
+(require 'completer)
+
+;:*======================
+;:* Misc Stuff that I haven't yet put anywhere permanent
+;;
+;; I used to have my browse-url setting here, but because of xdg that
+;; really isn't necessary anymore.
+(setq
+ abbrev-mode t
+ allow-deletion-of-last-visible-frame t
+ bookmark-default-file (expand-file-name "bookmarks" user-init-directory)
+ bookmark-save-flag 1
+ complex-buffers-menu-p t
+ etalk-process-file "talk"
+ find-function-source-path nil
+ font-menu-ignore-scaled-fonts nil
+ ges-post-use-mime t
+ mail-user-agent 'message-user-agent
+ modeline-scrolling-method 'scrollbar
+ progress-feedback-use-echo-area t
+ report-xemacs-bug-no-explanations t
+ scroll-step 1
+ lookup-syntax-properties nil)
+
+(quietly-read-abbrev-file)
+(add-hook 'text-mode-hook 'turn-on-auto-fill)
+;(customize-set-variable 'gutter-buffers-tab-visible-p nil)
+(setq gutter-buffers-tab-enabled nil)
+(customize-set-variable 'user-mail-address "steve@steveyoungs.com")
+(setq query-user-mail-address nil)
+(blink-cursor-mode 1)
+;; (when (featurep 'mule)
+;; (set-language-environment "Latin-1"))
+(unless (gnuserv-running-p)
+ (gnuserv-start))
+(require 'mozmail)
+
+;:*=======================
+;:* Info-mode
+(require 'info)
+
+(setq toolbar-info-frame-plist
+ '((width . 80)
+ (height . 45)
+ (name . "InfoFrame")
+ (menubar-visible-p . nil)
+ (default-toolbar-visible-p . t)
+ ;; I have a idea to put nav buttons in the gutter.
+ (default-gutter-visible-p . t)
+ (top-gutter-height . 24)))
+
+(unless (fboundp 'Info-search-next)
+ (defun Info-search-next ()
+ "Repeat search starting from point with last regexp used in `Info-search'."
+ (interactive)
+ (Info-search Info-last-search))
+ (define-key Info-mode-map "z" 'Info-search-next))
+
+(setq
+ Info-directory-list
+ '("/home/steve/.local/share/sxemacs/site-packages/info"
+ "/home/steve/.local/share/sxemacs/xemacs-packages/info"
+ "/usr/share/info"
+ ;; "/usr/share/sxemacs/site-packages/info"
+ ;; "/usr/share/sxemacs/sxemacs-packages/info"
+ "/usr/share/sxemacs/xemacs-packages/info"
+ "/usr/share/sxemacs/mule-packages/info")
+ Info-dir-contents-directory
+ "/home/steve/.local/share/sxemacs/site-packages/info"
+ Info-save-auto-generated-dir 'always
+ Info-button1-follows-hyperlink t)
+;:*=======================
+;:* gdb-highlight
+(add-hook 'gdb-mode-hook #'(lambda () (require 'gdb-highlight)))
+
+;:*=======================
+;:* etags
+(require 'etags)
+(defun sy-find-tag-regex (tagname)
+ "Use `igrep-find' command to find all occurances of tag with TAGNAME."
+ (interactive (if current-prefix-arg (list (current-word))
+ (list (find-tag-tag "Find tag: "))))
+ (let ((dir (file-name-directory tags-file-name)))
+ (igrep-find "grep" tagname (concat dir "/*"))))
+
+;:*=======================
+;:* Google
+(require 'google-query)
+(setq google-query-mirror "https://www.google.com.au"
+ google-query-result-count 100)
+(global-set-key [(control f9)] 'google-query)
+(global-set-key [(meta f9)] 'google-query-region)
+
+;:*=======================
+;:* What the fuck does that acronym mean?
+;; This requires wtf(6). No idea where you get it from, but it comes
+;; with Slackware.
+;; (wtf "lol") => LOL: laughing out loud
+(defun wtf (acronym)
+ "What the fuck is... ACRONYM"
+ (interactive "sWhat the fuck is: ")
+ (let* ((wtf (executable-find "wtf"))
+ (term (substring (shell-command-to-string
+ (concat wtf " " acronym)) 0 -1)))
+ (if (interactive-p)
+ (if current-prefix-arg
+ (insert term)
+ (message term))
+ term)))
+
+;:*=======================
+;:* Interactively append to the latest kill
+;;
+(defun sy-add-to-kill (start end &optional prepend)
+ "Copy region START END and append it to the latest kill.
+
+Or, PREPEND with prefix arg.
+
+With this you could select \"THIS \" word, `\\[kill-ring-save]' to save it
+to the kill ring, then select this \"WORD \" and do `\\[sy-add-to-kill]',
+then select this word \"HERE\", do `\\[sy-add-to-kill]', then select these
+words \"DON'T WANT \", do `\\[universal-argument] \\[sy-add-to-kill]', and
+finally do `\\[yank]' and you'd get...
+
+ DON'T WANT THIS WORD HERE"
+ (interactive "r\nP")
+ (let ((prepend (or prepend
+ current-prefix-arg)))
+ (if prepend
+ (kill-append (buffer-substring start end) 'before)
+ (kill-append (buffer-substring start end) nil))))
+
+(global-set-key [(meta ?W)] 'sy-add-to-kill)
+
+;:*=======================
+;:* DNS
+(add-to-list 'auto-mode-alist '("/var/chroot/named/etc/zones/.*$" . dns-mode))
+
+(defun dig-mx (domain)
+ "View MX records for DOMAIN.
+
+With a prefix arg, prompt for a server to query."
+ (interactive "sDomain: ")
+ (unless (interactive-p)
+ (error 'invalid-operation "`dig-mx' must be called interactively"))
+ (if current-prefix-arg
+ (dig domain "MX" nil nil nil
+ (format "%s" (read-string "Server: " nil nil "localhost")))
+ (dig domain "MX")))
+
+(defun dig-ns (domain)
+ "View NS records for DOMAIN.
+
+With a prefix arg, prompt for a server to query."
+ (interactive "sDomain: ")
+ (unless (interactive-p)
+ (error 'invalid-operation "`dig-ns' must be called interactively"))
+ (if current-prefix-arg
+ (dig domain "NS" nil nil nil
+ (format "%s" (read-string "Server: " nil nil "localhost")))
+ (dig domain "NS")))
+
+(defun dig-any (domain)
+ "View DNS records for DOMAIN.
+
+With a prefix arg, prompt for a server to query."
+ (interactive "sDomain: ")
+ (unless (interactive-p)
+ (error 'invalid-operation "`dig-any' must be called interactively"))
+ (if current-prefix-arg
+ (dig domain "ANY" nil nil nil
+ (format "%s" (read-string "Server: " nil nil "localhost")))
+ (dig domain "ANY")))
+
+;:*=======================
+;:* Hard disk temperature!
+;(or (ignore-errors (require 'hddtemp))
+; (progn
+; (load-module "cl-loop")
+; (require 'hddtemp)))
+
+;;; get fancy and stick it in the modeline
+;(defvar hddtemp-global-mode-string "sda:0°C"
+; "Default hddtemp modeline string.")
+;(setq global-mode-string (append global-mode-string
+; (list hddtemp-global-mode-string)))
+
+;(defun hddtemp-modeline-string ()
+; (let* ((disc0 (hddtemp 0))
+; (str (format "sda:%s°%s"
+; (nth 2 disc0) (nth 3 disc0))))
+; (setq hddtemp-global-mode-string str)))
+
+;(start-itimer "hdd-modeline"
+; #'(lambda ()
+; (progn
+; (setq global-mode-string
+; (delq hddtemp-global-mode-string global-mode-string))
+; (hddtemp-modeline-string)
+; (setq global-mode-string
+; (append global-mode-string
+; (list hddtemp-global-mode-string)))))
+; 10 10)
+
+;:*=======================
+;:* Term
+; M-x term usually gives really horrid "staircase" output. This fixes
+; that.
+(add-hook 'term-exec-hook
+ #'(lambda ()
+ (set-buffer-process-coding-system 'binary 'binary)))
+
+;:*=======================
+;:* Phonetic Alphabet
+(defvar phonetics-hash
+ #s(hash-table test equal
+ data ("a" "alpha"
+ "b" "bravo"
+ "c" "charlie"
+ "d" "delta"
+ "e" "echo"
+ "f" "foxtrot"
+ "g" "golf"
+ "h" "hotel"
+ "i" "india"
+ "j" "juliet"
+ "k" "kilo"
+ "l" "lima"
+ "m" "mike"
+ "n" "november"
+ "o" "oscar"
+ "p" "papa"
+ "q" "quebec"
+ "r" "romeo"
+ "s" "sierra"
+ "t" "tango"
+ "u" "uniform"
+ "v" "victor"
+ "w" "whiskey"
+ "x" "x-ray"
+ "y" "yankee"
+ "z" "zulu"
+ " " "SPC"
+ "0" "zero"
+ "1" "one"
+ "2" "two"
+ "3" "three"
+ "4" "four"
+ "5" "five"
+ "6" "six"
+ "7" "seven"
+ "8" "eight"
+ "9" "niner"))
+ "Hash table of phonetic alphabet.")
+
+(defun phoneticise (string)
+ "Return STRING rewritten using the phonetic alphabet.
+
+For example: \"cat\" => \"charlie alpha tango\".
+With a prefix arg, insert phoneticised string at point.
+It ignores punctuation."
+ (interactive "sString to phoneticise: ")
+ (let ((str (string-to-list (downcase string)))
+ phonetics)
+ (with-temp-buffer
+ (while str
+ (insert (or (gethash (char-to-string (car str)) phonetics-hash)
+ (char-to-string (car str))) " ")
+ (setq str (cdr str)))
+ (setq phonetics (buffer-string)))
+ (if current-prefix-arg
+ (insert phonetics)
+ (if (interactive-p)
+ (message "%s" phonetics)
+ phonetics))))
+
+;:*=======================
+;:* Copy the text without the extents
+(defun sy-extent-kill-save ()
+ "Save the extent under point's string to kill ring."
+ (interactive)
+ (kill-new (extent-string (extent-at (point)))))
+
+;:*=======================
+;:* PkgUsr tools
+(require 'pkgusr)
+
+;:*=======================
+;:* There's a new sexy rc.d style init in SXEmacs, and this is how I
+;; deal with it.
+;;
+;; I now have my init files named with a 2 digit numerical prefix.
+;; This is so I can control which order `lisp-initd-compile-and-load'
+;; will load my stuff. Consequently, finding a particular init file is
+;; much harder now because I can never remember what bloody number it
+;; has. This takes the remembering out of the equation.
+(defvar sy-init-hash (make-hash-table :test #'equal :size 20)
+ "A hash table of my numbered init files.")
+
+(defvar sy-init-files
+ (directory-files lisp-initd-dir nil ".*\.el$" 'sorted-list t)
+ "List of my init files.")
+
+(mapc
+ (lambda (value)
+ (let ((key (substring value 3 -3)))
+ (puthash key value sy-init-hash)))
+ sy-init-files)
+
+(defvar sy-init-hash-vector (hash-keys-to-vector sy-init-hash)
+ "A vector from my init file hash to use for completion.")
+
+(defvar sy-init-history nil
+ "History for `sy-init-file-other-window'.")
+
+(defun sy-init-file-other-window (initf &optional codesys)
+ "Basically, `find-file-other-window', but for my init files.
+
+Argument INITF is the \"base\" name of the init file.
+Optional prefix arg, CODESYS, is to specify a coding system to use.
+
+I have this because I've prefixed all of my init files with a 2
+digit number so I can ensure they get loaded in the right order with
+`lisp-initd-compile-and-load'. And I can never remember what init
+files are assigned what numbers."
+ (interactive (list (completing-read "Init file: "
+ (mapcar #'list sy-init-hash-vector)
+ nil nil nil sy-init-history)
+ (when current-prefix-arg
+ (read-coding-system "Coding System: "))))
+ (let* ((lib (gethash initf sy-init-hash))
+ (expanded (expand-file-name lib lisp-initd-dir)))
+ (find-file-other-window expanded codesys)))
+
+(global-set-key [(control ?x) ?4 ?i] #'sy-init-file-other-window)
+
+;:*=======================
+;:* "Active" menubar
+;; Nifty little thing that hides the menubar and makes it visible when
+;; the rat is on the toolbar.
+;; but it's annoying
+;(require 'active-menu)
+;(active-menu 1)
+
+;:*=======================
+;:* LiveJournal posting thingy
+;; Sadly, this no longer works because I neglected to keep it up to
+;; date with LiveJournal API changes. But it was damn cool while it
+;; lasted.
+(require 'lj)
+;(setq lj-cookie-flavour 'chrome)
+(setq lj-cookie-flavour 'firefox)
+(setq lj-user-id "bastard_blog")
+(setq lj-archive-posts t)
+(setq lj-bcc-address "Steve Youngs <steve@localhost>")
+(setq lj-default-location "Brisbane, Australia")
+(setq lj-signature
+ "<hr />
+<p style=\"color:#FD00FD;font-size:10pt;font-weight:bold;\">
+Till next time...<br />
+<i>Steve</i>
+</p>")
+(add-hook 'lj-before-post-hook #'lj-validate)
+(add-hook 'lj-after-post-hook #'lj-get-tags)
+
+;:*=======================
+;:* Handy kbd macros
+;;
+;; numpoints -- make numbered list points. Before using, initialise
+;; numeric register `n' to zero
+(number-to-register 0 ?n)
+(defalias 'numpoints
+ (read-kbd-macro "2*RET 2*SPC C-x r + n C-x r i n C-e ) SPC"))
+(global-set-key [(control ?c) (control ?n)] #'numpoints)
+(define-key message-mode-map [(hyper ?n)] #'numpoints)
+
+;:*=======================
+;:* Do things with environment variables let-bound
+;;
+;; (with-environment-variables (("VAR" "VALUE") ("VAR2" "VALUE2"))
+;; (do-shit-here))
+;;
+;(require 'with-environment-variables)
+
+;:*=======================
+;:* Play Sudoku
+(require 'sudoku)
+(setq sudoku-level 'easy)
+(setq modeline-coding-system "%C")
+
+;:*=======================
+;:* Stupid fucking Google Chrome is MIME-illiterate
+(defun sy-browse-url-of-file (&optional file)
+ "Ask a WWW browser to display FILE.
+
+Display the current buffer's file if FILE is nil or if called
+interactively. Turn the filename into a URL with function
+`browse-url-file-url'. Pass the URL to a browser using the
+`browse-url' function then run `browse-url-of-file-hook'.
+
+This has been reworked a little to cater for Google Chrome not knowing
+anything about MIME types."
+ (interactive)
+ (let (oldfile)
+ (or file
+ (setq file (buffer-file-name))
+ (error "Current buffer has no file"))
+ (unless (string-match "^\\.html?$" (file-name-extension file t))
+ (setq oldfile file)
+ (rename-file file (concat file ".html"))
+ (setq file (concat file ".html")))
+ (let ((buf (get-file-buffer file)))
+ (if buf
+ (save-excursion
+ (set-buffer buf)
+ (cond ((not (buffer-modified-p)))
+ (browse-url-save-file (save-buffer))
+ (t (message "%s modified since last save" file))))))
+ (unwind-protect
+ (progn
+ (browse-url (browse-url-file-url file))
+ (sit-for 1))
+ (and oldfile (rename-file file oldfile))))
+ (run-hooks 'browse-url-of-file-hook))
+
+(fset #'browse-url-of-file #'sy-browse-url-of-file)
+
+;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::*
+(message "miscellaneous initialised")
+
projects / syinit / blobdiff