cgit.sxemacs.org Git - syinit/blob - 12-misc.el

   1 ;; 12-misc --- Miscellaneous Settings
   2
   3 ;; Copyright (C) 2007 - 2021 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: <Monday 12 Apr 2021 13:43:20 (steve)>
   9 ;;   Download: <https://downloads.sxemacs.org/SYinits>
  10 ;;   HTMLised: <https://www.sxemacs.org/SYinits/12-misc.html>
  11 ;;   Git Repo: git clone https://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 ;;; Code:
  58 ;:*=======================
  59 ;:* Why type 'y e s RET' or 'n o RET' when 'y' or 'n' will do.
  60 (fset 'yes-or-no-p 'y-or-n-p)
  61
  62 (setq x-allow-sendevents t)
  63
  64 ;:*======================
  65 ;: Enable the command `narrow-to-region' ("C-x n n")
  66 ;(setq narrow-to-region t)
  67 (put 'narrow-to-region 'disabled nil)
  68
  69 ;:*======================
  70 ;:* Enable `erase-buffer'
  71 (put 'erase-buffer 'disabled nil)
  72
  73 ;:*======================
  74 ;:* Put the mouse selection in the kill buffer
  75 ;: Jan Vroonhof <vroonhof@frege.math.ethz.ch>
  76 (defun mouse-track-drag-copy-to-kill (event count)
  77   "Copy the dragged region to the kill ring"
  78   (let ((region (default-mouse-track-return-dragged-selection event)))
  79     (when region
  80       (copy-region-as-kill (car region)
  81                            (cdr region)))
  82     nil))
  83 (add-hook 'mouse-track-drag-up-hook 'mouse-track-drag-copy-to-kill)
  84
  85 ;:*=======================
  86 ;:* Keep the mouse pointer away from the text cursor
  87 (require 'avoid)
  88 (mouse-avoidance-mode 'exile)
  89
  90 ;:*=======================
  91 ;:* Frame title.
  92 (setq frame-title-format
  93       (concat "-={%b}=- "
  94               (construct-emacs-version-name)
  95               " ["
  96               (and-boundp 'sxemacs-codename
  97                 sxemacs-codename)
  98               "]"))
  99
 100 ;:*======================
 101 ;:* Additions to the menubar.
 102 (when (featurep 'menubar)
 103   (require 'big-menubar)
 104
 105   ;; Get rid of stuff from big-menubar that I don't like/use
 106   (delete-menu-item '("Top"))
 107   (delete-menu-item '("<<"))
 108   (delete-menu-item '(" | "))
 109   (delete-menu-item '(">>"))
 110   (delete-menu-item '("Bot"))
 111   (delete-menu-item '("Motion"))
 112
 113   ;; Add back the "Motion" menu, but as a submenu under "Cmds"
 114   ;; Motion menu.
 115   (add-submenu
 116    '("Cmds")
 117    '("Motion"
 118      ["Goto Mark"                  exchange-point-and-mark (mark t)]
 119      ["Goto Line..."                          goto-line           t]
 120      "---"
 121      ["End of Balanced Parentheses ( )"       forward-list        t]
 122      ["Beginning of Balanced Parentheses ( )" backward-list       t]
 123      ["Next Opening Parenthesis ("            down-list           t]
 124      ["Previous Opening Parenthesis ("        backward-up-list    t]
 125      ["Next Closing Parenthesis )"            up-list             t]
 126      "---"
 127      ["End of Balanced Expression"            forward-sexp        t]
 128      ["Beginning of Balanced Expression"      backward-sexp       t]
 129      "---"
 130      ["End of Function"                       end-of-defun        t]
 131      ["Beginning of Function"                 beginning-of-defun  t]
 132      "---"
 133      ["Next Page"                             forward-page        t]
 134      ["Previous Page"                         backward-page       t]
 135      "---"
 136      ["End of Buffer"                         end-of-buffer       t]
 137      ["Beginning of Buffer"                   beginning-of-buffer t]
 138      "---"
 139      ["Save Current Position..."              point-to-register   t]
 140      ["Goto Saved Position..."                register-to-point   t]
 141      "---"
 142      ["Set Marker..."                         set-user-marker     t]
 143      ["Goto Marker..."                        goto-user-marker    t]
 144      ["List Markers"                          list-markers        t]
 145      "---"
 146      ["Set Goal Column"                       set-goal-column     t]
 147      ["Cancel Goal Column"          (set-goal-column t) goal-column])
 148    "Abbrev"))
 149
 150
 151 ;:*======================
 152 ;:* create a Kill-Ring menu
 153 (when (featurep 'menubar)
 154   (defvar str)
 155   (defvar yank-menu-length 40
 156     "*Maximum length of an item in the menu for select-and-yank.")
 157   (defun select-and-yank-filter (menu)
 158     (let* ((count 0))
 159       (append menu
 160               (mapcar
 161                #'(lambda (str)
 162                    (if (> (length str) yank-menu-length)
 163                        (setq str (substring str 0 yank-menu-length)))
 164                    (prog1
 165                        (vector
 166                         str
 167                         (list
 168                          'progn
 169                          '(push-mark (point))
 170                          (list 'insert (list 'current-kill count t)))
 171                         t)
 172                      (setq count (1+ count))))
 173                kill-ring))))
 174   (add-submenu '("Edit") '("Kill-Ring"
 175                            :included kill-ring
 176                            :filter select-and-yank-filter)))
 177
 178 ;:*======================
 179 ;: resize-minibuffer-mode makes the minibuffer automatically
 180 ;: resize as necessary when it's too big to hold its contents.
 181 ;(autoload 'resize-minibuffer-mode "rsz-minibuf" nil t)
 182 ;(resize-minibuffer-mode)
 183 ;(setq resize-minibuffer-window-exactly nil)
 184 ;(setq minibuffer-max-depth nil)
 185 (setq resize-minibuffer-mode t)
 186 ;:*======================
 187 ;:* don't invert colors when grabbing a password
 188 ;:  (because sometimes it screws up and leaves the frame
 189 ;:  with dorked up colors).
 190 (setq passwd-invert-frame-when-keyboard-grabbed nil)
 191
 192 ;:*=======================
 193 ;:* VI-style matching parenthesis
 194 ;:  From Eric Hendrickson edh @ med.umn.edu
 195 (defun match-paren (arg)
 196   "Go to the matching parenthesis if on parenthesis."
 197   (interactive "p")
 198   (cond ((looking-at "[([{]") (forward-sexp 1) (backward-char))
 199         ((looking-at "[])}]") (forward-char) (backward-sexp 1))))
 200
 201 ;:*======================
 202 ;:* Inserting elisp Comments
 203 ; by Jonas Luster <mailto:jonas @ nethammer.qad.org>
 204 (defun elispcomment ()
 205 ;:*=====================
 206   (interactive)
 207   (insert ";:*=======================\n")
 208   (insert ";:* " (setq str (read-input "Comment: ")) "\n")
 209   (insert "\n"))
 210
 211 ;:*======================
 212 ;:* Time-Stamp
 213 (require 'time-stamp)
 214 (add-hook 'write-file-hooks 'time-stamp)
 215 (setq time-stamp-active t)
 216 (setq time-stamp-format "%a %02d %3b %4y %02H:%02M:%02S (%u)")
 217 ;:*======================
 218 ;:* Image formats
 219 (require 'image-mode)
 220 ;; Needed to load this earlier for some reason that I have long since
 221 ;; forgotten, so it is now in 01-vars-sy.el
 222 ;;(require 'ffi-wand)
 223
 224 ;; If you want to use #'Wand-display whenever you C-x C-f imagefile
 225 ;; uncomment this.  It's cool and all, but there are definitely times
 226 ;; when you don't want to view images with #'Wand-display.  Editing
 227 ;; XPM files for example.  Have you seen xpm-mode? it's awesome.
 228 ;(Wand-find-file-enable)
 229 ;; But sometimes you do want it so...
 230 ;; [2021-02-15] My ImageMagick is currently dead
 231 ;(global-set-key [(super ?x) (super ?f)] #'Wand-display)
 232
 233 ;:*=======================
 234 ;:* ffi-magic
 235 ;; Automatic coding-system detection via libmagic
 236 (require 'ffi-magic)
 237 (magic:find-file-magic-alist-enable)
 238
 239 ;:*======================
 240 ;:* Dired enhancements.
 241 (require 'dired)
 242 (setq dired-ls-locale "POSIX")
 243
 244 ;; Pack and Unpack tarballs
 245 (require 'dired-tar)
 246 (setq dired-tar-compress-with 'xz)
 247
 248 ;; FFI/libWand for image files in Dired
 249 ;; [2021-02-15] My ImageMagick is currently dead
 250 ;(defun sy-dired-wand ()
 251 ; (interactive)
 252 ; (let ((file (dired-get-filename)))
 253 ;   (Wand-display file)))
 254 ;
 255 ;(define-key dired-mode-map [?b] #'sy-dired-wand)
 256
 257 ;; Play audio files directly from dired.
 258 (defun sy-dired-play-audio ()
 259   (interactive)
 260   (let ((file (dired-get-filename)))
 261     (when (magic:file-audio-p file)
 262       (let ((stream (make-media-stream :file file)))
 263         (play-media-stream stream)))))
 264
 265 ;(setq dired-use-ls-dired t)
 266 ;(setq dired-listing-switches "-alih")
 267
 268 ;:*======================
 269 ;:* Change some modeline indicators
 270 (setq pending-delete-modeline-string nil)
 271 (setq fume-mode-line-string nil)
 272 (setq filladapt-mode-line-string nil)
 273 (setq mouse-avoidance-mode-line-string nil)
 274 (add-minor-mode 'abbrev-mode " Ab")
 275 (add-hook 'lisp-interaction-mode-hook #'(lambda () (setq mode-name "LI")))
 276
 277 ;:*======================
 278 ;:* Force efs into passive ftp because of my firewall
 279 (setq efs-use-passive-mode t)
 280
 281 ;:*======================
 282 ;:* ibuffer - replacement for buffer-menu
 283 (require 'ibuffer)
 284 (setq
 285  ibuffer-expert t
 286  ibuffer-default-sorting-mode 'major-mode
 287  ibuffer-fontification-level t
 288  ibuffer-saved-filter-groups
 289  ;; First match wins.
 290  '(("My-ibuffer-grps"
 291     ("ChangeLog"
 292      (mode . change-log-mode))
 293     ("Dired"
 294      (mode . dired-mode))
 295     ("Programming"
 296      (or
 297       (mode . emacs-lisp-mode)
 298       (mode . cperl-mode)
 299       (mode . c-mode)
 300       (mode . c++-mode)
 301       (mode . java-mode)
 302       (mode . idl-mode)
 303       (mode . lisp-mode)))
 304     ("Documentation"
 305      (or
 306       (mode . help-mode)
 307       (mode . hyper-apropos-help-mode)
 308       (mode . hyper-apropos-mode)
 309       (mode . Info-mode)
 310       (mode . Manual-mode)))
 311     ("Riece"
 312      (or
 313       (mode . riece-channel-list-mode)
 314       (mode . riece-channel-mode)
 315       (mode . riece-command-mode)
 316       (mode . riece-dialogue-mode)
 317       (mode . riece-others-mode)
 318       (mode . riece-user-list-mode)))
 319     ("Gnus"
 320      (or
 321       (mode . message-mode)
 322       (mode . mail-mode)
 323       (mode . gnus-group-mode)
 324       (mode . gnus-summary-mode)
 325       (mode . gnus-article-mode)))
 326     ("Fundamental"
 327      (mode . fundamental-mode))
 328     )))
 329
 330 (add-hook 'ibuffer-mode-hooks
 331           (lambda ()
 332             (ibuffer-switch-to-saved-filter-groups "My-ibuffer-grps")
 333             (ibuffer-add-to-tmp-hide "\\*scratch\\*")))
 334
 335 ;:*======================
 336 ;:* Sawfish mode
 337 (require 'sawfish)
 338 (add-to-list 'auto-mode-alist '("\\.sawfishrc$" . sawfish-mode))
 339 (add-to-list 'auto-mode-alist '("\\.jl$" . sawfish-mode))
 340
 341 ;:*======================
 342 ;:* from.el - check whose sent us mail
 343 ;; Not that much use anymore now that most of my mail is via IMAP so
 344 ;; doesn't go through my local server or spool.
 345 (require 'from)
 346 (setq
 347  from-mailspools '("~/mail/INBOX")
 348  from-use-other-window nil
 349  from-quit-command 'kill-buffer
 350  from-highlight-regexp
 351  #r"Merge-Req\(?:uest\)?\|P\(?:-Req\|atch\|ull-Req\)\|SXEmacs\|patch")
 352
 353 ;:*======================
 354 ;:* PS-Print
 355 (require 'ps-print)
 356 (require 'ps-mule)
 357 (require 'ps-bdf)
 358 (require 'lpr)
 359 (setq
 360  bdf-directory-list '("/usr/share/fonts/bdf")
 361  ps-multibyte-buffer 'bdf-font-except-latin
 362  ps-paper-type 'a4
 363  printer-name "Duplex_Colour")
 364
 365 ;:*======================
 366 ;:* Line and Column numbers.
 367 (line-number-mode 1)
 368 (column-number-mode 1)
 369
 370 ;:*======================
 371 ;:* Setting initial default-directory.
 372 (setq default-directory (file-name-as-directory (user-home-directory)))
 373
 374 ;:*======================
 375 ;:* Sane ChangeLogs
 376 (when (featurep 'mule)
 377   ;; Cater for the majority of the World who don't have names and
 378   ;; languages that fit nicely into US-ASCII.
 379   (add-to-list 'file-coding-system-alist
 380                (cons "ChangeLog\\(.?[[:alnum:][:punct:]]+\\)?"
 381                      '(utf-8 . utf-8))))
 382
 383 ;; Try to have even the oddly named ChangeLogs in change-log-mode
 384 (add-to-list
 385  'auto-mode-alist
 386  '("ChangeLog\\(.?[[:alnum:][:punct:]]+\\)?" . change-log-mode))
 387
 388 ;; My sy-git.el has nice font-locking for git logs, so use it outside
 389 ;; of sy-git-mode as well.
 390 (defun sy-change-log-mode-hook ()
 391   (save-excursion
 392     (when (re-search-forward "^commit [0-9a-f]+" 1000 t)
 393       (set (make-local-variable 'font-lock-defaults)
 394            '(sy-git-log-font-lock-keywords t t)))))
 395
 396 (add-hook 'change-log-mode-hook #'sy-change-log-mode-hook)
 397
 398 ;:*======================
 399 ;:* Directory Abbrevs
 400 ;;  Love this.  It saves me so much time.
 401 (setq directory-abbrev-alist
 402       `(("^/instcore" . ,(concat (car emacs-roots)
 403                                 "share/sxemacs-"
 404                                 emacs-program-version))
 405         ("^/instpkg" . ,(concat (car emacs-roots)
 406                                 "share/sxemacs"))
 407         ("^/prog" . "~/programming")
 408         ("^/linux" . "/usr/src/kernel/linux")
 409         ("^/src" . "/usr/src")
 410         ("^/sxe" . "/home/steve/programming/SXEmacs")
 411         ("^/core" . "/home/steve/programming/SXEmacs/core/sxemacs.git")
 412         ("^/web" . "/home/steve/programming/SXEmacs/web/website")
 413         ("^/init" . ,(expand-file-name "init.d" user-init-directory))
 414         ("^/blds" . "/home/steve/programming/SXEmacs/core/BUILDS")
 415         ("^/lisp" . "/home/steve/programming/lisp")
 416         ("^/pkgs" . "/home/steve/programming/SXEmacs/packages")
 417         ("^/xpkgs" . "/home/steve/programming/SXEmacs/packages/xemacs-packages")
 418         ("^/mpkgs" . "/home/steve/programming/SXEmacs/packages/mule-packages")))
 419
 420 ;:*======================
 421 ;:* The beginnings of procmail-mode.el.
 422 ;;
 423 ;; I can't remember who I stole this from, but if it was you, please
 424 ;; let me know so I can give you the credit you deserve.
 425 (defvar procmail-font-lock-keywords)
 426
 427 (define-derived-mode procmail-mode fundamental-mode "Procmail"
 428   "Major mode for editing procmail recipes."
 429
 430   (setq comment-start "#")
 431   (setq comment-start-skip "#[ \t]*")
 432
 433   ;;register keywords
 434   (setq procmail-font-lock-keywords
 435         (list '("#.*"
 436                 . font-lock-comment-face)
 437               '("^[\t ]*:.*"
 438                 . font-lock-type-face)
 439               '("[A-Za-z_]+=.*"
 440                 . font-lock-keyword-face)
 441               '("^[\t ]*\\*.*"
 442                 . font-lock-doc-string-face)
 443               '("\$[A-Za-z0-9_]+"
 444                 . font-lock-function-name-face)))
 445   (font-lock-mode))
 446
 447 (add-to-list 'auto-mode-alist '("\\.procmailrc$" . procmail-mode))
 448
 449 ;; And because my ~/.procmailrc has lots of high ASCII to defeat
 450 ;; Chinese SPAM I set its coding to binary.
 451 (when (featurep 'mule)
 452   (add-to-list 'file-coding-system-alist '("\\.procmailrc$" . binary)))
 453
 454 ;:*=======================
 455 ;:* Ninja mode (just some font-locking)
 456 ;;
 457 ;; I just took what worked from ninja-mode.el in the ninja source and
 458 ;; dumped it here with some minor massaging.
 459 (defvar ninja-font-lock-keywords)
 460
 461 (define-derived-mode ninja-mode fundamental-mode "ninja"
 462   "Major mode for a bit of font-locking in ninja files."
 463   (setq comment-start "#")
 464   (setq comment-start-skip "#[ \t]*")
 465   (setq ninja-font-lock-keywords
 466           `((,(concat "^" (regexp-opt '("rule" "build" "subninja" "include"
 467                                         "pool" "default")
 468                                       'words))
 469              . font-lock-keyword-face)
 470             ("\\([[:alnum:]_]+\\) =" 1 font-lock-variable-name-face)
 471             ;; Variable expansion.
 472             ("$[[:alnum:]_]+" . font-lock-variable-name-face)
 473             ("${[[:alnum:]._]+}" . font-lock-variable-name-face)
 474             ;; Rule names
 475             ("rule +\\([[:alnum:]_.-]+\\)" 1 font-lock-function-name-face)
 476             ;; Build Statement - highlight the rule used,
 477             ;; allow for escaped $,: in outputs.
 478             ("build +\\(?:[^:$\n]\\|$[:$]\\)+ *: *\\([[:alnum:]_.-]+\\)"
 479              1 font-lock-function-name-face)
 480             ("^#.*$" . font-lock-comment-face)))
 481   (font-lock-mode))
 482
 483 (add-to-list 'auto-mode-alist '("\\.ninja$" . ninja-mode))
 484
 485 ;:*=======================
 486 ;:* Meson / CMake
 487 ;;
 488 ;; There exists both a meson-mode and a cmake-mode but they are very
 489 ;; GNU/Emacs only and I haven't yet been able to get either to behave
 490 ;; in SXEmacs. These next two aliases will at least let me open meson
 491 ;; and cmake files that have the mode set via local cookie.
 492 (defalias 'meson-mode 'fundamental-mode)
 493 (defalias 'cmake-mode 'fundamental-mode)
 494
 495 ;:*======================
 496 ;:* Build Reports
 497 (setq
 498  build-rpt-prompts '(("Status?: "
 499                       ("Success"
 500                        "Success (tests fail)"
 501                        "Failure"
 502                        "Failure (tests fail)"
 503                        "OK (with issues)")))
 504  build-rpt-use-gnus-group "nnml:sxemacs.builds"
 505  build-rpt-use-gnus-p t
 506  build-rpt-make-output-files
 507  '("/usr/src/sxemacs/make.err"
 508    "/usr/src/sxemacs/check.err"
 509    "/usr/src/sxemacs/install.err"
 510    ))
 511
 512 ;:*======================
 513 ;:* Set the frame geometry
 514 (unless (getenv "XWEM_RUNNING")
 515   (setq default-frame-plist
 516         '(name "SXEFrame" width 90))
 517   (setq initial-frame-plist '(width 90)))
 518
 519
 520 ;:*======================
 521 ;:* The Beginnings of a Finance package
 522 (setq
 523  emoney-accounts-directory
 524  (file-name-as-directory
 525   (expand-file-name "emoney" user-init-directory))
 526  emoney-bank-url "https://internetbanking.suncorpbank.com.au/"
 527  emoney-date-format "%Y-%m-%d"
 528  emoney-default-account "scorp-main.emy"
 529  emoney-recalculate-on-quit t
 530  emoney-save-after-recalculate t
 531  emoney-use-new-frame t)
 532
 533 (require 'emoney)
 534
 535 ;:*======================
 536 ;:* Modeline enhancements.
 537 ;;
 538 ;; Reorganise the modeline so that the line and column numbers are on
 539 ;; the left where you can see them.  Also add a bit of colour to the
 540 ;; left and right ID extents so they stand out.
 541 (when (or (< emacs-minor-version 5)
 542           (featurep 'sxemacs))
 543   (setq-default modeline-buffer-identification
 544                 (list (cons modeline-buffer-id-left-extent
 545                             (cons 10 (list
 546                                       (list 'line-number-mode "L%l ")
 547                                       (list 'column-number-mode "C%c ")
 548                                       (list (cons -3 (list "%p")))
 549                                       ":")))
 550                       (cons modeline-buffer-id-right-extent "%17b")))
 551
 552   (setq-default
 553    modeline-format
 554    (list
 555     ""
 556     (if (boundp 'modeline-multibyte-status)
 557         "%C" ;modeline-multibyte-status
 558       "NoMule")
 559     (cons modeline-modified-extent 'modeline-modified)
 560     (cons modeline-buffer-id-extent 'modeline-buffer-identification)
 561     " "
 562     'global-mode-string
 563     " %[("
 564     (cons modeline-minor-mode-extent
 565           (list "" 'mode-name 'minor-mode-alist))
 566     (cons modeline-narrowed-extent "%n")
 567     'modeline-process
 568     ")%]----"
 569     "-%-"))
 570
 571   (set-extent-face modeline-buffer-id-left-extent 'font-lock-warning-face)
 572   (set-extent-face modeline-buffer-id-right-extent 'font-lock-comment-face))
 573
 574 ;:*======================
 575 ;:* Enable funky completion.
 576 ;;
 577 ;; This allows you to do things like type "M-x b-c-f RET" and it will
 578 ;; expand to `byte-compile-file'.
 579 (require 'completer)
 580
 581 ;:*======================
 582 ;:* Misc Stuff that I haven't yet put anywhere permanent
 583 ;;
 584 ;;  I used to have my browse-url setting here, but because of xdg that
 585 ;;  really isn't necessary anymore.
 586 (setq
 587  abbrev-mode t
 588  allow-deletion-of-last-visible-frame t
 589  bookmark-default-file (expand-file-name "bookmarks" user-init-directory)
 590  bookmark-save-flag 1
 591  complex-buffers-menu-p t
 592  etalk-process-file "talk"
 593  find-function-source-path nil
 594  font-menu-ignore-scaled-fonts nil
 595  ges-post-use-mime t
 596  mail-user-agent 'message-user-agent
 597  modeline-scrolling-method 'scrollbar
 598  progress-feedback-use-echo-area t
 599  report-xemacs-bug-no-explanations t
 600  scroll-step 1
 601  lookup-syntax-properties nil)
 602
 603 (quietly-read-abbrev-file)
 604 (add-hook 'text-mode-hook 'turn-on-auto-fill)
 605 ;(customize-set-variable 'gutter-buffers-tab-visible-p nil)
 606 (setq gutter-buffers-tab-enabled nil)
 607 (customize-set-variable 'user-mail-address "steve@steveyoungs.com")
 608 (setq query-user-mail-address nil)
 609 (blink-cursor-mode 1)
 610 ;; (when (featurep 'mule)
 611 ;;   (set-language-environment "Latin-1"))
 612 (unless (gnuserv-running-p)
 613   (gnuserv-start))
 614 (require 'mozmail)
 615
 616 ;:*=======================
 617 ;:* Info-mode
 618 (require 'info)
 619
 620 (setq toolbar-info-frame-plist
 621       '((width . 80)
 622         (height . 45)
 623         (name . "InfoFrame")
 624         (menubar-visible-p . nil)
 625         (default-toolbar-visible-p . t)
 626         ;; I have a idea to put nav buttons in the gutter.
 627         (default-gutter-visible-p . t)
 628         (top-gutter-height . 24)))
 629
 630 (unless (fboundp 'Info-search-next)
 631   (defun Info-search-next ()
 632     "Repeat search starting from point with last regexp used in `Info-search'."
 633     (interactive)
 634     (Info-search Info-last-search))
 635   (define-key Info-mode-map "z" 'Info-search-next))
 636
 637 (setq
 638  Info-directory-list
 639  '("/home/steve/.local/share/sxemacs/site-packages/info"
 640    "/home/steve/.local/share/sxemacs/xemacs-packages/info"
 641    "/usr/share/info"
 642    ;; "/usr/share/sxemacs/site-packages/info"
 643    ;; "/usr/share/sxemacs/sxemacs-packages/info"
 644    "/usr/share/sxemacs/xemacs-packages/info"
 645    "/usr/share/sxemacs/mule-packages/info")
 646  Info-dir-contents-directory
 647  "/home/steve/.local/share/sxemacs/site-packages/info"
 648  Info-save-auto-generated-dir 'always
 649  Info-button1-follows-hyperlink t)
 650 ;:*=======================
 651 ;:* gdb-highlight
 652 (add-hook 'gdb-mode-hook #'(lambda () (require 'gdb-highlight)))
 653
 654 ;:*=======================
 655 ;:* etags
 656 (require 'etags)
 657 (defun sy-find-tag-regex (tagname)
 658   "Use `igrep-find' command to find all occurances of tag with TAGNAME."
 659   (interactive (if current-prefix-arg (list (current-word))
 660                  (list (find-tag-tag "Find tag: "))))
 661   (let ((dir (file-name-directory tags-file-name)))
 662     (igrep-find "grep" tagname (concat dir "/*"))))
 663
 664 ;:*=======================
 665 ;:* Google (see: DuckDuckGo below)
 666 ; (require 'google-query)
 667 ; (setq google-query-mirror "https://www.google.com.au"
 668 ;       google-query-result-count 100)
 669
 670 ;:*=======================
 671 ;:* What the fuck does that acronym mean?
 672 ;; This requires wtf(6).  No idea where you get it from, but it comes
 673 ;; with Slackware.
 674 ;; (wtf "lol") => LOL: laughing out loud
 675 (defun wtf (acronym)
 676   "What the fuck is... ACRONYM"
 677   (interactive "sWhat the fuck is: ")
 678   (let* ((wtf (executable-find "wtf"))
 679          (term (substring (shell-command-to-string
 680                            (concat wtf " " acronym)) 0 -1)))
 681     (if (interactive-p)
 682         (if current-prefix-arg
 683             (insert term)
 684           (message term))
 685       term)))
 686
 687 ;:*=======================
 688 ;:* Interactively append to the latest kill
 689 ;;
 690 (defun sy-add-to-kill (start end &optional prepend)
 691   "Copy region START END and append it to the latest kill.
 692
 693 Or, PREPEND with prefix arg.
 694
 695 With this you could select \"THIS \" word, `\\[kill-ring-save]' to save it
 696 to the kill ring, then select this \"WORD \" and do `\\[sy-add-to-kill]',
 697 then select this word \"HERE\", do `\\[sy-add-to-kill]', then select these
 698 words \"DON'T WANT \", do `\\[universal-argument] \\[sy-add-to-kill]', and
 699 finally do `\\[yank]' and you'd get...
 700
 701    DON'T WANT THIS WORD HERE"
 702   (interactive "r\nP")
 703   (let ((prepend (or prepend
 704                      current-prefix-arg)))
 705     (if prepend
 706         (kill-append (buffer-substring start end) 'before)
 707       (kill-append (buffer-substring start end) nil))))
 708
 709 ;:*=======================
 710 ;:* DNS
 711 (add-to-list 'auto-mode-alist '("/var/chroot/named/etc/zones/.*$" . dns-mode))
 712
 713 (defun dig-mx (domain)
 714   "View MX records for DOMAIN.
 715
 716 With a prefix arg, prompt for a server to query."
 717   (interactive "sDomain: ")
 718   (unless (interactive-p)
 719     (error 'invalid-operation "`dig-mx' must be called interactively"))
 720   (if current-prefix-arg
 721       (dig domain "MX" nil nil nil
 722            (format "%s" (read-string "Server: " nil nil "localhost")))
 723     (dig domain "MX")))
 724
 725 (defun dig-ns (domain)
 726   "View NS records for DOMAIN.
 727
 728 With a prefix arg, prompt for a server to query."
 729   (interactive "sDomain: ")
 730   (unless (interactive-p)
 731     (error 'invalid-operation "`dig-ns' must be called interactively"))
 732   (if current-prefix-arg
 733       (dig domain "NS" nil nil nil
 734            (format "%s" (read-string "Server: " nil nil "localhost")))
 735     (dig domain "NS")))
 736
 737 (defun dig-any (domain)
 738   "View DNS records for DOMAIN.
 739
 740 With a prefix arg, prompt for a server to query."
 741   (interactive "sDomain: ")
 742   (unless (interactive-p)
 743     (error 'invalid-operation "`dig-any' must be called interactively"))
 744   (if current-prefix-arg
 745       (dig domain "ANY" nil nil nil
 746            (format "%s" (read-string "Server: " nil nil "localhost")))
 747     (dig domain "ANY")))
 748
 749 ;:*=======================
 750 ;:* Hard disk temperature!
 751 ;(or (ignore-errors (require 'hddtemp))
 752 ;    (progn
 753 ;      (load-module "cl-loop")
 754 ;      (require 'hddtemp)))
 755
 756 ;;; get fancy and stick it in the modeline
 757 ;(defvar hddtemp-global-mode-string "sda:0°C"
 758 ;  "Default hddtemp modeline string.")
 759 ;(setq global-mode-string (append global-mode-string
 760 ;                                (list hddtemp-global-mode-string)))
 761
 762 ;(defun hddtemp-modeline-string ()
 763 ;  (let* ((disc0 (hddtemp 0))
 764 ;        (str (format "sda:%s°%s"
 765 ;                     (nth 2 disc0) (nth 3 disc0))))
 766 ;    (setq hddtemp-global-mode-string str)))
 767
 768 ;(start-itimer "hdd-modeline"
 769 ;             #'(lambda ()
 770 ;                 (progn
 771 ;                   (setq global-mode-string
 772 ;                         (delq hddtemp-global-mode-string global-mode-string))
 773 ;                   (hddtemp-modeline-string)
 774 ;                   (setq global-mode-string
 775 ;                         (append global-mode-string
 776 ;                                 (list hddtemp-global-mode-string)))))
 777 ;             10 10)
 778
 779 ;:*=======================
 780 ;:* Term
 781 ; M-x term usually gives really horrid "staircase" output.  This fixes
 782 ; that.
 783 (add-hook 'term-exec-hook
 784           #'(lambda ()
 785               (set-buffer-process-coding-system 'binary 'binary)))
 786
 787 ;:*=======================
 788 ;:* Phonetic Alphabet
 789 (defvar phonetics-hash
 790   #s(hash-table test equal
 791                 data ("a" "alpha"
 792                       "b" "bravo"
 793                       "c" "charlie"
 794                       "d" "delta"
 795                       "e" "echo"
 796                       "f" "foxtrot"
 797                       "g" "golf"
 798                       "h" "hotel"
 799                       "i" "india"
 800                       "j" "juliet"
 801                       "k" "kilo"
 802                       "l" "lima"
 803                       "m" "mike"
 804                       "n" "november"
 805                       "o" "oscar"
 806                       "p" "papa"
 807                       "q" "quebec"
 808                       "r" "romeo"
 809                       "s" "sierra"
 810                       "t" "tango"
 811                       "u" "uniform"
 812                       "v" "victor"
 813                       "w" "whiskey"
 814                       "x" "x-ray"
 815                       "y" "yankee"
 816                       "z" "zulu"
 817                       " " "SPC"
 818                       "0" "zero"
 819                       "1" "one"
 820                       "2" "two"
 821                       "3" "three"
 822                       "4" "four"
 823                       "5" "five"
 824                       "6" "six"
 825                       "7" "seven"
 826                       "8" "eight"
 827                       "9" "niner"))
 828   "Hash table of phonetic alphabet.")
 829
 830 (defun phoneticise (string)
 831   "Return STRING rewritten using the phonetic alphabet.
 832
 833 For example: \"cat\" => \"charlie alpha tango\".
 834 With a prefix arg, insert phoneticised string at point.
 835 It ignores punctuation."
 836   (interactive "sString to phoneticise: ")
 837   (let ((str (string-to-list (downcase string)))
 838         phonetics)
 839     (with-temp-buffer
 840       (while str
 841         (insert (or (gethash (char-to-string (car str)) phonetics-hash)
 842                     (char-to-string (car str))) " ")
 843         (setq str (cdr str)))
 844       (setq phonetics (buffer-string)))
 845     (if current-prefix-arg
 846         (insert phonetics)
 847       (if (interactive-p)
 848           (message "%s" phonetics)
 849         phonetics))))
 850
 851 ;:*=======================
 852 ;:* Copy the text without the extents
 853 (defun sy-extent-kill-save ()
 854   "Save the extent under point's string to kill ring."
 855   (interactive)
 856   (kill-new (extent-string (extent-at (point)))))
 857
 858 ;:*=======================
 859 ;:* PkgUsr tools
 860 (require 'pkgusr)
 861
 862 ;:*=======================
 863 ;:* There's a new sexy rc.d style init in SXEmacs, and this is how I
 864 ;;  deal with it.
 865 ;;
 866 ;;  I now have my init files named with a 2 digit numerical prefix.
 867 ;;  This is so I can control which order `lisp-initd-compile-and-load'
 868 ;;  will load my stuff.  Consequently, finding a particular init file is
 869 ;;  much harder now because I can never remember what bloody number it
 870 ;;  has.  This takes the remembering out of the equation.
 871 (defvar sy-init-hash (make-hash-table :test #'equal :size 20)
 872   "A hash table of my numbered init files.")
 873
 874 (defvar sy-init-files
 875   (directory-files lisp-initd-dir nil ".*\.el$" 'sorted-list t)
 876   "List of my init files.")
 877
 878 (mapc
 879  (lambda (value)
 880    (let ((key (substring value 3 -3)))
 881      (puthash key value sy-init-hash)))
 882  sy-init-files)
 883
 884 (defvar sy-init-hash-vector (hash-keys-to-vector sy-init-hash)
 885   "A vector from my init file hash to use for completion.")
 886
 887 (defvar sy-init-history nil
 888   "History for `sy-init-file-other-window'.")
 889
 890 (defun sy-init-file-other-window (initf &optional codesys)
 891   "Basically, `find-file-other-window', but for my init files.
 892
 893 Argument INITF is the \"base\" name of the init file.
 894 Optional prefix arg, CODESYS, is to specify a coding system to use.
 895
 896 I have this because I've prefixed all of my init files with a 2
 897 digit number so I can ensure they get loaded in the right order with
 898 `lisp-initd-compile-and-load'.  And I can never remember what init
 899 files are assigned what numbers."
 900   (interactive (list (completing-read "Init file: "
 901                                       (mapcar #'list sy-init-hash-vector)
 902                                       nil nil nil sy-init-history)
 903                      (when current-prefix-arg
 904                        (read-coding-system "Coding System: "))))
 905   (let* ((lib (gethash initf sy-init-hash))
 906          (expanded (expand-file-name lib lisp-initd-dir)))
 907     (find-file-other-window expanded codesys)))
 908
 909 ;:*=======================
 910 ;:* "Active" menubar
 911 ;; Nifty little thing that hides the menubar and makes it visible when
 912 ;; the rat is on the toolbar.
 913 ;; but it's annoying
 914 ;(require 'active-menu)
 915 ;(active-menu 1)
 916
 917 ;:*=======================
 918 ;:* LiveJournal posting thingy
 919 ;;  Sadly, this no longer works because I neglected to keep it up to
 920 ;;  date with LiveJournal API changes.  But it was damn cool while it
 921 ;;  lasted.
 922 (require 'lj)
 923 ;(setq lj-cookie-flavour 'chrome)
 924 (setq lj-cookie-flavour 'firefox)
 925 (setq lj-user-id "bastard_blog")
 926 (setq lj-archive-posts t)
 927 (setq lj-bcc-address "Steve Youngs <steve@localhost>")
 928 (setq lj-default-location "Brisbane, Australia")
 929 (setq lj-signature
 930       "<hr />
 931 <p style=\"color:#FD00FD;font-size:10pt;font-weight:bold;\">
 932 Till next time...<br />
 933 <i>Steve</i>
 934 </p>")
 935 (add-hook 'lj-before-post-hook #'lj-validate)
 936 (add-hook 'lj-after-post-hook #'lj-get-tags)
 937
 938 ;:*=======================
 939 ;:* Handy kbd macros
 940 ;;
 941 ;; numpoints -- make numbered list points.  Before using, initialise
 942 ;; numeric register `n' to zero
 943 (number-to-register 0 ?n)
 944 (defalias 'numpoints
 945   (read-kbd-macro "2*RET 2*SPC C-x r + n C-x r i n C-e ) SPC"))
 946
 947 ;:*=======================
 948 ;:* Do things with environment variables let-bound
 949 ;;
 950 ;;  (with-environment-variables (("VAR" "VALUE") ("VAR2" "VALUE2"))
 951 ;;    (do-shit-here))
 952 ;;
 953 ;(require 'with-environment-variables)
 954
 955 ;:*=======================
 956 ;:* Play Sudoku
 957 (require 'sudoku)
 958 (setq sudoku-level 'easy)
 959 (setq modeline-coding-system "%C")
 960
 961 ;:*=======================
 962 ;:* Stupid fucking Google Chrome is MIME-illiterate
 963 (defun sy-browse-url-of-file (&optional file)
 964   "Ask a WWW browser to display FILE.
 965
 966 Display the current buffer's file if FILE is nil or if called
 967 interactively.  Turn the filename into a URL with function
 968 `browse-url-file-url'.  Pass the URL to a browser using the
 969 `browse-url' function then run `browse-url-of-file-hook'.
 970
 971 This has been reworked a little to cater for Google Chrome not knowing
 972 anything about MIME types."
 973   (interactive)
 974   (let (oldfile)
 975     (or file
 976         (setq file (buffer-file-name))
 977         (error "Current buffer has no file"))
 978     (unless (string-match "^\\.html?$" (file-name-extension file t))
 979       (setq oldfile file)
 980       (rename-file file (concat file ".html"))
 981       (setq file (concat file ".html")))
 982     (let ((buf (get-file-buffer file)))
 983       (if buf
 984           (save-excursion
 985             (set-buffer buf)
 986             (cond ((not (buffer-modified-p)))
 987                   (browse-url-save-file (save-buffer))
 988                   (t (message "%s modified since last save" file))))))
 989     (unwind-protect
 990         (progn
 991           (browse-url (browse-url-file-url file))
 992           (sit-for 1))
 993       (and oldfile (rename-file file oldfile))))
 994   (run-hooks 'browse-url-of-file-hook))
 995
 996 (fset #'browse-url-of-file #'sy-browse-url-of-file)
 997
 998 ;:*=======================
 999 ;:* Search DuckDuckGo
1000 (defun ddg-search (string)
1001   "Search DuckDuckGo for STRING.
1002
1003 STRING is truncated at 500 characters to stay within DuckDuckGo's
1004 limits. The results are displayed in your default browser via
1005 `browse-url'"
1006   (interactive "sSearch DuckDuckGo for: ")
1007   (let* ((baseurl "https://duckduckgo.com/?q=")
1008          (str (url-hexify-string
1009                (truncate-string-to-width string 500))))
1010     (browse-url (concat baseurl str))))
1011
1012 (defun ddg-search-region (beg end)
1013   "Search DuckDuckGo for the string BEG END.
1014
1015 The search string is truncated at 500 characters to stay within
1016 DuckDuckGo's limits. The results are displayed in your default
1017 browser via `browse-url'"
1018   (interactive "r")
1019   (let ((str (buffer-substring-no-properties beg end)))
1020     (zmacs-deactivate-region)
1021     (ddg-search str)))
1022
1023 ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::*
1024 (message "miscellaneous initialised")
1025