;: -*- emacs-lisp -*-
;:* $Id: misc-sy.el,v 1.1 2003-10-18 01:07:16+10 steve Exp steve $
;:* 
;:*=======================
;:* Why type 'y e s RET' or 'n o RET' when 'y' or 'n' will do.
(fset 'yes-or-no-p 'y-or-n-p)

;:*=======================
;: Enable the command `narrow-to-region' ("C-x n n")
(setq narrow-to-region t)
(put 'narrow-to-region 'disabled nil)

;:*=======================
;:* Enable `erase-buffer'
(put 'erase-buffer 'disabled nil)

;:*=======================
;:* Put the mouse selection in the kill buffer
;: Jan Vroonhof <vroonhof@frege.math.ethz.ch>
(defun mouse-track-drag-copy-to-kill (event count)
  "Copy the dragged region to the kill ring"
  (let ((region (default-mouse-track-return-dragged-selection event)))
    (when region
      (copy-region-as-kill (car region)
                           (cdr region)))
    nil))
(add-hook 'mouse-track-drag-up-hook 'mouse-track-drag-copy-to-kill)

;:*=======================
;:* Remove or convert trailing ctl-M
;; FIXME: This is really bogus --- rewrite it!!
;; (add-hook 'find-file-hooks 'remove-or-convert-trailing-ctl-M)
;; (defun remove-or-convert-trailing-ctl-M ()
;;   "Propose to remove or convert trailing ^M from a file."
;;   (interactive)
;;   (save-excursion
;;     (goto-char (point-min))
;;     (if (search-forward "\^M" nil t)
;;              : a ^M is found
;;         (if (or (= (preceding-char) ?\^J)
;;                 (= (following-char) ?\^J))
;;              : Must find a way to display the buffer before this question
;;             (if (y-or-n-p "Remove trailing ^M ? ")
;;                 (progn (goto-char (point-min))
;;                        (perform-replace "\^M" "" nil nil nil)
;;                        (pop-mark))
;;               (message "No transformation."))
;;           (if (y-or-n-p "Convert ^M into ^J ? ")
;;               (progn (goto-char (point-min))
;;                      (perform-replace "\^M" "\^J" nil nil nil)
;;                      (pop-mark))
;;             (message "No transformation."))))))

;:*======================= 
;:* Avoid deactivation of region when buffer end or beginning is reached
;:* XEmacs mailing list ; schrod @ iti.informatik.th-darmstadt.de
(defadvice line-move (around catch-buffer-border-error activate)
  "Catch errors `beginning-of-buffer' or `end-of-buffer' to avoid
   deactivation of region"
  (condition-case ()
      ad-do-it
    ((beginning-of-buffer end-of-buffer) (ding nil 'buffer-bound))))

;:*======================= 
;:* manual follows xref instead of opening a new buffer
;: Glynn Clements <glynn@sensei.co.uk>
(defun Manual-follow-xref (&optional name-or-event)
  "Invoke `manual-entry' on the cross-reference under the mouse.
When invoked noninteractively, the arg may be an xref string to parse
instead."
  (interactive "e")
  (if (eventp name-or-event)
      (let* ((p (event-point name-or-event))
             (extent (and p (extent-at p
                             (event-buffer name-or-event)
                             'highlight)))
             (data (and extent (extent-property extent 'man))))
        (if (eq (car-safe data) 'Manual-follow-xref)
            (eval data)
          (error "no manual cross-reference there.")))
    (let ((buff (current-buffer)))
      (or (and (manual-entry name-or-event)
               (or (eq (current-buffer) buff)
                   (kill-buffer buff)))
          ;: If that didn't work, maybe it's in a different section than the
          ;: man page writer expected.  For example, man pages tend assume
          ;: that all user programs are in section 1, but X tends to generate
          ;: makefiles that put things in section "n" instead...
          (and (string-match "[ \t]*([^)]+)\\'" name-or-event)
               (progn
                 (message "No entries found for %s; checking other sections..."
                          name-or-event)
                 (and (manual-entry
                       (substring name-or-event 0 (match-beginning 0)) nil t)
                      (or (eq (current-buffer) buff)
                          (kill-buffer buff)))))))))

;:*======================= 
;:* Frame title.
(setq frame-title-format
      (concat (construct-emacs-version-name)
              (if (featurep 'mule)
                  " (Mule) ["
                " (non-Mule) [")
              xemacs-codename "] %b"))

;:*=======================
;:* Additions to the menubar.
(when (featurep 'menubar)
  (require 'big-menubar)
  (add-menu-button nil ["Fr%_ame" make-frame t] "Help"))

;:*=======================
;:* create a Kill-Ring menu
(when (featurep 'menubar)
  (defvar str)
  (defvar yank-menu-length 40
    "*Maximum length of an item in the menu for select-and-yank.")
  (defun select-and-yank-filter (menu)
    (let* ((count 0))
      (append menu
              (mapcar
               #'(lambda (str)
                   (if (> (length str) yank-menu-length)
                       (setq str (substring str 0 yank-menu-length)))
                   (prog1
                       (vector
                        str
                        (list
                         'progn
                         '(push-mark (point))
                         (list 'insert (list 'current-kill count t)))
                        t)
                     (setq count (1+ count))))
               kill-ring))))
  (add-submenu nil '("Kill-Ring"
                     :included kill-ring
                     :filter select-and-yank-filter)))

;:*=======================
;: resize-minibuffer-mode makes the minibuffer automatically
;: resize as necessary when it's too big to hold its contents.
(autoload 'resize-minibuffer-mode "rsz-minibuf" nil t)
(resize-minibuffer-mode)
(setq resize-minibuffer-window-exactly nil)
(setq minibuffer-max-depth nil)

;:*=======================
;:* don't invert colors when grabbing a password
;:  (because sometimes it screws up and leaves the frame 
;:  with dorked up colors).
(setq passwd-invert-frame-when-keyboard-grabbed nil)

;:*========================
;:* VI-style matching parenthesis
;:  From Eric Hendrickson edh @ med.umn.edu
(defun match-paren (arg)
  "Go to the matching parenthesis if on parenthesis otherwise insert %."
  (interactive "p")
  (cond ((looking-at "[([{]") (forward-sexp 1) (backward-char))
        ((looking-at "[])}]") (forward-char) (backward-sexp 1))))
(global-set-key '(control f1) 'match-paren)

;:*=======================
;:* Inserting elisp Comments
; by Jonas Luster <mailto:jonas @ nethammer.qad.org>
(defun elispcomment ()
;:*=======================
  (interactive)
  (insert ";:*=======================\n")
  (insert ";:* " (setq str (read-input "Comment: ")) "\n")
  (insert "\n"))
(global-set-key '(control f3) 'elispcomment)

;:*=======================
;:* Time-Stamp
(require 'time-stamp)
(add-hook 'write-file-hooks 'time-stamp)
(set 'time-stamp-active t)
(set 'time-stamp-format "%a %3b %2d, %4y %02H:%02M:%02S %u")

;:*=======================
;:* Dired enhancement. Pack and Unpack tarballs
(require 'dired-tar)

;:*=======================
;:* Image formats
(require 'image-mode)

;:*=======================
;:* Change some modeline indicators
(setq pending-delete-modeline-string " PD")
(setq filladapt-mode-line-string "")
(add-minor-mode 'abbrev-mode " Ab")
; (mouse-avoidance-mode 'animate)
; (add-minor-mode 'mouse-avoidance-mode " Av")

(defun sy-lisp-interaction-indicator ()
  (setq mode-name "LI"))

(add-hook 'lisp-interaction-mode-hook 'sy-lisp-interaction-indicator)

;:*=======================
;:* Evil hack to replace the src dir with the install dir in load-history.
(when (equal (invocation-directory) "/usr/local/bin/")
  (dolist (entry load-history)
    (when (string-match "/usr/local/src/xemacs/" (car entry))
      (setcar entry
              (replace-match
               (concat "/usr/local/lib/xemacs-" emacs-program-version "/")
               t t (car entry))))))

;:*=======================
;:* Force efs into passive ftp because of my firewall
(setq efs-use-passive-mode t)

;:*=======================
;:* ibuffer - replacement for buffer-menu
(require 'ibuffer)
(setq 
 ibuffer-expert t
 ibuffer-default-sorting-mode 'major-mode
 ibuffer-fontification-level t
 ibuffer-saved-filter-groups 
 '(("My-ibuffer-grps"
    ("ChangeLog"
     (mode . change-log-mode))
    ("Dired"
     (mode . dired-mode))
    ("Documentation"
     (or
      (mode . help-mode)
      (mode . hyper-apropos-help-mode)
      (mode . hyper-apropos-mode)
      (mode . Info-mode)
      (mode . Manual-mode)))
    ("Eicq"
     (or
      (mode . eicq-buddy-mode)
      (mode . eicq-log-mode)
      (mode . eicq-network-mode)
      (mode . world-mode)))
    ("Fundamental"
     (mode . fundamental-mode))
    ("Gnus"
     (or
      (mode . message-mode)
      (mode . mail-mode)
      (mode . gnus-group-mode)
      (mode . gnus-summary-mode) 
      (mode . gnus-article-mode)))
    ("Programming"
     (or
      (mode . emacs-lisp-mode)
      (mode . cperl-mode)
      (mode . c-mode)
      (mode . c++-mode)
      (mode . java-mode) 
      (mode . idl-mode)
      (mode . lisp-mode))))))
(add-hook 'ibuffer-mode-hooks 
          '(lambda () 
             (ibuffer-switch-to-saved-filter-groups "My-ibuffer-grps")
             (ibuffer-add-to-tmp-hide "\\*scratch\\*")))

;:*=======================
;:* Sawfish mode
(autoload 'sawfish-mode "sawfish" "sawfish-mode" t)

;:*=======================
;:* from.el - check whose sent us mail
(require 'from)
(setq 
 from-mailspools
 '("~/mail/INBOX")
 from-use-other-window nil
 from-quit-command 'kill-buffer
 from-highlight-regexp "eicq\\|pa\\(ckages?\\|tch\\)\\|core-commit\\|mh-e")

;:*=======================
;:* PS-Print
(require 'ps-print)
(require 'ps-mule)
(require 'ps-bdf)
(require 'lpr)
(setq 
 bdf-directory-list
 '("/usr/X11R6/lib/X11/fonts/ucs"
   "/usr/X11R6/lib/X11/fonts/bitmap")
 ps-multibyte-buffer 'bdf-font-except-latin
 ps-paper-type 'a4
 printer-name "/dev/lp0"
 ps-printer-name ""
 ps-print-color-p nil)

;:*=======================
;:* mpg123... Whee! Play mp3's in XEmacs!
 (if (featurep 'mule)
     (progn
       (autoload 'mpg123 "mpg123" "A Front-end to mpg123" t)
       (setq mpg123-startup-volume 100)
       (mpg123:set-volume '(100 . 100))))

;:*=======================
;:* Line and Column numbers.
;;
;; XEamcsen prior to 21.5.6 default both `line-number-mode' and
;; `column-number-mode' to off, whereas XEmacs >= 21.5.6 default
;; both to on.  I like line-number but not column number, hence this
;; test.
(if (emacs-version>= 21 5 6)
    (column-number-mode nil)
  (line-number-mode 1))

;:*=======================
;:* Setting initial default-directory.
(setq default-directory (file-name-as-directory (getenv "HOME")))

;:*=======================
;:* Emacs Lisp List
(require 'ell)
(setq ell-host "www.anc.ed.ac.uk"
      ell-path "~stephen/emacs/ell.html"
;      ell-proxy-host "eicq.dnsalias.org"
;      ell-proxy-port 3128
      ell-goto-addr t
      ell-locate nil)

;:*=======================
;:* Sane ChangeLogs
(if (featurep 'mule)
    (add-to-list 'file-coding-system-alist '("ChangeLog" . binary)))

;:*=======================
;:* Directory Abbrevs
(setq directory-abbrev-alist
      `(("^/instcore" . ,(concat (car emacs-roots)
                                "lib/xemacs-"
                                emacs-program-version))
        ("^/instpkg" . ,(concat (car emacs-roots)
                                "lib/xemacs"))
        ("^/XEmacs" . "~/programming/XEmacs")
        ("^/corecvs" . "~/programming/XEmacs/xemacs-21.5")
        ("^/corebld" . "~/test-it/XEmacs-21.5")
        ("^/prog" . "~/programming")
        ("^/pkgcvs" . "~/programming/XEmacs/packages")
        ("^/pkgbld" . "~/test-it/build/packages")
        ("^/staging" . "~/test-it/xemacs-packages")
        ("^/linux" . "/usr/src/linux")
        ("^/src" . "/usr/local/src")))

;:*=======================
;:* Latin-Unity (coding-system)
;;
;; XEmacsen <= 21.1.14 barf on this (missing a built-in 'copy-case-table')
;; so don't load unless we're using a Mule-enabled XEmacs >= 21.1.15.
(if (and (featurep 'mule)
         (emacs-version>= 21 1 15))
    (progn
      (latin-unity-install)
      (add-to-list 'latin-unity-preapproved-coding-system-list 'iso-8859-1)))

;:*=======================
;:* The beginnings of procmail-mode.el.
;;
;; I can't remember who I stole this from, but if it was you, please
;; let me know so I can give you the credit you deserve.
(defvar procmail-font-lock-keywords)

(define-derived-mode procmail-mode fundamental-mode "Procmail"
  "Major mode for editing procmail recipes."

  (setq comment-start "#")
  (setq comment-start-skip "#[ \t]*")

  ;;register keywords
  (setq procmail-font-lock-keywords
        (list '("#.*"
                . font-lock-comment-face)
              '("^[\t ]*:.*"
                . font-lock-type-face)
              '("[A-Za-z_]+=.*"
                . font-lock-keyword-face)
              '("^[\t ]*\\*.*"
                . font-lock-doc-string-face)
              '("\$[A-Za-z0-9_]+"
                . font-lock-function-name-face)))
  (font-lock-mode))

(add-to-list 'auto-mode-alist '("\\.procmailrc$" . procmail-mode))

;; And because my ~/.procmailrc has lots of high ASCII to defeat
;; Chinese SPAM I set its coding to binary.
(if (featurep 'mule)
    (add-to-list 'file-coding-system-alist '("\\.procmailrc$" . binary)))

;:*=======================
;:* Work around coding system bug in 21.5
;;
;; For reasons that are beyond me sometimes 21.5 is prepending a
;; "UTF-8 signature" to some files.  I'm still not really sure what
;; that means, but it does cause havoc for me.  This rearranges the
;; `coding-priority-list' if we're in 21.5.
(if (and (featurep 'mule)
         (emacs-version>= 21 5 0))
    (set-coding-priority-list '(iso-8-1 
                                iso-8-2 
                                iso-7 
                                no-conversion 
                                iso-8-designate 
                                iso-lock-shift 
                                shift-jis 
                                big5 
                                utf-16-little-endian-bom 
                                utf-16-bom 
                                utf-16-little-endian 
                                utf-16 
                                ucs-4
                                utf-8-bom 
                                utf-8)))

;:*=======================
;:* Build Reports
(setq
 build-report-destination 
 '("XEmacs Builds <xemacs-buildreports@xemacs.org>" 
   "XEmacs Beta <xemacs-beta@xemacs.org>")
 build-report-installation-insert-all t
 build-report-make-output-files '("beta.err"
                                  "xemacs-make-all.err" 
                                  "xemacs-make-check.err" 
                                  "xemacs-make-install.err")
 build-report-prompts '(("Status?: "
                         ("Success" 
                          "Failure" 
                          "OK (with issues)"))))

;:*=======================
;:* Set the frame geometry
(setq initial-frame-plist '(top 30 left 10 width 98 height 41)
      default-frame-plist '(top 30 left 10 width 98 height 41))

;:*=======================
;:* The Beginnings of a Finance package
(require 'emoney)
(setq emoney-date-format "%Y-%m-%d")

;:*=======================
;:* Modeline enhancements.
;;
;; Reorganise the modeline so that the line and column numbers are on
;; the left where you can see them.  Also add a bit of colour to the
;; left and right ID extents so they stand out.
(when (< emacs-minor-version 5)
  (setq-default modeline-buffer-identification
                (list (cons modeline-buffer-id-left-extent
                            (cons 10 (list
                                      (list 'line-number-mode "L%l ")
                                      (list 'column-number-mode "C%c ")
                                      (list (cons -3 (list "%p")))
                                      ":")))
                      (cons modeline-buffer-id-right-extent "%17b")))

  (setq-default
   modeline-format
   (list
    ""
    (if (boundp 'modeline-multibyte-status)
        'modeline-multibyte-status
      "")
    (cons modeline-modified-extent 'modeline-modified)
    (cons modeline-buffer-id-extent 'modeline-buffer-identification)
    " "
    'global-mode-string
    " %[("
    (cons modeline-minor-mode-extent
          (list "" 'mode-name 'minor-mode-alist))
    (cons modeline-narrowed-extent "%n")
    'modeline-process
    ")%]----"
    "-%-"))

  (set-extent-face modeline-buffer-id-left-extent 'font-lock-warning-face)
  (set-extent-face modeline-buffer-id-right-extent 'font-lock-comment-face))

;:*=======================
;:* Enable funky completion.
;;
;; This allows you to do things like type "M-x b-c-f RET" and it will
;; expand to `byte-compile-file'.
(require 'completer)

;:*=======================
;:* Misc Stuff that I haven't yet put anywhere permanent
(add-to-list 'Info-directory-list '"/usr/share/texmf/info")
;; I have some docs in '/usr/info' that are newer than the same docs in
;; the XEmacs directories, reversing the list makes XEmacs look in
;; '/usr/info' _before_ '/usr/local/lib/xemacs-<version>/info'.
(setq Info-directory-list (nreverse Info-directory-list))
(setq
 abbrev-mode t
 browse-url-browser-function 'browse-url-mozilla
 browse-url-new-window-flag t
 browse-url-mozilla-new-window-is-tab t
 browse-url-netscape-version 6
 browse-url-save-file t
 browse-url-xterm-program "xterm"
 complex-buffers-menu-p t
 etalk-process-file "talk"
 find-function-source-path nil
 font-menu-ignore-scaled-fonts nil
 lookup-syntax-properties nil
 mail-user-agent 'message-user-agent
 modeline-scrolling-method 'scrollbar
 report-xemacs-bug-no-explanations t
 scroll-step 1)

(quietly-read-abbrev-file)
(add-hook 'browse-url-of-file-hook '(browse-url-netscape-reload nil))
(add-hook 'text-mode-hook 'turn-on-auto-fill)
(customize-set-variable 'gutter-buffers-tab-visible-p nil)
(customize-set-variable 'user-mail-address "sryoungs@bigpond.net.au")
(setq query-user-mail-address nil)
(blink-cursor-mode 1)
(when (featurep 'mule)
  (set-language-environment "English"))
;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::*
(message "miscellaneous initialised")

Copyright © 2003 Steve Youngs
Verbatim copying and distribution is permitted in any medium, providing this notice is preserved.
Last modified: Sat Oct 18 02:13:37 EST 2003