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: <Thursday Mar 19, 2020 20:55:58 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
 405 ;:*======================
 406 ;:* The beginnings of procmail-mode.el.
 407 ;;
 408 ;; I can't remember who I stole this from, but if it was you, please
 409 ;; let me know so I can give you the credit you deserve.
 410 (defvar procmail-font-lock-keywords)
 411
 412 (define-derived-mode procmail-mode fundamental-mode "Procmail"
 413   "Major mode for editing procmail recipes."
 414
 415   (setq comment-start "#")
 416   (setq comment-start-skip "#[ \t]*")
 417
 418   ;;register keywords
 419   (setq procmail-font-lock-keywords
 420         (list '("#.*"
 421                 . font-lock-comment-face)
 422               '("^[\t ]*:.*"
 423                 . font-lock-type-face)
 424               '("[A-Za-z_]+=.*"
 425                 . font-lock-keyword-face)
 426               '("^[\t ]*\\*.*"
 427                 . font-lock-doc-string-face)
 428               '("\$[A-Za-z0-9_]+"
 429                 . font-lock-function-name-face)))
 430   (font-lock-mode))
 431
 432 (add-to-list 'auto-mode-alist '("\\.procmailrc$" . procmail-mode))
 433
 434 ;; And because my ~/.procmailrc has lots of high ASCII to defeat
 435 ;; Chinese SPAM I set its coding to binary.
 436 (when (featurep 'mule)
 437   (add-to-list 'file-coding-system-alist '("\\.procmailrc$" . binary)))
 438
 439 ;:*======================
 440 ;:* Build Reports
 441 (setq
 442  build-rpt-prompts '(("Status?: "
 443                       ("Success"
 444                        "Success (tests fail)"
 445                        "Failure"
 446                        "Failure (tests fail)"
 447                        "OK (with issues)")))
 448  build-rpt-use-gnus-group "nnml:sxemacs.builds"
 449  build-rpt-use-gnus-p t
 450  build-rpt-make-output-files
 451  '("/usr/src/sxemacs/make.err"
 452    "/usr/src/sxemacs/check.err"
 453    "/usr/src/sxemacs/install.err"
 454    ))
 455
 456 ;:*======================
 457 ;:* Set the frame geometry
 458 (unless (getenv "XWEM_RUNNING")
 459   (setq default-frame-plist
 460         '(name "SXEFrame" width 90))
 461   (setq initial-frame-plist '(width 90)))
 462
 463
 464 ;:*======================
 465 ;:* The Beginnings of a Finance package
 466 (setq
 467  emoney-accounts-directory
 468  (file-name-as-directory
 469   (expand-file-name "emoney" user-init-directory))
 470  emoney-bank-url "https://internetbanking.suncorpbank.com.au/"
 471  emoney-date-format "%Y-%m-%d"
 472  emoney-default-account "scorp-main.emy"
 473  emoney-recalculate-on-quit t
 474  emoney-save-after-recalculate t
 475  emoney-use-new-frame t)
 476
 477 (require 'emoney)
 478
 479 ;:*======================
 480 ;:* Modeline enhancements.
 481 ;;
 482 ;; Reorganise the modeline so that the line and column numbers are on
 483 ;; the left where you can see them.  Also add a bit of colour to the
 484 ;; left and right ID extents so they stand out.
 485 (when (or (< emacs-minor-version 5)
 486           (featurep 'sxemacs))
 487   (setq-default modeline-buffer-identification
 488                 (list (cons modeline-buffer-id-left-extent
 489                             (cons 10 (list
 490                                       (list 'line-number-mode "L%l ")
 491                                       (list 'column-number-mode "C%c ")
 492                                       (list (cons -3 (list "%p")))
 493                                       ":")))
 494                       (cons modeline-buffer-id-right-extent "%17b")))
 495
 496   (setq-default
 497    modeline-format
 498    (list
 499     ""
 500     (if (boundp 'modeline-multibyte-status)
 501         "%C" ;modeline-multibyte-status
 502       "NoMule")
 503     (cons modeline-modified-extent 'modeline-modified)
 504     (cons modeline-buffer-id-extent 'modeline-buffer-identification)
 505     " "
 506     'global-mode-string
 507     " %[("
 508     (cons modeline-minor-mode-extent
 509           (list "" 'mode-name 'minor-mode-alist))
 510     (cons modeline-narrowed-extent "%n")
 511     'modeline-process
 512     ")%]----"
 513     "-%-"))
 514
 515   (set-extent-face modeline-buffer-id-left-extent 'font-lock-warning-face)
 516   (set-extent-face modeline-buffer-id-right-extent 'font-lock-comment-face))
 517
 518 ;:*======================
 519 ;:* Enable funky completion.
 520 ;;
 521 ;; This allows you to do things like type "M-x b-c-f RET" and it will
 522 ;; expand to `byte-compile-file'.
 523 (require 'completer)
 524
 525 ;:*======================
 526 ;:* Misc Stuff that I haven't yet put anywhere permanent
 527 ;;
 528 ;;  I used to have my browse-url setting here, but because of xdg that
 529 ;;  really isn't necessary anymore.
 530 (setq
 531  abbrev-mode t
 532  allow-deletion-of-last-visible-frame t
 533  bookmark-default-file (expand-file-name "bookmarks" user-init-directory)
 534  bookmark-save-flag 1
 535  complex-buffers-menu-p t
 536  etalk-process-file "talk"
 537  find-function-source-path nil
 538  font-menu-ignore-scaled-fonts nil
 539  ges-post-use-mime t
 540  mail-user-agent 'message-user-agent
 541  modeline-scrolling-method 'scrollbar
 542  progress-feedback-use-echo-area t
 543  report-xemacs-bug-no-explanations t
 544  scroll-step 1
 545  lookup-syntax-properties nil)
 546
 547 (quietly-read-abbrev-file)
 548 (add-hook 'text-mode-hook 'turn-on-auto-fill)
 549 ;(customize-set-variable 'gutter-buffers-tab-visible-p nil)
 550 (setq gutter-buffers-tab-enabled nil)
 551 (customize-set-variable 'user-mail-address "steve@steveyoungs.com")
 552 (setq query-user-mail-address nil)
 553 (blink-cursor-mode 1)
 554 ;; (when (featurep 'mule)
 555 ;;   (set-language-environment "Latin-1"))
 556 (unless (gnuserv-running-p)
 557   (gnuserv-start))
 558 (require 'mozmail)
 559
 560 ;:*=======================
 561 ;:* Info-mode
 562 (require 'info)
 563
 564 (setq toolbar-info-frame-plist
 565       '((width . 80)
 566         (height . 45)
 567         (name . "InfoFrame")
 568         (menubar-visible-p . nil)
 569         (default-toolbar-visible-p . t)
 570         (default-gutter-visible-p . t)))
 571
 572 (unless (fboundp 'Info-search-next)
 573   (defun Info-search-next ()
 574     "Repeat search starting from point with last regexp used in `Info-search'."
 575     (interactive)
 576     (Info-search Info-last-search))
 577   (define-key Info-mode-map "z" 'Info-search-next))
 578
 579 (setq
 580  Info-directory-list
 581  '("/home/steve/.local/share/sxemacs/site-packages/info"
 582    "/home/steve/.local/share/sxemacs/xemacs-packages/info"
 583    "/usr/share/info"
 584    ;; "/usr/share/sxemacs/site-packages/info"
 585    ;; "/usr/share/sxemacs/sxemacs-packages/info"
 586    "/usr/share/sxemacs/xemacs-packages/info"
 587    "/usr/share/sxemacs/mule-packages/info")
 588  Info-dir-contents-directory
 589  "/home/steve/.local/share/sxemacs/site-packages/info"
 590  Info-save-auto-generated-dir 'always
 591  Info-button1-follows-hyperlink t)
 592 ;:*=======================
 593 ;:* gdb-highlight
 594 (add-hook 'gdb-mode-hook #'(lambda () (require 'gdb-highlight)))
 595
 596 ;:*=======================
 597 ;:* etags
 598 (require 'etags)
 599 (defun sy-find-tag-regex (tagname)
 600   "Use `igrep-find' command to find all occurances of tag with TAGNAME."
 601   (interactive (if current-prefix-arg (list (current-word))
 602                  (list (find-tag-tag "Find tag: "))))
 603   (let ((dir (file-name-directory tags-file-name)))
 604     (igrep-find "grep" tagname (concat dir "/*"))))
 605
 606 ;:*=======================
 607 ;:* Google
 608 (require 'google-query)
 609 (setq google-query-mirror "https://www.google.com.au"
 610       google-query-result-count 100)
 611 (global-set-key [(control f9)] 'google-query)
 612 (global-set-key [(meta f9)] 'google-query-region)
 613
 614 ;:*=======================
 615 ;:* What the fuck does that acronym mean?
 616 ;; This requires wtf(6).  No idea where you get it from, but it comes
 617 ;; with Slackware.
 618 ;; (wtf "lol") => LOL: laughing out loud
 619 (defun wtf (acronym)
 620   "What the fuck is... ACRONYM"
 621   (interactive "sWhat the fuck is: ")
 622   (let* ((wtf (executable-find "wtf"))
 623          (term (substring (shell-command-to-string
 624                            (concat wtf " " acronym)) 0 -1)))
 625     (if (interactive-p)
 626         (if current-prefix-arg
 627             (insert term)
 628           (message term))
 629       term)))
 630
 631 ;:*=======================
 632 ;:* Interactively append to the latest kill
 633 ;;
 634 (defun sy-add-to-kill (start end &optional prepend)
 635   "Copy region START END and append it to the latest kill.
 636
 637 Or, PREPEND with prefix arg.
 638
 639 With this you could select \"THIS \" word, `\\[kill-ring-save]' to save it
 640 to the kill ring, then select this \"WORD \" and do `\\[sy-add-to-kill]',
 641 then select this word \"HERE\", do `\\[sy-add-to-kill]', then select these
 642 words \"DON'T WANT \", do `\\[universal-argument] \\[sy-add-to-kill]', and
 643 finally do `\\[yank]' and you'd get...
 644
 645    DON'T WANT THIS WORD HERE"
 646   (interactive "r\nP")
 647   (let ((prepend (or prepend
 648                      current-prefix-arg)))
 649     (if prepend
 650         (kill-append (buffer-substring start end) 'before)
 651       (kill-append (buffer-substring start end) nil))))
 652
 653 (global-set-key [(meta ?W)] 'sy-add-to-kill)
 654
 655 ;:*=======================
 656 ;:* DNS
 657 (add-to-list 'auto-mode-alist '("/var/chroot/named/etc/zones/.*$" . dns-mode))
 658
 659 (defun dig-mx (domain)
 660   "View MX records for DOMAIN.
 661
 662 With a prefix arg, prompt for a server to query."
 663   (interactive "sDomain: ")
 664   (unless (interactive-p)
 665     (error 'invalid-operation "`dig-mx' must be called interactively"))
 666   (if current-prefix-arg
 667       (dig domain "MX" nil nil nil
 668            (format "%s" (read-string "Server: " nil nil "localhost")))
 669     (dig domain "MX")))
 670
 671 (defun dig-ns (domain)
 672   "View NS records for DOMAIN.
 673
 674 With a prefix arg, prompt for a server to query."
 675   (interactive "sDomain: ")
 676   (unless (interactive-p)
 677     (error 'invalid-operation "`dig-ns' must be called interactively"))
 678   (if current-prefix-arg
 679       (dig domain "NS" nil nil nil
 680            (format "%s" (read-string "Server: " nil nil "localhost")))
 681     (dig domain "NS")))
 682
 683 (defun dig-any (domain)
 684   "View DNS records for DOMAIN.
 685
 686 With a prefix arg, prompt for a server to query."
 687   (interactive "sDomain: ")
 688   (unless (interactive-p)
 689     (error 'invalid-operation "`dig-any' must be called interactively"))
 690   (if current-prefix-arg
 691       (dig domain "ANY" nil nil nil
 692            (format "%s" (read-string "Server: " nil nil "localhost")))
 693     (dig domain "ANY")))
 694
 695 ;:*=======================
 696 ;:* Hard disk temperature!
 697 ;(or (ignore-errors (require 'hddtemp))
 698 ;    (progn
 699 ;      (load-module "cl-loop")
 700 ;      (require 'hddtemp)))
 701
 702 ;;; get fancy and stick it in the modeline
 703 ;(defvar hddtemp-global-mode-string "sda:0°C"
 704 ;  "Default hddtemp modeline string.")
 705 ;(setq global-mode-string (append global-mode-string
 706 ;                                (list hddtemp-global-mode-string)))
 707
 708 ;(defun hddtemp-modeline-string ()
 709 ;  (let* ((disc0 (hddtemp 0))
 710 ;        (str (format "sda:%s°%s"
 711 ;                     (nth 2 disc0) (nth 3 disc0))))
 712 ;    (setq hddtemp-global-mode-string str)))
 713
 714 ;(start-itimer "hdd-modeline"
 715 ;             #'(lambda ()
 716 ;                 (progn
 717 ;                   (setq global-mode-string
 718 ;                         (delq hddtemp-global-mode-string global-mode-string))
 719 ;                   (hddtemp-modeline-string)
 720 ;                   (setq global-mode-string
 721 ;                         (append global-mode-string
 722 ;                                 (list hddtemp-global-mode-string)))))
 723 ;             10 10)
 724
 725 ;:*=======================
 726 ;:* Term
 727 ; M-x term usually gives really horrid "staircase" output.  This fixes
 728 ; that.
 729 (add-hook 'term-exec-hook
 730           #'(lambda ()
 731               (set-buffer-process-coding-system 'binary 'binary)))
 732
 733 ;:*=======================
 734 ;:* Phonetic Alphabet
 735 (defvar phonetics-hash
 736   #s(hash-table test equal
 737                 data ("a" "alpha"
 738                       "b" "bravo"
 739                       "c" "charlie"
 740                       "d" "delta"
 741                       "e" "echo"
 742                       "f" "foxtrot"
 743                       "g" "golf"
 744                       "h" "hotel"
 745                       "i" "india"
 746                       "j" "juliet"
 747                       "k" "kilo"
 748                       "l" "lima"
 749                       "m" "mike"
 750                       "n" "november"
 751                       "o" "oscar"
 752                       "p" "papa"
 753                       "q" "quebec"
 754                       "r" "romeo"
 755                       "s" "sierra"
 756                       "t" "tango"
 757                       "u" "uniform"
 758                       "v" "victor"
 759                       "w" "whiskey"
 760                       "x" "x-ray"
 761                       "y" "yankee"
 762                       "z" "zulu"
 763                       " " "SPC"
 764                       "0" "zero"
 765                       "1" "one"
 766                       "2" "two"
 767                       "3" "three"
 768                       "4" "four"
 769                       "5" "five"
 770                       "6" "six"
 771                       "7" "seven"
 772                       "8" "eight"
 773                       "9" "niner"))
 774   "Hash table of phonetic alphabet.")
 775
 776 (defun phoneticise (string)
 777   "Return STRING rewritten using the phonetic alphabet.
 778
 779 For example: \"cat\" => \"charlie alpha tango\".
 780 With a prefix arg, insert phoneticised string at point.
 781 It ignores punctuation."
 782   (interactive "sString to phoneticise: ")
 783   (let ((str (string-to-list (downcase string)))
 784         phonetics)
 785     (with-temp-buffer
 786       (while str
 787         (insert (or (gethash (char-to-string (car str)) phonetics-hash)
 788                     (char-to-string (car str))) " ")
 789         (setq str (cdr str)))
 790       (setq phonetics (buffer-string)))
 791     (if current-prefix-arg
 792         (insert phonetics)
 793       (if (interactive-p)
 794           (message "%s" phonetics)
 795         phonetics))))
 796
 797 ;:*=======================
 798 ;:* Copy the text without the extents
 799 (defun sy-extent-kill-save ()
 800   "Save the extent under point's string to kill ring."
 801   (interactive)
 802   (kill-new (extent-string (extent-at (point)))))
 803
 804 ;:*=======================
 805 ;:* PkgUsr tools
 806 (require 'pkgusr)
 807
 808 ;:*=======================
 809 ;:* There's a new sexy rc.d style init in SXEmacs, and this is how I
 810 ;;  deal with it.
 811 ;;
 812 ;;  I now have my init files named with a 2 digit numerical prefix.
 813 ;;  This is that I can control which order `lisp-initd-compile-and-load'
 814 ;;  will load my stuff.  Consequently, finding a particular init file is
 815 ;;  much harder now because I can never remember what bloody number it
 816 ;;  has.  This takes the remembering out of the equation.
 817 (defvar sy-init-hash (make-hash-table :test #'equal :size 20)
 818   "A hash table of my numbered init files.")
 819
 820 (defvar sy-init-files
 821   (directory-files lisp-initd-dir nil ".*\.el$" 'sorted-list t)
 822   "List of my init files.")
 823
 824 (mapc
 825  (lambda (value)
 826    (let ((key (substring value 3 -3)))
 827      (puthash key value sy-init-hash)))
 828  sy-init-files)
 829
 830 (defvar sy-init-hash-vector (hash-keys-to-vector sy-init-hash)
 831   "A vector from my init file hash to use for completion.")
 832
 833 (defvar sy-init-history nil
 834   "History for `sy-init-file-other-window'.")
 835
 836 (defun sy-init-file-other-window (initf &optional codesys)
 837   "Basically, `find-file-other-window', but for my init files.
 838
 839 Argument INITF is the \"base\" name of the init file.
 840 Optional prefix arg, CODESYS, is to specify a coding system to use.
 841
 842 I have this because I've prefixed all of my init files with a 2
 843 digit number so I can ensure they get loaded in the right order with
 844 `lisp-initd-compile-and-load'.  And I can never remember what init
 845 files are assigned what numbers."
 846   (interactive (list (completing-read "Init file: "
 847                                       (mapcar #'list sy-init-hash-vector)
 848                                       nil nil nil sy-init-history)
 849                      (when current-prefix-arg
 850                        (read-coding-system "Coding System: "))))
 851   (let* ((lib (gethash initf sy-init-hash))
 852          (expanded (expand-file-name lib lisp-initd-dir)))
 853     (find-file-other-window expanded codesys)))
 854
 855 (global-set-key [(control ?x) ?4 ?i] #'sy-init-file-other-window)
 856 ;:*=======================
 857 ;:* "Active" menubar
 858 ;; Nifty little thing that hides the menubar and makes it visible when
 859 ;; the rat is on the toolbar.
 860 ;; but it's annoying
 861 ;(require 'active-menu)
 862 ;(active-menu 1)
 863
 864 ;:*=======================
 865 ;:* LiveJournal posting thingy
 866 (require 'lj)
 867 ;(setq lj-cookie-flavour 'chrome)
 868 (setq lj-cookie-flavour 'firefox)
 869 (setq lj-user-id "bastard_blog")
 870 (setq lj-archive-posts t)
 871 (setq lj-bcc-address "Steve Youngs <steve@localhost>")
 872 (setq lj-default-location "Brisbane, Australia")
 873 (setq lj-signature
 874       "<hr />
 875 <p style=\"color:#FD00FD;font-size:10pt;font-weight:bold;\">
 876 Till next time...<br />
 877 <i>Steve</i>
 878 </p>")
 879 (add-hook 'lj-before-post-hook #'lj-validate)
 880 (add-hook 'lj-after-post-hook #'lj-get-tags)
 881
 882 ;:*=======================
 883 ;:* Handy kbd macros
 884 ;;
 885 ;; numpoints -- make numbered list points.  Before using, initialise
 886 ;; numeric register `n' to zero
 887 (number-to-register 0 ?n)
 888 (defalias 'numpoints
 889   (read-kbd-macro "2*RET 2*SPC C-x r + n C-x r i n C-e ) SPC"))
 890 (global-set-key [(control ?c) (control ?n)] #'numpoints)
 891 (define-key message-mode-map [(hyper ?n)] #'numpoints)
 892
 893 ;:*=======================
 894 ;:* Do things with environment variables let-bound
 895 ;;
 896 ;;  (with-environment-variables (("VAR" "VALUE") ("VAR2" "VALUE2"))
 897 ;;    (do-shit-here))
 898 ;;
 899 ;(require 'with-environment-variables)
 900
 901 ;:*=======================
 902 ;:* Play Sudoku
 903 (require 'sudoku)
 904 (setq sudoku-level 'easy)
 905 (setq modeline-coding-system "%C")
 906
 907 ;:*=======================
 908 ;:* Stupid fucking Google Chrome is MIME-illiterate
 909 (defun sy-browse-url-of-file (&optional file)
 910   "Ask a WWW browser to display FILE.
 911
 912 Display the current buffer's file if FILE is nil or if called
 913 interactively.  Turn the filename into a URL with function
 914 `browse-url-file-url'.  Pass the URL to a browser using the
 915 `browse-url' function then run `browse-url-of-file-hook'.
 916
 917 This has been reworked a little to cater for Google Chrome not knowing
 918 anything about MIME types."
 919   (interactive)
 920   (let (oldfile)
 921     (or file
 922         (setq file (buffer-file-name))
 923         (error "Current buffer has no file"))
 924     (unless (string-match "^\\.html?$" (file-name-extension file t))
 925       (setq oldfile file)
 926       (rename-file file (concat file ".html"))
 927       (setq file (concat file ".html")))
 928     (let ((buf (get-file-buffer file)))
 929       (if buf
 930           (save-excursion
 931             (set-buffer buf)
 932             (cond ((not (buffer-modified-p)))
 933                   (browse-url-save-file (save-buffer))
 934                   (t (message "%s modified since last save" file))))))
 935     (unwind-protect
 936         (progn
 937           (browse-url (browse-url-file-url file))
 938           (sit-for 1))
 939       (and oldfile (rename-file file oldfile))))
 940   (run-hooks 'browse-url-of-file-hook))
 941
 942 (fset #'browse-url-of-file #'sy-browse-url-of-file)
 943
 944 ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::*
 945 (message "miscellaneous initialised")
 946