;; 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: <Saturday Apr 18, 2020 21:07:03 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 'exile)

;:*======================= 
;:* 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")

Copyright © 2020 Steve Youngs
Verbatim copying and distribution is permitted in any medium, providing this notice is preserved.
Last modified: Sat Apr 18 21:42:42 AEST 2020