;; 13-misc-sy.el --- Miscellaneous Settings -*- Emacs-Lisp -*- ;; Copyright (C) 2007 - 2012 Steve Youngs ;; Author: Steve Youngs ;; Maintainer: Steve Youngs ;; Created: <2007-12-02> ;; Time-stamp: ;; Download: ;; HTMLised: ;; Git Repo: git clone http://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 (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) ;:*======================= ;:* manual follows xref instead of opening a new buffer ;: Glynn Clements (defun Manual-follow-xref (&optional name-or-event) "Invoke `manual-entry' on the cross-reference under the mouse. When invoked noninteractively, the arg may be an xref string to parse instead." (interactive "e") (if (eventp name-or-event) (let* ((p (event-point name-or-event)) (extent (and p (extent-at p (event-buffer name-or-event) 'highlight))) (data (and extent (extent-property extent 'man)))) (if (eq (car-safe data) 'Manual-follow-xref) (eval data) (error "no manual cross-reference there."))) (let ((buff (current-buffer))) (or (and (manual-entry name-or-event) (or (eq (current-buffer) buff) (kill-buffer buff))) ;: If that didn't work, maybe it's in a different section than the ;: man page writer expected. For example, man pages tend assume ;: that all user programs are in section 1, but X tends to generate ;: makefiles that put things in section "n" instead... (and (string-match "[ \t]*([^)]+)\\'" name-or-event) (progn (message "No entries found for %s; checking other sections..." name-or-event) (and (manual-entry (substring name-or-event 0 (match-beginning 0)) nil t) (or (eq (current-buffer) buff) (kill-buffer buff))))))))) ;:*======================= ;:* Frame title. (setq frame-title-format (concat "-={%b}=- " (construct-emacs-version-name) (if (featurep 'mule) " (Mule) [" " (non-Mule) [") (and-boundp 'sxemacs-codename sxemacs-codename) "]")) ;:*====================== ;:* Additions to the menubar. (when (featurep 'menubar) (require 'big-menubar) (add-menu-button nil ["Fr%_ame" make-frame t] "Help")) ;:*====================== ;:* 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 nil '("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 otherwise insert %." (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 (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) (require 'ffi-wand) (Wand-find-file-enable) ;:*====================== ;:* Dired enhancements. (require 'dired) (setq dired-ls-locale "POSIX") ;; Pack and Unpack tarballs (require 'dired-tar) (setq dired-tar-compress-with 'bzip2) ;; 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 (string-match #r"\.\(wav\|au\|ogg\|mp3\|flac\)$" 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 " PD") (setq filladapt-mode-line-string "") (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))) ("Eicq" (or (mode . eicq-buddy-mode) (mode . eicq-log-mode) (mode . eicq-network-mode) (mode . world-mode) (mode . eicq-history-mode) (name . "\\*eicq-debug\\*") (filename . "/home/steve/\\.eicq/history/.*"))) ("EMchat" (or (mode . emchat-buddy-mode) (mode . emchat-log-mode) (mode . emchat-network-mode) (mode . world-mode) (mode . emchat-history-mode) (name . "\\*emchat-debug\\*") (filename . "/home/steve/\\.emchat/history/.*"))) ("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 ;(require 'from) ;(setq ; from-mailspools ; '("~/mail/INBOX") ; from-use-other-window nil ; from-quit-command 'kill-buffer ; from-highlight-regexp ; #r"Merge-Req\|e\(icq\|mchat\)\|pa\(?:ckages\|tch\)\|sxemacs\|x\(?:e\(?:macs\|tla\)\|wem\)") ;:*====================== ;:* PS-Print ;; FIXME: make this work, it looks interesting! ;(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 "/dev/lp0" ; ps-printer-name "" ; ps-print-color-p nil) ;:*====================== ;:* 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) (add-to-list 'file-coding-system-alist '("ChangeLog" . binary))) ;:*====================== ;:* Directory Abbrevs (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/linux") ("^/src" . "/usr/src") ("^/sexy" . "~/programming/SXEmacs") ("^/sexycore" . "~/programming/SXEmacs/core") ("^/sexyweb" . "~/programming/SXEmacs/web"))) ;:*====================== ;:* 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 '(;"~/programming/SXEmacs/core/sxemacs.git/=build/,,vars.out" ;"~/programming/SXEmacs/core/sxemacs.git/=build/,,beta.out" ;"~/programming/SXEmacs/core/sxemacs.git/=build/,,make-all.out" ;"~/programming/SXEmacs/core/sxemacs.git/=build/,,make-check-temacs.out" ;"~/programming/SXEmacs/core/sxemacs.git/=build/,,make-check.out" ;"~/programming/SXEmacs/core/sxemacs.git/=build/,,make-install.out" "/usr/src/sxemacs/make.err" "/usr/src/sxemacs/check.err" "/usr/src/sxemacs/install.err" )) ;:*====================== ;:* Set the frame geometry (unless (getenv "XWEM_RUNNING") (setq initial-frame-plist '(top 23 left 26 width 95 height 40) default-frame-plist '(top 3 left 26 width 95 height 40))) ;:*====================== ;:* The Beginnings of a Finance package (require 'emoney) (setq emoney-bank-url "https://internetbanking.suncorpbank.com.au/" emoney-date-format "%Y-%m-%d" emoney-default-account "metway-main.emy" emoney-recalculate-on-quit t emoney-save-after-recalculate t emoney-use-new-frame t) ;:*====================== ;:* 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 (setq abbrev-mode t allow-deletion-of-last-visible-frame t bookmark-save-flag 1 ;;; Mozilla ;; browse-url-browser-function #'browse-url-mozilla ;; browse-url-new-window-flag t ;; browse-url-mozilla-new-window-is-tab t ;;; Firefox ;; browse-url-browser-function #'browse-url-firefox ;; browse-url-new-window-flag t ;; browse-url-firefox-new-window-is-tab t ;;; Conkeror ;; browse-url-browser-function #'browse-url-firefox ;; browse-url-new-window-flag t ;; browse-url-firefox-new-window-is-tab t ;;; SeaMonkey ;; browse-url-browser-function #'browse-url-seamonkey ;; browse-url-new-window-flag t ;; browse-url-seamonkey-new-window-is-tab t ;;; Midori ;; browse-url-generic-program "midori" ;; browse-url-browser-function #'browse-url-generic ;;; Google Chrome browse-url-generic-program "google-chrome" browse-url-browser-function #'browse-url-generic browse-url-netscape-version 7 browse-url-save-file t ;; browse-url-xterm-program "xterm" 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@sxemacs.org") (setq query-user-mail-address nil) (blink-cursor-mode 1) (when (featurep 'mule) (set-language-environment "Latin-1")) (when (eq 0 (length (shell-command-to-string "ps -U steve|grep gnuserv||false"))) (gnuserv-start)) (require 'mozmail) ;:*======================= ;:* Info-mode (require 'info) (setq toolbar-info-frame-plist '((width . 85) (name . "InfoFrame"))) (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/.sxemacs/site-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/.sxemacs/site-packages/info" Info-save-auto-generated-dir 'always) ;:*======================= ;:* 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 "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 that 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 (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 ") (setq lj-default-location "Brisbane, Australia") (setq lj-signature "

Till next time...
Steve

") (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-f ) SPC")) (global-set-key [(control ?c) (control ?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) ;:*======================= ;:* 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)) (when (equal browse-url-generic-program "google-chrome") (fset #'browse-url-of-file #'sy-browse-url-of-file)) ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::* (message "miscellaneous initialised")