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

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