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

   1 ;; 12-misc-sy.el --- Miscellaneous Settings   -*- Emacs-Lisp -*-
   2
   3 ;; Copyright (C) 2007 - 2020 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: <Friday Mar 20, 2020 05:21:21 steve>
   9 ;;   Download: <http://bastard.steveyoungs.com/~steve/SXEmacs/inits/>
  10 ;;   HTMLised: <http://bastard.steveyoungs.com/~steve/SXEmacs/htmlinits/12-misc-sy.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 'jump)
  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 otherwise insert %."
 197   (interactive "p")
 198   (cond ((looking-at "[([{]") (forward-sexp 1) (backward-char))
 199         ((looking-at "[])}]") (forward-char) (backward-sexp 1))))
 200 (global-set-key '(control f1) 'match-paren)
 201
 202 ;:*======================
 203 ;:* Inserting elisp Comments
 204 ; by Jonas Luster <mailto:jonas @ nethammer.qad.org>
 205 (defun elispcomment ()
 206 ;:*=====================
 207   (interactive)
 208   (insert ";:*=======================\n")
 209   (insert ";:* " (setq str (read-input "Comment: ")) "\n")
 210   (insert "\n"))
 211 (global-set-key '(control f3) 'elispcomment)
 212
 213 ;:*======================
 214 ;:* Time-Stamp
 215 (require 'time-stamp)
 216 (add-hook 'write-file-hooks 'time-stamp)
 217 (set 'time-stamp-active t)
 218 (set 'time-stamp-format "%a %3b %2d, %4y %02H:%02M:%02S %u")
 219
 220 ;:*======================
 221 ;:* Image formats
 222 (require 'image-mode)
 223 ;; Needed to load this earlier for some reason that I have long since
 224 ;; forgotten, so it is now in 01-vars-sy.el
 225 ;;(require 'ffi-wand)
 226 (Wand-find-file-enable)
 227
 228 ;:*=======================
 229 ;:* ffi-magic
 230 ;; Automatic coding-system detection via libmagic
 231 (require 'ffi-magic)
 232 (magic:find-file-magic-alist-enable)
 233
 234 ;:*======================
 235 ;:* Dired enhancements.
 236 (require 'dired)
 237 (setq dired-ls-locale "POSIX")
 238
 239 ;; Pack and Unpack tarballs
 240 (require 'dired-tar)
 241 (setq dired-tar-compress-with 'xz)
 242
 243 ;; FFI/libWand for image files in Dired
 244 (defun sy-dired-wand ()
 245  (interactive)
 246  (let ((file (dired-get-filename)))
 247    (Wand-display file)))
 248
 249 (define-key dired-mode-map [?b] #'sy-dired-wand)
 250
 251 ;; Play audio files directly from dired.
 252 (defun sy-dired-play-audio ()
 253   (interactive)
 254   (let ((file (dired-get-filename)))
 255     (when (magic:file-audio-p file)
 256       (let ((stream (make-media-stream :file file)))
 257         (play-media-stream stream)))))
 258
 259 (define-key dired-mode-map [(control ?c) ?p] #'sy-dired-play-audio)
 260
 261 ;(setq dired-use-ls-dired t)
 262 ;(setq dired-listing-switches "-alih")
 263
 264 ;:*======================
 265 ;:* Change some modeline indicators
 266 (setq pending-delete-modeline-string nil)
 267 (setq fume-mode-line-string nil)
 268 (setq filladapt-mode-line-string nil)
 269 (setq mouse-avoidance-mode-line-string nil)
 270 (add-minor-mode 'abbrev-mode " Ab")
 271 (add-hook 'lisp-interaction-mode-hook #'(lambda () (setq mode-name "LI")))
 272
 273 ;:*======================
 274 ;:* Force efs into passive ftp because of my firewall
 275 (setq efs-use-passive-mode t)
 276
 277 ;:*======================
 278 ;:* ibuffer - replacement for buffer-menu
 279 (require 'ibuffer)
 280 (setq
 281  ibuffer-expert t
 282  ibuffer-default-sorting-mode 'major-mode
 283  ibuffer-fontification-level t
 284  ibuffer-saved-filter-groups
 285  ;; First match wins.
 286  '(("My-ibuffer-grps"
 287     ("ChangeLog"
 288      (mode . change-log-mode))
 289     ("Dired"
 290      (mode . dired-mode))
 291     ("Programming"
 292      (or
 293       (mode . emacs-lisp-mode)
 294       (mode . cperl-mode)
 295       (mode . c-mode)
 296       (mode . c++-mode)
 297       (mode . java-mode)
 298       (mode . idl-mode)
 299       (mode . lisp-mode)))
 300     ("Documentation"
 301      (or
 302       (mode . help-mode)
 303       (mode . hyper-apropos-help-mode)
 304       (mode . hyper-apropos-mode)
 305       (mode . Info-mode)
 306       (mode . Manual-mode)))
 307     ("Riece"
 308      (or
 309       (mode . riece-channel-list-mode)
 310       (mode . riece-channel-mode)
 311       (mode . riece-command-mode)
 312       (mode . riece-dialogue-mode)
 313       (mode . riece-others-mode)
 314       (mode . riece-user-list-mode)))
 315     ("Gnus"
 316      (or
 317       (mode . message-mode)
 318       (mode . mail-mode)
 319       (mode . gnus-group-mode)
 320       (mode . gnus-summary-mode)
 321       (mode . gnus-article-mode)))
 322     ("Fundamental"
 323      (mode . fundamental-mode))
 324     )))
 325
 326 (add-hook 'ibuffer-mode-hooks
 327           (lambda ()
 328             (ibuffer-switch-to-saved-filter-groups "My-ibuffer-grps")
 329             (ibuffer-add-to-tmp-hide "\\*scratch\\*")))
 330
 331 ;:*======================
 332 ;:* Sawfish mode
 333 (require 'sawfish)
 334 (add-to-list 'auto-mode-alist '("\\.sawfishrc$" . sawfish-mode))
 335 (add-to-list 'auto-mode-alist '("\\.jl$" . sawfish-mode))
 336
 337 ;:*======================
 338 ;:* from.el - check whose sent us mail
 339 (require 'from)
 340 (setq
 341  from-mailspools '("~/mail/INBOX")
 342  from-use-other-window nil
 343  from-quit-command 'kill-buffer
 344  from-highlight-regexp
 345  #r"Merge-Req\|e\(icq\|mchat\)\|pa\(?:ckages\|tch\)\|sxemacs\|x\(?:e\(?:macs\|tla\)\|wem\)")
 346
 347 ;:*======================
 348 ;:* PS-Print
 349 (require 'ps-print)
 350 (require 'ps-mule)
 351 (require 'ps-bdf)
 352 (require 'lpr)
 353 (setq
 354  bdf-directory-list '("/usr/share/fonts/bdf")
 355  ps-multibyte-buffer 'bdf-font-except-latin
 356  ps-paper-type 'a4
 357  printer-name "Duplex_Colour")
 358
 359 ;:*======================
 360 ;:* Line and Column numbers.
 361 (line-number-mode 1)
 362 (column-number-mode 1)
 363
 364 ;:*======================
 365 ;:* Setting initial default-directory.
 366 (setq default-directory (file-name-as-directory (user-home-directory)))
 367
 368 ;:*======================
 369 ;:* Sane ChangeLogs
 370 (when (featurep 'mule)
 371   (add-to-list 'file-coding-system-alist
 372                (cons "ChangeLog.[[:alnum:]]+" '(utf-8 . utf-8))))
 373
 374 (add-to-list 'auto-mode-alist
 375              '("ChangeLog[\\.-][[:alnum:]]+" . change-log-mode))
 376
 377 (defun sy-change-log-mode-hook ()
 378   (save-excursion
 379     (when (re-search-forward "^commit [0-9a-f]+" 1000 t)
 380       (set (make-local-variable 'font-lock-defaults)
 381            '(sy-git-log-font-lock-keywords t t)))))
 382
 383 (add-hook 'change-log-mode-hook #'sy-change-log-mode-hook)
 384
 385
 386 ;:*======================
 387 ;:* Directory Abbrevs
 388 (setq directory-abbrev-alist
 389       `(("^/instcore" . ,(concat (car emacs-roots)
 390                                 "share/sxemacs-"
 391                                 emacs-program-version))
 392         ("^/instpkg" . ,(concat (car emacs-roots)
 393                                 "share/sxemacs"))
 394         ("^/prog" . "~/programming")
 395         ("^/linux" . "/usr/src/kernel/linux")
 396         ("^/src" . "/usr/src")
 397         ("^/sxe" . "/home/steve/programming/SXEmacs")
 398         ("^/core" . "/home/steve/programming/SXEmacs/core/sxemacs.git")
 399         ("^/web" . "/home/steve/programming/SXEmacs/web/website")
 400         ("^/init" . ,(expand-file-name "init.d" user-init-directory))
 401         ("^/blds" . "/home/steve/programming/SXEmacs/core/BUILDS")
 402         ("^/lisp" . "/home/steve/programming/lisp")
 403         ("^/pkgs" . "/home/steve/programming/SXEmacs/packages")
 404         ("^/xpkgs" . "/home/steve/programming/SXEmacs/packages/xemacs-packages")
 405         ("^/mpkgs" . "/home/steve/programming/SXEmacs/packages/mule-packages")
 406
 407 ;:*======================
 408 ;:* The beginnings of procmail-mode.el.
 409 ;;
 410 ;; I can't remember who I stole this from, but if it was you, please
 411 ;; let me know so I can give you the credit you deserve.
 412 (defvar procmail-font-lock-keywords)
 413
 414 (define-derived-mode procmail-mode fundamental-mode "Procmail"
 415   "Major mode for editing procmail recipes."
 416
 417   (setq comment-start "#")
 418   (setq comment-start-skip "#[ \t]*")
 419
 420   ;;register keywords
 421   (setq procmail-font-lock-keywords
 422         (list '("#.*"
 423                 . font-lock-comment-face)
 424               '("^[\t ]*:.*"
 425                 . font-lock-type-face)
 426               '("[A-Za-z_]+=.*"
 427                 . font-lock-keyword-face)
 428               '("^[\t ]*\\*.*"
 429                 . font-lock-doc-string-face)
 430               '("\$[A-Za-z0-9_]+"
 431                 . font-lock-function-name-face)))
 432   (font-lock-mode))
 433
 434 (add-to-list 'auto-mode-alist '("\\.procmailrc$" . procmail-mode))
 435
 436 ;; And because my ~/.procmailrc has lots of high ASCII to defeat
 437 ;; Chinese SPAM I set its coding to binary.
 438 (when (featurep 'mule)
 439   (add-to-list 'file-coding-system-alist '("\\.procmailrc$" . binary)))
 440
 441 ;:*======================
 442 ;:* Build Reports
 443 (setq
 444  build-rpt-prompts '(("Status?: "
 445                       ("Success"
 446                        "Success (tests fail)"
 447                        "Failure"
 448                        "Failure (tests fail)"
 449                        "OK (with issues)")))
 450  build-rpt-use-gnus-group "nnml:sxemacs.builds"
 451  build-rpt-use-gnus-p t
 452  build-rpt-make-output-files
 453  '("/usr/src/sxemacs/make.err"
 454    "/usr/src/sxemacs/check.err"
 455    "/usr/src/sxemacs/install.err"
 456    ))
 457
 458 ;:*======================
 459 ;:* Set the frame geometry
 460 (unless (getenv "XWEM_RUNNING")
 461   (setq default-frame-plist
 462         '(name "SXEFrame" width 90))
 463   (setq initial-frame-plist '(width 90)))
 464
 465
 466 ;:*======================
 467 ;:* The Beginnings of a Finance package
 468 (setq
 469  emoney-accounts-directory
 470  (file-name-as-directory
 471   (expand-file-name "emoney" user-init-directory))
 472  emoney-bank-url "https://internetbanking.suncorpbank.com.au/"
 473  emoney-date-format "%Y-%m-%d"
 474  emoney-default-account "scorp-main.emy"
 475  emoney-recalculate-on-quit t
 476  emoney-save-after-recalculate t
 477  emoney-use-new-frame t)
 478
 479 (require 'emoney)
 480
 481 ;:*======================
 482 ;:* Modeline enhancements.
 483 ;;
 484 ;; Reorganise the modeline so that the line and column numbers are on
 485 ;; the left where you can see them.  Also add a bit of colour to the
 486 ;; left and right ID extents so they stand out.
 487 (when (or (< emacs-minor-version 5)
 488           (featurep 'sxemacs))
 489   (setq-default modeline-buffer-identification
 490                 (list (cons modeline-buffer-id-left-extent
 491                             (cons 10 (list
 492                                       (list 'line-number-mode "L%l ")
 493                                       (list 'column-number-mode "C%c ")
 494                                       (list (cons -3 (list "%p")))
 495                                       ":")))
 496                       (cons modeline-buffer-id-right-extent "%17b")))
 497
 498   (setq-default
 499    modeline-format
 500    (list
 501     ""
 502     (if (boundp 'modeline-multibyte-status)
 503         "%C" ;modeline-multibyte-status
 504       "NoMule")
 505     (cons modeline-modified-extent 'modeline-modified)
 506     (cons modeline-buffer-id-extent 'modeline-buffer-identification)
 507     " "
 508     'global-mode-string
 509     " %[("
 510     (cons modeline-minor-mode-extent
 511           (list "" 'mode-name 'minor-mode-alist))
 512     (cons modeline-narrowed-extent "%n")
 513     'modeline-process
 514     ")%]----"
 515     "-%-"))
 516
 517   (set-extent-face modeline-buffer-id-left-extent 'font-lock-warning-face)
 518   (set-extent-face modeline-buffer-id-right-extent 'font-lock-comment-face))
 519
 520 ;:*======================
 521 ;:* Enable funky completion.
 522 ;;
 523 ;; This allows you to do things like type "M-x b-c-f RET" and it will
 524 ;; expand to `byte-compile-file'.
 525 (require 'completer)
 526
 527 ;:*======================
 528 ;:* Misc Stuff that I haven't yet put anywhere permanent
 529 ;;
 530 ;;  I used to have my browse-url setting here, but because of xdg that
 531 ;;  really isn't necessary anymore.
 532 (setq
 533  abbrev-mode t
 534  allow-deletion-of-last-visible-frame t
 535  bookmark-default-file (expand-file-name "bookmarks" user-init-directory)
 536  bookmark-save-flag 1
 537  complex-buffers-menu-p t
 538  etalk-process-file "talk"
 539  find-function-source-path nil
 540  font-menu-ignore-scaled-fonts nil
 541  ges-post-use-mime t
 542  mail-user-agent 'message-user-agent
 543  modeline-scrolling-method 'scrollbar
 544  progress-feedback-use-echo-area t
 545  report-xemacs-bug-no-explanations t
 546  scroll-step 1
 547  lookup-syntax-properties nil)
 548
 549 (quietly-read-abbrev-file)
 550 (add-hook 'text-mode-hook 'turn-on-auto-fill)
 551 ;(customize-set-variable 'gutter-buffers-tab-visible-p nil)
 552 (setq gutter-buffers-tab-enabled nil)
 553 (customize-set-variable 'user-mail-address "steve@steveyoungs.com")
 554 (setq query-user-mail-address nil)
 555 (blink-cursor-mode 1)
 556 ;; (when (featurep 'mule)
 557 ;;   (set-language-environment "Latin-1"))
 558 (unless (gnuserv-running-p)
 559   (gnuserv-start))
 560 (require 'mozmail)
 561
 562 ;:*=======================
 563 ;:* Info-mode
 564 (require 'info)
 565
 566 (setq toolbar-info-frame-plist
 567       '((width . 80)
 568         (height . 45)
 569         (name . "InfoFrame")
 570         (menubar-visible-p . nil)
 571         (default-toolbar-visible-p . t)
 572         (default-gutter-visible-p . t)))
 573
 574 (unless (fboundp 'Info-search-next)
 575   (defun Info-search-next ()
 576     "Repeat search starting from point with last regexp used in `Info-search'."
 577     (interactive)
 578     (Info-search Info-last-search))
 579   (define-key Info-mode-map "z" 'Info-search-next))
 580
 581 (setq
 582  Info-directory-list
 583  '("/home/steve/.local/share/sxemacs/site-packages/info"
 584    "/home/steve/.local/share/sxemacs/xemacs-packages/info"
 585    "/usr/share/info"
 586    ;; "/usr/share/sxemacs/site-packages/info"
 587    ;; "/usr/share/sxemacs/sxemacs-packages/info"
 588    "/usr/share/sxemacs/xemacs-packages/info"
 589    "/usr/share/sxemacs/mule-packages/info")
 590  Info-dir-contents-directory
 591  "/home/steve/.local/share/sxemacs/site-packages/info"
 592  Info-save-auto-generated-dir 'always
 593  Info-button1-follows-hyperlink t)
 594 ;:*=======================
 595 ;:* gdb-highlight
 596 (add-hook 'gdb-mode-hook #'(lambda () (require 'gdb-highlight)))
 597
 598 ;:*=======================
 599 ;:* etags
 600 (require 'etags)
 601 (defun sy-find-tag-regex (tagname)
 602   "Use `igrep-find' command to find all occurances of tag with TAGNAME."
 603   (interactive (if current-prefix-arg (list (current-word))
 604                  (list (find-tag-tag "Find tag: "))))
 605   (let ((dir (file-name-directory tags-file-name)))
 606     (igrep-find "grep" tagname (concat dir "/*"))))
 607
 608 ;:*=======================
 609 ;:* Google
 610 (require 'google-query)
 611 (setq google-query-mirror "https://www.google.com.au"
 612       google-query-result-count 100)
 613 (global-set-key [(control f9)] 'google-query)
 614 (global-set-key [(meta f9)] 'google-query-region)
 615
 616 ;:*=======================
 617 ;:* What the fuck does that acronym mean?
 618 ;; This requires wtf(6).  No idea where you get it from, but it comes
 619 ;; with Slackware.
 620 ;; (wtf "lol") => LOL: laughing out loud
 621 (defun wtf (acronym)
 622   "What the fuck is... ACRONYM"
 623   (interactive "sWhat the fuck is: ")
 624   (let* ((wtf (executable-find "wtf"))
 625          (term (substring (shell-command-to-string
 626                            (concat wtf " " acronym)) 0 -1)))
 627     (if (interactive-p)
 628         (if current-prefix-arg
 629             (insert term)
 630           (message term))
 631       term)))
 632
 633 ;:*=======================
 634 ;:* Interactively append to the latest kill
 635 ;;
 636 (defun sy-add-to-kill (start end &optional prepend)
 637   "Copy region START END and append it to the latest kill.
 638
 639 Or, PREPEND with prefix arg.
 640
 641 With this you could select \"THIS \" word, `\\[kill-ring-save]' to save it
 642 to the kill ring, then select this \"WORD \" and do `\\[sy-add-to-kill]',
 643 then select this word \"HERE\", do `\\[sy-add-to-kill]', then select these
 644 words \"DON'T WANT \", do `\\[universal-argument] \\[sy-add-to-kill]', and
 645 finally do `\\[yank]' and you'd get...
 646
 647    DON'T WANT THIS WORD HERE"
 648   (interactive "r\nP")
 649   (let ((prepend (or prepend
 650                      current-prefix-arg)))
 651     (if prepend
 652         (kill-append (buffer-substring start end) 'before)
 653       (kill-append (buffer-substring start end) nil))))
 654
 655 (global-set-key [(meta ?W)] 'sy-add-to-kill)
 656
 657 ;:*=======================
 658 ;:* DNS
 659 (add-to-list 'auto-mode-alist '("/var/chroot/named/etc/zones/.*$" . dns-mode))
 660
 661 (defun dig-mx (domain)
 662   "View MX records for DOMAIN.
 663
 664 With a prefix arg, prompt for a server to query."
 665   (interactive "sDomain: ")
 666   (unless (interactive-p)
 667     (error 'invalid-operation "`dig-mx' must be called interactively"))
 668   (if current-prefix-arg
 669       (dig domain "MX" nil nil nil
 670            (format "%s" (read-string "Server: " nil nil "localhost")))
 671     (dig domain "MX")))
 672
 673 (defun dig-ns (domain)
 674   "View NS records for DOMAIN.
 675
 676 With a prefix arg, prompt for a server to query."
 677   (interactive "sDomain: ")
 678   (unless (interactive-p)
 679     (error 'invalid-operation "`dig-ns' must be called interactively"))
 680   (if current-prefix-arg
 681       (dig domain "NS" nil nil nil
 682            (format "%s" (read-string "Server: " nil nil "localhost")))
 683     (dig domain "NS")))
 684
 685 (defun dig-any (domain)
 686   "View DNS records for DOMAIN.
 687
 688 With a prefix arg, prompt for a server to query."
 689   (interactive "sDomain: ")
 690   (unless (interactive-p)
 691     (error 'invalid-operation "`dig-any' must be called interactively"))
 692   (if current-prefix-arg
 693       (dig domain "ANY" nil nil nil
 694            (format "%s" (read-string "Server: " nil nil "localhost")))
 695     (dig domain "ANY")))
 696
 697 ;:*=======================
 698 ;:* Hard disk temperature!
 699 ;(or (ignore-errors (require 'hddtemp))
 700 ;    (progn
 701 ;      (load-module "cl-loop")
 702 ;      (require 'hddtemp)))
 703
 704 ;;; get fancy and stick it in the modeline
 705 ;(defvar hddtemp-global-mode-string "sda:0°C"
 706 ;  "Default hddtemp modeline string.")
 707 ;(setq global-mode-string (append global-mode-string
 708 ;                                (list hddtemp-global-mode-string)))
 709
 710 ;(defun hddtemp-modeline-string ()
 711 ;  (let* ((disc0 (hddtemp 0))
 712 ;        (str (format "sda:%s°%s"
 713 ;                     (nth 2 disc0) (nth 3 disc0))))
 714 ;    (setq hddtemp-global-mode-string str)))
 715
 716 ;(start-itimer "hdd-modeline"
 717 ;             #'(lambda ()
 718 ;                 (progn
 719 ;                   (setq global-mode-string
 720 ;                         (delq hddtemp-global-mode-string global-mode-string))
 721 ;                   (hddtemp-modeline-string)
 722 ;                   (setq global-mode-string
 723 ;                         (append global-mode-string
 724 ;                                 (list hddtemp-global-mode-string)))))
 725 ;             10 10)
 726
 727 ;:*=======================
 728 ;:* Term
 729 ; M-x term usually gives really horrid "staircase" output.  This fixes
 730 ; that.
 731 (add-hook 'term-exec-hook
 732           #'(lambda ()
 733               (set-buffer-process-coding-system 'binary 'binary)))
 734
 735 ;:*=======================
 736 ;:* Phonetic Alphabet
 737 (defvar phonetics-hash
 738   #s(hash-table test equal
 739                 data ("a" "alpha"
 740                       "b" "bravo"
 741                       "c" "charlie"
 742                       "d" "delta"
 743                       "e" "echo"
 744                       "f" "foxtrot"
 745                       "g" "golf"
 746                       "h" "hotel"
 747                       "i" "india"
 748                       "j" "juliet"
 749                       "k" "kilo"
 750                       "l" "lima"
 751                       "m" "mike"
 752                       "n" "november"
 753                       "o" "oscar"
 754                       "p" "papa"
 755                       "q" "quebec"
 756                       "r" "romeo"
 757                       "s" "sierra"
 758                       "t" "tango"
 759                       "u" "uniform"
 760                       "v" "victor"
 761                       "w" "whiskey"
 762                       "x" "x-ray"
 763                       "y" "yankee"
 764                       "z" "zulu"
 765                       " " "SPC"
 766                       "0" "zero"
 767                       "1" "one"
 768                       "2" "two"
 769                       "3" "three"
 770                       "4" "four"
 771                       "5" "five"
 772                       "6" "six"
 773                       "7" "seven"
 774                       "8" "eight"
 775                       "9" "niner"))
 776   "Hash table of phonetic alphabet.")
 777
 778 (defun phoneticise (string)
 779   "Return STRING rewritten using the phonetic alphabet.
 780
 781 For example: \"cat\" => \"charlie alpha tango\".
 782 With a prefix arg, insert phoneticised string at point.
 783 It ignores punctuation."
 784   (interactive "sString to phoneticise: ")
 785   (let ((str (string-to-list (downcase string)))
 786         phonetics)
 787     (with-temp-buffer
 788       (while str
 789         (insert (or (gethash (char-to-string (car str)) phonetics-hash)
 790                     (char-to-string (car str))) " ")
 791         (setq str (cdr str)))
 792       (setq phonetics (buffer-string)))
 793     (if current-prefix-arg
 794         (insert phonetics)
 795       (if (interactive-p)
 796           (message "%s" phonetics)
 797         phonetics))))
 798
 799 ;:*=======================
 800 ;:* Copy the text without the extents
 801 (defun sy-extent-kill-save ()
 802   "Save the extent under point's string to kill ring."
 803   (interactive)
 804   (kill-new (extent-string (extent-at (point)))))
 805
 806 ;:*=======================
 807 ;:* PkgUsr tools
 808 (require 'pkgusr)
 809
 810 ;:*=======================
 811 ;:* There's a new sexy rc.d style init in SXEmacs, and this is how I
 812 ;;  deal with it.
 813 ;;
 814 ;;  I now have my init files named with a 2 digit numerical prefix.
 815 ;;  This is that I can control which order `lisp-initd-compile-and-load'
 816 ;;  will load my stuff.  Consequently, finding a particular init file is
 817 ;;  much harder now because I can never remember what bloody number it
 818 ;;  has.  This takes the remembering out of the equation.
 819 (defvar sy-init-hash (make-hash-table :test #'equal :size 20)
 820   "A hash table of my numbered init files.")
 821
 822 (defvar sy-init-files
 823   (directory-files lisp-initd-dir nil ".*\.el$" 'sorted-list t)
 824   "List of my init files.")
 825
 826 (mapc
 827  (lambda (value)
 828    (let ((key (substring value 3 -3)))
 829      (puthash key value sy-init-hash)))
 830  sy-init-files)
 831
 832 (defvar sy-init-hash-vector (hash-keys-to-vector sy-init-hash)
 833   "A vector from my init file hash to use for completion.")
 834
 835 (defvar sy-init-history nil
 836   "History for `sy-init-file-other-window'.")
 837
 838 (defun sy-init-file-other-window (initf &optional codesys)
 839   "Basically, `find-file-other-window', but for my init files.
 840
 841 Argument INITF is the \"base\" name of the init file.
 842 Optional prefix arg, CODESYS, is to specify a coding system to use.
 843
 844 I have this because I've prefixed all of my init files with a 2
 845 digit number so I can ensure they get loaded in the right order with
 846 `lisp-initd-compile-and-load'.  And I can never remember what init
 847 files are assigned what numbers."
 848   (interactive (list (completing-read "Init file: "
 849                                       (mapcar #'list sy-init-hash-vector)
 850                                       nil nil nil sy-init-history)
 851                      (when current-prefix-arg
 852                        (read-coding-system "Coding System: "))))
 853   (let* ((lib (gethash initf sy-init-hash))
 854          (expanded (expand-file-name lib lisp-initd-dir)))
 855     (find-file-other-window expanded codesys)))
 856
 857 (global-set-key [(control ?x) ?4 ?i] #'sy-init-file-other-window)
 858 ;:*=======================
 859 ;:* "Active" menubar
 860 ;; Nifty little thing that hides the menubar and makes it visible when
 861 ;; the rat is on the toolbar.
 862 ;; but it's annoying
 863 ;(require 'active-menu)
 864 ;(active-menu 1)
 865
 866 ;:*=======================
 867 ;:* LiveJournal posting thingy
 868 (require 'lj)
 869 ;(setq lj-cookie-flavour 'chrome)
 870 (setq lj-cookie-flavour 'firefox)
 871 (setq lj-user-id "bastard_blog")
 872 (setq lj-archive-posts t)
 873 (setq lj-bcc-address "Steve Youngs <steve@localhost>")
 874 (setq lj-default-location "Brisbane, Australia")
 875 (setq lj-signature
 876       "<hr />
 877 <p style=\"color:#FD00FD;font-size:10pt;font-weight:bold;\">
 878 Till next time...<br />
 879 <i>Steve</i>
 880 </p>")
 881 (add-hook 'lj-before-post-hook #'lj-validate)
 882 (add-hook 'lj-after-post-hook #'lj-get-tags)
 883
 884 ;:*=======================
 885 ;:* Handy kbd macros
 886 ;;
 887 ;; numpoints -- make numbered list points.  Before using, initialise
 888 ;; numeric register `n' to zero
 889 (number-to-register 0 ?n)
 890 (defalias 'numpoints
 891   (read-kbd-macro "2*RET 2*SPC C-x r + n C-x r i n C-e ) SPC"))
 892 (global-set-key [(control ?c) (control ?n)] #'numpoints)
 893 (define-key message-mode-map [(hyper ?n)] #'numpoints)
 894
 895 ;:*=======================
 896 ;:* Do things with environment variables let-bound
 897 ;;
 898 ;;  (with-environment-variables (("VAR" "VALUE") ("VAR2" "VALUE2"))
 899 ;;    (do-shit-here))
 900 ;;
 901 ;(require 'with-environment-variables)
 902
 903 ;:*=======================
 904 ;:* Play Sudoku
 905 (require 'sudoku)
 906 (setq sudoku-level 'easy)
 907 (setq modeline-coding-system "%C")
 908
 909 ;:*=======================
 910 ;:* Stupid fucking Google Chrome is MIME-illiterate
 911 (defun sy-browse-url-of-file (&optional file)
 912   "Ask a WWW browser to display FILE.
 913
 914 Display the current buffer's file if FILE is nil or if called
 915 interactively.  Turn the filename into a URL with function
 916 `browse-url-file-url'.  Pass the URL to a browser using the
 917 `browse-url' function then run `browse-url-of-file-hook'.
 918
 919 This has been reworked a little to cater for Google Chrome not knowing
 920 anything about MIME types."
 921   (interactive)
 922   (let (oldfile)
 923     (or file
 924         (setq file (buffer-file-name))
 925         (error "Current buffer has no file"))
 926     (unless (string-match "^\\.html?$" (file-name-extension file t))
 927       (setq oldfile file)
 928       (rename-file file (concat file ".html"))
 929       (setq file (concat file ".html")))
 930     (let ((buf (get-file-buffer file)))
 931       (if buf
 932           (save-excursion
 933             (set-buffer buf)
 934             (cond ((not (buffer-modified-p)))
 935                   (browse-url-save-file (save-buffer))
 936                   (t (message "%s modified since last save" file))))))
 937     (unwind-protect
 938         (progn
 939           (browse-url (browse-url-file-url file))
 940           (sit-for 1))
 941       (and oldfile (rename-file file oldfile))))
 942   (run-hooks 'browse-url-of-file-hook))
 943
 944 (fset #'browse-url-of-file #'sy-browse-url-of-file)
 945
 946 ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::*
 947 (message "miscellaneous initialised")
 948