;;
;; Nix's .emacs for XEmacs 21.4
;;
;; Stored in RCS: $Header: /home/nix/RCS/.emacs,v 1.11 2001/07/23 22:00:22 nix Exp nix $

;; Path configuration.

(setq load-path (append (list (concat (getenv "HOME") "/lisp/")) load-path))

;; Requirements.

; Lisp routines to make everything easier.

(require 'cl)                                   ; For mapcar* and other things
(require 'nixlist)                              ; My list manipulation functions

; General Emacs UI improvements.

(require 'winring)                              ; The `window ring' is *very* useful
(require 'scroll-in-place)                      ; We want to scroll nicely
(require 'uniquify)                             ; This really is deeply deeply nifty
(require 'icomplete)                            ; So too is this
(require 'balloon-help)                         ; Tooltips are go!
(require 'hack-locals)                          ; Don't ask if evals should be executed if I wrote the code.
(require 'type-break)                           ; Save the hands

(when (featurep 'xemacs)
  (require 'x-compose))                         ; I often need international characters.

(unless (featurep 'xemacs)
  (iswitchb-mode 1))

;; Disable novice-mode... is there a cleaner way than this?

;; (Yes, but it's just as ugly, only a one-off. I *never* want to be bothered by
;; disabled commands, so this would be needed anyway, to stop disabled commands
;; in newly `load'ed files from interfering.)

(defun nix-enable-disabled-commands (&rest ignore)
  "This function completely disables disabled commands.
it does this by, uh, enabling them. I hope this is clear."
  (remprop this-command 'disabled)
  (call-interactively this-command))

(setq disabled-command-hook 'nix-enable-disabled-commands)

;; Stop default.el from loading the desktop (we do it below ourselves)

(setq inhibit-default-init-portions '(desktop-load))

;; Personalize the modeline.

(setq-default modeline-buffer-identification 
              (list (cons modeline-buffer-id-left-extent "NixEmacs%N:")
                    (cons modeline-buffer-id-right-extent " %17b")))

(require 'init-prog-modes)                       ; Initialize programming-language-related stuff.
(require 'init-message-modes)                    ; Initialize email/news-related stuff, non-Gnus-specific
(require 'init-music)                            ; Initialize the EMMS.

;; Flashy colours

(set-face-foreground 'highlight "DarkGreen")
(set-face-background 'highlight "DarkSeaGreen2")

;; Anti-RSI stuff.

; type-break is very noisy in the modeline; we stop it from stamping where it
; wants to stamp.

(let ((minor-mode-alist minor-mode-alist))
  (type-break-mode))                            ; Save the hands

;; Shut up type-break's more inane messages

(defadvice type-break-time-warning (around nix-type-break-time-warning-snuff-logging last activate)
  "Block logging of the `Type break due in {blah}' messages.
The messages are still displayed."
   (let ((old-message-function (symbol-function 'message))
         (log-message-ignore-regexps (append log-message-ignore-regexps
                                              '("Warning: typing break due in"))))
       (unwind-protect                          ; Don't permanently smash `message'
        (progn (fset 'message (symbol-function 'gawd-snuff-message-function))
                ad-do-it)
        (fset 'message old-message-function))))

(defadvice type-break-keystroke-warning (around nix-type-break-keystroke-warning-snuff-logging last activate)
  "Block logging of the `Type break due in {blah} keystrokes' messages.
The messages are still displayed."
  (let ((old-message-function (symbol-function 'message))
        (log-message-ignore-regexps (append log-message-ignore-regexps
                                            '("Warning: typing break due in [0-9]* keystrokes\\.\\'"))))
       (unwind-protect                          ; Don't permanently smash `message'
        (progn (fset 'message (symbol-function 'gawd-snuff-message-function))
                ad-do-it)
        (fset 'message old-message-function))))

(setq type-break-demo-functions '(type-break-demo-boring
                                  type-break-demo-life))

;; Transform the verbose contents of the `type-break-warning-countdown-string-type'
;; into something less obnoxious.

(defvar nix-type-break-warning-countdown-string-type nil
  "Indicates the unit type of `type-break-warning-countdown-string'.
It will be either \"s\" or \"#k\".")

(defadvice type-break-time-warning-schedule (after nix-type-break-time-warning-schedule-typefix activate)
  "Keep the `nix-type-break-warning-countdown-string-type' up to date."
  (setq nix-type-break-warning-countdown-string-type
        (if (equal type-break-warning-countdown-string-type "seconds")
            "s"
          "#k")))

(defadvice type-break-check-keystroke-warning (after nix-type-break-check-keystroke-warning-typefix activate)
  "Keep the `nix-type-break-warning-countdown-string-type' up to date."
  (setq nix-type-break-warning-countdown-string-type
        (if (equal type-break-warning-countdown-string-type "seconds")
            "s"
          "#k")))

(setq type-break-mode-line-warning
      `(type-break-mode-line-break-message-p
        ("")
        (type-break-warning-countdown-string
         ("["
          type-break-warning-countdown-string
          nix-type-break-warning-countdown-string-type
          "] "))))

; Tweak the modeline.

(define-modeline-control "type-break" 'type-break-mode-line-string
  "Modeline control warning about typing breaks."
  nil "button3 begins a typing break.")

(define-key modeline-type-break-map (kbd "<button3>") 'type-break)

(setq modeline-format (splice-equal (cons modeline-buffer-id-extent 'modeline-buffer-id)
                                    (cons modeline-type-break-extent 'modeline-type-break)
                                    modeline-format))

(define-modeline-control "winring" '(" {" winring-name "} ")
  "Modeline control giving the name of the current window in the ring."
  'modeline-mousable "button1 circulates backwards in the window ring, button3 forwards")

(define-key modeline-winring-map (kbd "<button1>") 'winring-prev-configuration)
(define-key modeline-winring-map (kbd "<button3>") 'winring-next-configuration)

; Talk in the mode line now. (Also reschedule the typing break, to force the
; messages on.)

(setq type-break-mode-line-message-mode t)
(type-break-schedule)

;; Activate some modes that need that sort of thing

(balloon-help-mode)                             ; Tooltips!
(miniedit-install)
(winring-initialize                             ; Initialize the winring
 #'(lambda ()
     (setq modeline-format (splice-equal (cons modeline-buffer-id-extent 'modeline-buffer-id)
                                         (list 'winring-show-names (cons modeline-winring-extent 'modeline-winring))
                                         modeline-format))))

;; Add more keys to the keybinding alist.
;; As they are all in the alt, super, or hyper namespace, or bound to keys unique to this
;; keyboard, they are guaranteed not to clash with anyone else's keys.
;; (Except, of course, for C-x C-c... and M-z. And any other keys whose bindings I dislike.)

(setq gawd-key-bind-alist
      (nconc gawd-key-bind-alist
             `((,(current-global-map)
                ("A-r" . 'rename-buffer)
                ("A-j" . 'jump-to-register)
                ("A-g" . 'fume-prompt-function-goto)
                ("A-C-l" . 'fume-list-functions)
                ("A-k" . 'kill-entire-line)
                ("s-k" . 'kill-buffer-and-window)
                ("s-H-A-x" . 'save-buffers-kill-emacs)
                ("S-A-left" . 'winring-next-configuration)
                ("S-A-right" . 'winring-prev-configuration)
                ("A-m p" . 'emms-start)
                ("A-m s" . 'emms-stop)
                ("A-m >" . 'emms-next)
                ("A-m <" . 'emms-previous)
                ("A-m <right>" . 'emms-seek-forward)
                ("A-m <left>" . 'emms-seek-backward)
                ("A-m SPC" . 'emms-pause)
                ("A-m A-SPC" . 'emms-pause)
                ("A-m TAB" . 'emms-smart-browse)
                ("A-m m" . 'emms-show)
                ("A-m A-m" . 'emms-show)
                ("A-m r" . 'emms-toggle-repeat-playlist)
                ("A-m A-r" . 'emms-toggle-repeat-track)
                ("A-m b <right>" . 'emms-bookmarks-next)
                ("A-m b <left>" . 'emms-bookmarks-prev)
                ("A-m b SPC" . 'emms-bookmarks-add)
                ("A-m b <del>" . 'emms-bookmarks-clear)
                ("A-m <f11>" . 'emms-volume-mode-raise)
                ("A-m <f2>" . 'emms-volume-mode-lower)
                ("A-m d" . 'emms-play-directory)
                ("A-m D" . 'emms-play-directory-tree)
                ("S-left" . 'backward-word)
                ("S-right" . 'forward-word)
                ("S-BS" . 'backward-kill-word)
                ("S-<del>" . 'backward-or-forward-kill-word)
                ("<scroll-lock>" . 'ignore)     ; This key is a WM-control state lock key
                ("H-<scroll-lock>" . 'ignore)   ; This key is a WM-control state lock key
                ("C-x C-c" . nil)               ; This key is entirely too easy to hit by mistake.
                ("C-z" . nil)                   ; Likewise.
                ("C-z ." . 'vi-dot)             ; . . . along, merrily down the stream...
                ("A-c" . 'compose-map)          ; International characters, please
                ("A-u" . 'redo)                 ; We'd like a redo...
                ("A-/" . 'redo)                 ; ... on all the keys undo is on
                ("A-_" . 'redo)
                ("M-z" . 'zap-up-to-char)       ; This is actually *useful*, unlike `zap-to-char'...
                ("A-z" . 'zap-to-char)))))      ; ... but leave `zap-to-char' accessible.

;; Set up some useful variables.

(setq track-eol t                               ; Track ends of lines
      backup-by-copying-when-linked nil         ; I need link-snapping semantics for patching
      backup-by-copying-when-mismatch nil       ; Don't care about ownership
      mail-extr-ignore-single-names nil         ; Urgh. Not a chance.
      use-dialog-box nil                        ; Again, urgh.
      gc-cons-threshold 40000000                ; The tail causes massive conses and discards; up the threshold to stop thrashing
      vc-initial-comment t                      ; I want to change the first log entry in a newly registered file
      vc-diff-switches "-u"                     ; Just Say No to Context Diffs
      signal-error-on-buffer-boundary nil       ; Again, urgh.
      toolbar-visible-p nil                     ; Likewise.
      igrep-verbose-prompts 'semi               ; Don't be so chatty
      mark-ring-max 64                          ; A bigger mark ring than I'll need
      global-mark-ring-max 64                   ; Likewise the global mark ring
      log-message-ignore-regexps '("\\`\\'")    ; We can't get beginning and end of buffer msgs anymore
      desktop-files-not-to-save "^$"            ; Specifically, *do* remember remote filenames
      guided-tour-insinuate-menubar nil         ; I know how XEmacs works, I don't need a tour
      winring-show-names t)                     ; I want to show the name of the active window-cfg in the modeline.a

(if (featurep 'xemacs)
    (setq zmacs-regions nil)                    ; Too gaudy and too restrictive; this is not Windows.
  (setq transient-mark-mode nil                 ; Too gaudy and too restrictive; this is not Windows.
        shift-select-mode nil                   ; This seriously collies with my keybindings
        mouse-autoselect-window nil))           ; Focus follows mouse is too aggravating: keyboard only plz

(if (featurep 'xemacs)
    (setq auto-gc-threshold (/ gc-cons-threshold 3)) ; Reset the automatic idle GC counter
  (setq undo-limit 500000                       ; Keep up to half a meg of undo info...
        undo-strong-limit 1200000))             ; ... and never exceed 1.2Mb

;; Customize settings. I hate customize, but sometimes it is useful for quick hacks.

(setq custom-file "~/.xemacs/.customized"       ; Customized stuff goes in here
      custom-unlispify-menu-entries nil         ; I like seeing lisp as lisp
      custom-unlispify-tag-names nil
      custom-variable-default-form 'edit
      custom-novice nil)                        ; I am not a novice

;; We must now load the desktop, as the hook setup above must be done before the
;; desktop loads (in order that the files loaded when the desktop loads acquire
;; the right modes &c.) Indeed, pretty much *all* hook setup must be done before
;; this point.

;; We hide away a hooks whose value we want to preserve past the read.

(let ((term-setup-hook))
  (desktop-read))

(load custom-file)                              ; Handle any interactive customizations that we may have done