;; patfunc.el -- Copyright (C) 1998 Pat Thoyts <pat@calubc.caladan.co.uk>
;;
;; Emacs lisp functions to be loaded from my .emacs file.
;;
;; This file is for useful functions and variables which would do well
;; to byte compiled for faster loading from .emacs. If it's a function that
;; is likely to change often or configuration type of information then
;; leave it in .emacs
;;
;; To use this just include (require 'patfunc) in your .emacs file _or_
;; if you want to do stuff only if this package is available try:
;;
;; (condition-case () (require 'patfunc)   (error nil))
;; (cond
;;  ((symbolp 'patfunc-rcs-version)
;;   (message "Call things that depend on this package."))
;;  (t
;;   (message "You didn't load patfunc so skip those bits.")))

(defconst patfunc-rcs-version
  "@(#)$Id: patfunc.el,v 1.10 2000/11/19 18:29:23 pat Exp $"
  "RCS version info for `patfunc' package.")

(defconst patfunc-version-number
  (let ((version "$Revision: 1.10 $"))
    (if (string-match "[0-9.]+" version)
	(substring version (match-beginning 0) (match-end 0))
      "0.0"))
  "Version number of the `patfunc' package.")

;;
;; Fix up a function to insert my copyright message.
;; Using copyright-whoami means we can use `update-copyright' on files too.
;;
;; this was a defconst.
(defun copyright-whoami ()
  "The author string used in `pat-insert-copyright-message'. The function
will prepend Copyright (C) and the year and then insert this string.
This constant gets used for `update-copyright' as well."
  (concat (user-full-name) " <" user-mail-address ">"))

(defun pat-copyright-message ()
  "Return my copyright message using the author information provided
in `copyright-whoami'."
  (message "Copyright (C) %s %s"
	   (format-time-string "%Y" (current-time))
	   (copyright-whoami)))

(defun pat-insert-copyright-message ()
  "Inserts a one-line copyright message using the author information
provided in `copyright-whoami'. Bound to \\[pat-insert-copyright-message]"
  (interactive)
  (insert (pat-copyright-message)))

(defun pat-scfl-copyright-message ()
  "Return my copyright message for Sanderson CFL using the author
information provided in `copyright-whoami'."
  (message "Written by %s, Copyright (C) %s Sanderson CFL"
	   (user-full-name)
	   (format-time-string "%Y" (current-time))))

(defun pat-renishaw-copyright-message ()
  "Return my copyright message for Renishaw plc using the author
information provided in `copyright-whoami'."
  (message "Written by %s, Copyright (C) %s Renishaw plc"
	   (user-full-name)
	   (format-time-string "%Y" (current-time))))

(defun pat-insert-work-copyright-message ()
  "Inserts a one-line copyright message for work files.
Currently taken from `pat-renishaw-copyright-message'. Bound to \\[pat-insert-work-copyright-message]"
  (interactive)
  (insert (pat-renishaw-copyright-message)))

(defconst gpl-statement 
"  This is free software; you can redistribute it and/or modify it under
  the terms of the GNU General Public License as published by the Free
  Software Foundation; either version 2, or (at your option) any later
  version.

  This program  is distributed in the hope that it will be useful, but
  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  for more details.

  You should have received a copy of the GNU General Public License along
  with this program; see the file `Copying'.  If not, write to the Free 
  Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
"
"The text for the GPL statement to be included in programs distributed
under the GNU General Public Licence." )

(defun pat-insert-gpl-message ()
  "Inserts a multi-line GPL copyright message using the author information
provided in `copyright-whoami' and the Copyright message from 
`gpl-statement'. Bound to \\[pat-insert-gpl-message]"
  (interactive)
  (insert (message "\n  %s\n\n%s\n"
		   (pat-copyright-message)
		   gpl-statement)))

(defsubst pat-insert-html-header ()
  "Insert my favourite HTML topline. Bound to \\[pat-insert-html-header]"
  (interactive)
  (insert "<!doctype HTML public \"-//W3O//DTD W3 HTML 2.0//EN\">"))

(defun pat-chop-ends ()
  "Chop off all the whitespace at the end of the lines for a region.
Bound to \\[pat-chop-ends]"
  (interactive)
  (if (not (mark))
      nil
    (save-excursion
      (save-restriction
        (if (> (mark) (point))
            (narrow-to-region (point) (mark))
          (narrow-to-region (mark) (point)))
        (goto-char (point-min))
        (while (and (not (eobp))
                    (re-search-forward "[ 	]+$" (point-max) t))
          (replace-match ""))))))

(defsubst pat-insert-date ()
  "Insert the current date and time. eg: Wed Jul 29 13:51:13 1998.
Bound to \\[pat-insert-date]"
  (interactive)
  (insert (current-time-string)))

(defun pat-insert-buffer-tag (tag &optional end)
  "Insert an emacs local variable segment at the end of the buffer provided
there isn't one there already.
TAG is the string to insert.
END is a regexp to match the end of the section, used for instance for
html where END might be \"<!--[ \\t]*End:[ \\t]*\\(-->[ \\t]*\\)?$\""
  (goto-char (point-max))
  (cond
   ((not tag)
    (error "No tag provided for insertion"))
   ((not end)
    (setq end "End:[ \t]*$")))

  (if (not (save-excursion
             (re-search-backward end
                                 (save-excursion 
                                   (beginning-of-line -5) (point))
                                 t)))
      (insert tag)))

(defun pat-insert-unibasic-tag ()
  "Insert emacs notification at the end of the buffer to set the file to
unibasic mode whenever it is loaded.
Bound to \\[pat-insert-unibasic-tag]"
  (interactive)
  (pat-insert-buffer-tag
   "\n*\n* Local variables:\n* mode: unibasic\n* End:\n"))

(defun pat-insert-tcl-tag ()
  "Insert emacs notification at the end of the buffer to set the file to
tcl-mode whenever it is loaded.
Bound to \\[pat-insert-tcl-tag]"
  (interactive)
  (pat-insert-buffer-tag
   "\n#\n# Local variables:\n# mode: tcl\n# End:\n"))

(defun pat-truncate-lines ()
  "Toggle the `truncate-lines' variable in the current buffer.
Bound to \\[pat-truncate-lines]"
  (interactive)
  (message "Set truncate-lines to: %s" (not truncate-lines))
  (setq truncate-lines (not truncate-lines)))

(defun pat-number-lines (regexp &optional count)
  "Number lines that match a regexp. Starting at COUNT.
Bound to \\[pat-number-lines]."
  (interactive "sEnter regexp for matching lines: ")
  (let ((cn 0)
        (val 0))
    (if count
        (setq val count))
  (beginning-of-line 2)
  (while (looking-at regexp)
    (insert (message "%s " (+ val cn)))
    (setq cn (+ cn 1))
    (beginning-of-line 2))))


(defun pat-set-isp (isp)
  "Set any variables for emacs that depend on our ISP connection.
Pick from ConnectFREE or FreeServe. bound to \\[pat-set-isp]"
  (interactive "sEnter ISP: ")
  (let ((r nil))
    (setq smtpmail-default-smtp-server "binky.scfl-bristol.co.uk")
    (cond
     ((string-match "^[Ll]" isp)
      (setq ISP 'lars)
      (setq gnus-select-method '(nntp "is.bbsrc.ac.uk"))
      (setq smtpmail-default-smtp-server "mail.lars.bbsrc.ac.uk")
      (setq url-proxy-services 
            '(("http"     . "wwwcache.bbsrc.ac.uk:8080")
              ("ftp"      . "wwwcache.bbsrc.ac.uk:8080")
              ("gopher"   . "wwwcache.bbsrc.ac.uk:8080")
              ("no_proxy" . "^.*\.bbsrc\.ac\.uk")))
      (setq mc-pgp-keyserver-address "wwwcache.bbsrc.ac.uk")
      (setq mc-pgp-keyserver-port 8080)
      (setq mc-pgp-keyserver-url-template
            "http://www.cl.cam.ac.uk/cgi-bin/pks-extract-key.pl?op=get&search=%s")
      (setq r t))
     ((string-match "^[Hh]" isp)
      (setq ISP 'home)
      (setq gnus-select-method 'nil)
      (setq smtpmail-default-smtp-server "mail.home.net")
      (setq r t))
     ((string-match "^[Cc]" isp)
      (setq ISP 'connectfree)
      (setq gnus-select-method '(nntp "news.connectfree.co.uk"))
;      (setq smtpmail-default-smtp-server "mail.telinco.net")
      (setq r t))
     ((string-match "^[Ff].*9" isp)
      (setq ISP 'force9)
      (setq gnus-select-method '(nntp "news.f9.net.uk"))
      (setq r t))
     ((string-match "^[Ff]" isp)
      (setq ISP 'freeserve)
      (setq gnus-select-method '(nntp "news.freeserve.net"))
;      (setq smtpmail-default-smtp-server "smtp.freeserve.net")
      (setq r t))
     ((string-match "^[Jj]" isp)
      (setq ISP 'jungle)
      (setq gnus-select-method '(nntp "news.junglelink.net"))
;      (setq smtpmail-default-smtp-server "smtp.junglelink.net")
      (setq r t))
     (t
      (message "ISP (%s) must be one of ConnectFREE or FreeServe" isp)))
    (if (eq r nil)
        nil
      (message "ISP changed to %s." ISP))))

(defconst pat-home-page "http://www.zsplat.freeserve.co.uk/"
  "The URL of my home page for use in `pat-news-address-hook'.")

(defconst pat-news-signature
  "Pat Thoyts          To reply, rot13 the Return address, or don't.
PGP fingerprint 2C 6E 98 07 2C 59 C8 97  10 CE 11 E6 04 E0 B9 DD"
  "My news posting signature string.")

(defconst pat-x-face
  " .`d#euqz@6H{\";Ysmx2IVe_7M3vA+2w1X[QLk?ZO&QRauXQL{*L'$3getx}9+zK.-KWDx3.
 qrlR)76MFb`6bgoGvLpLtcQKB=X~;*<JKLtwLBM(IA'?rVjs1*tq\\VHn?WMNsB,3XXWF@5.)4SRFa+
 '?a?.s#@hl7CiTo'F\"O!fvbL0"
  "My X-Face: picture for inclusion in GNUS postings.
This only gets pretty if the recipient can support X-Face. XEmacs can if
compiled right. To use this I have a `pat-news-address-hook' which does
  (add-to-list 'message-required-news-headers '(X-Face . pat-x-face))")

(defun pat-news-address-hook ()
  "Fix the From: line for use in usenet postings to use a fake return address.
It _should_ be generated from `user-full-name' and `user-mail-address',
but isn't.
This is a BadThing(tm) but cuts out some of the spam."
  (interactive)
  (setq message-from-style "angles")
  (add-to-list 'message-required-news-headers (cons 'X-Face pat-x-face))
  (add-to-list 'message-required-news-headers (cons 'X-Url pat-home-page))
  (add-to-list 'message-required-news-headers (cons 'X-Web pat-home-page))
  (add-to-list 'message-required-news-headers
               (cons 'X-Home-Page pat-home-page))
  (local-set-key "\C-c\C-w" 
                 '(lambda () nil (interactive) (insert pat-news-signature)))
  (make-local-variable 'message-signature)
  (setq message-signature 'pat-news-signature) 
  (make-local-variable 'user-mail-address)
  (setq user-mail-address (pat-rot13-string user-mail-address)))

(defun pat-w32-select-font ()
  "Change the frame font in GNU win32 emacs."
  (interactive)
  (if (not (fboundp 'w32-select-font))
      (error "w32-select-font is not defined."))
  (let ((fontname (w32-select-font)))
    (if fontname
	(set-frame-font fontname))))

(defun whois (who)
  "Run the whois(1) command and capture the output in a new buffer."
  (interactive "sWho is: ")
  (let ((bn (concat "Who is: " who)))
    (get-buffer-create bn)
    (switch-to-buffer bn)  
    (erase-buffer)
    (start-process "whois" bn "whois" who)))

;; The C styles used for writing kernel source code.
(defun linux-c-mode ()
  "C mode with adjusted defaults for use with the Linux kernel source code."
  (interactive)
  (c-mode)
  (c-set-style "K&R")
  (setq c-basic-offset 8))
(add-to-list 'auto-mode-alist '("/usr/src/linux.*/.*\\.[ch]$" . linux-c-mode))

(defun pat-char-sub (string char repl)
  "Convert all instances of character CHAR in STRING to REPL-STRING-OR-CHAR."
  (let ((result "")
	(size (length string))
	(cn 0))
    (if (not (eq (type-of char) 'integer))
	(error "CHAR must be a character"))
    (if (not (char-or-string-p repl))
	(error "REPL-STRING must be a char or a string"))
    (while (< cn size)
      (setq result (concat result 
			   (let ((c (aref string cn)))
			     (if (char-equal char c)
				 (if (stringp repl)
				     repl
				   (char-to-string repl))
                               (char-to-string c)))))
      (setq cn (1+ cn)))
    result))

(defun pat-rot13-char ( char )
  "Perform a rot13 encoding for character CHAR."
  (let ((c (char-int char)))
    (cond ((or (and (>= c (char-int ?A)) (<= c (char-int ?M)))
               (and (>= c (char-int ?a)) (<= c (char-int ?m))) )
           (setq c (+ c 13)))
          ((or (and (>= c (char-int ?N)) (<= c (char-int ?Z)))
               (and (>= c (char-int ?n)) (<= c (char-int ?z))) )
           (setq c (- c 13)))
          (t c))))

(defun pat-rot13-string ( string )
  "Perform a rot13 encoding on a copy of STRING.
This is OK in FSF Emacs 20 and XEmacs 20 but needs testing on Emacs 19."
  (let ((counter 0)
        (result ""))
    (while (< counter (length string))
      (setq result
            (concat result 
                    (char-to-string
                     (pat-rot13-char (aref string counter)))))
      (setq counter (1+ counter)))
    result))

(defun pat-insert-rot13-string (string)
  "Encode a string using rot13 and insert into the buffer.
Bound to \\[pat-insert-rot13]"
  (interactive "sText: ")
  (insert (pat-rot13-string string)))

;; Next:
;; pat-rot13-region and pat-rot13-buffer, maybe pat-rot13-char ?

(defun pat-rcs-version (rcs-string)
  "Extract the version number from an RCS string.
If a no number is present then return the whole string."
  (interactive "sRCS String? ")
  (if (string-match "\\<[0-9]+[0-9\\.]+\\>" rcs-string)
      (substring rcs-string (match-beginning 0) (match-end 0))
    _emacs-version))

(defun pat-rcs-version-numbers (rcs-string)
  (let ((string (pat-rcs-version rcs-string))
	(start 0)
	(numbers nil)
	(substr nil))
    (while (string-match "\\<[0-9]+\\>"  string start)
      (setq start (match-end 0)
	    substr (substring string (match-beginning 0) start)
	    substr (string-to-number substr)
	    numbers (append numbers (list substr))))
    numbers))

(defun pat-rcs-major-version (rcs-string)
  "Return the major version number from an RCS ID string."
  (interactive "sRCS String? ")
  (car (pat-rcs-version-numbers rcs-string)))

(defun pat-rcs-minor-version (rcs-string &optional level)
  "Return the minor version number from an RCS ID string.
If level is given or a prefix number is used then this returns the level'th
minor version number. eg: for version \"1.2.3.4\" a level of 1 gives \"2\"
and level 2 gives \"3\""
  (interactive "sRCS String? \np")
  (if (not level) (setq level 1))
  (elt (pat-rcs-version-numbers rcs-string) level))

(defconst pat-win-template
"/* template.c
 * 
 */

const unsigned char *rcsid = 
\"@(#)$ Id$\";

#define STRICT
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <windowsx.h>
#include <stdlib.h>

LRESULT WINAPI WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp);
static HWND InitApplication(HINSTANCE inst, HINSTANCE prev, 
                            LPSTR app_name, int cmdshow);
void warn_me(const char* msg, ...);

int WINAPI
WinMain(HINSTANCE inst, HINSTANCE prev, LPSTR cmdline, int cmdshow)
{
  extern int __argc;
  extern char **__argv, **_environ;
  MSG msg;
  HANDLE accel_table;
  HWND hwnd;
  CHAR app_name[16] = \"template\";

  /*LoadString(hInstance, IDS_APPNAME, app_name, sizeof(app_name));*/

  hwnd = InitApplication(inst, prev, app_name, cmdshow);
  if (hwnd == NULL) {
    warn_me(\"The program failed to initialise.\");
    return FALSE;
  }

  accel_table = LoadAccelerators(inst, app_name);
  
  while( GetMessage(&msg, NULL, 0, 0)) {
    if (!IsDialogMessage(hwnd, &msg)) {
      if (!TranslateAccelerator (msg.hwnd, accel_table, &msg)) {
        TranslateMessage(&msg);
        DispatchMessage(&msg);
      }
    }
  }
  return msg.wParam;
}

static HWND
InitApplication(HINSTANCE inst, HINSTANCE prev, LPSTR app_name, int cmdshow)
{
  WNDCLASSEX wc;
  HWND       hwnd;
  CHAR       title[32] = \"Template Application\";

  /*LoadString(inst, IDS_DESCRIPTION, title, sizeof(title));*/

  if (!prev) {
    wc.cbSize        = sizeof(WNDCLASSEX);
    wc.style         = CS_HREDRAW | CS_VREDRAW;
    wc.lpfnWndProc   = (WNDPROC)WndProc;
    wc.cbClsExtra    = 0;
    wc.cbWndExtra    = 0;
    wc.hInstance     = inst;
/*  wc.hIconSm       = LoadImage(inst, MAKEINTRESOURCE(IDI_APPICON),
 *			       IMAGE_ICON, 16, 16, 0);
 *  wc.hIcon         = LoadIcon(inst, MAKEINTRESOURCE(IDI_APPICON));
 */
    wc.hIcon         = LoadIcon(NULL, IDI_APPLICATION);
    wc.hIconSm       = LoadIcon(NULL, IDI_APPLICATION);
    wc.hCursor       = LoadCursor(NULL, IDC_ARROW);
    wc.hbrBackground = CreateSolidBrush(GetSysColor(COLOR_WINDOW));
    wc.lpszMenuName  = app_name;
    wc.lpszClassName = app_name;

    if (!RegisterClassEx(&wc)) {
      warn_me(\"Failed to register the extended window class.\");
      if (!RegisterClass((LPWNDCLASS)&wc.style)) {
        warn_me(\"Failed to register the window class.\");
        return NULL;
      }
    }
  }
  hwnd = CreateWindow( app_name, title, WS_OVERLAPPEDWINDOW,
		       CW_USEDEFAULT, CW_USEDEFAULT,
		       CW_USEDEFAULT, CW_USEDEFAULT,
		       NULL, NULL, inst, NULL );
  /* or ... hwnd = CreateDialog(inst, app_name, 0, NULL); */

  if (!hwnd) {
     warn_me(\"Failed to create the main window.\");
     return NULL;
  }

  ShowWindow(hwnd, cmdshow);
  UpdateWindow(hwnd);
    
  return hwnd;
}

void
warn_me(const char* msg, ...)
{
  LPSTR err_buffer;
  va_list args;

  err_buffer = (LPSTR)LocalAlloc(LPTR, sizeof(CHAR)*2048);
  va_start(args, msg);
  wvsprintf(err_buffer, msg, args);
  va_end(args);
  MessageBox(NULL, err_buffer,(LPSTR)\"Warning\", MB_OK|MB_ICONWARNING);
  LocalFree((LOCALHANDLE)err_buffer);
}

/*
 * static BOOL Main_OnCreate(HWND hwnd, LPCREATESTRUCT cs);
 * static void Main_OnCommand(HWND hwnd, int id, HWND control, UINT notify);
 * static void Main_OnSize(HWND hwnd, UINT state, int cx, int cy);
 */
static void Main_SysColorChange(HWND hwnd);
static void Main_OnDestroy(HWND hwnd);

LRESULT WINAPI
WndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp)
{
  switch (msg) {
/*
 *  case WM_COMMAND:
 *    return HANDLE_WM_COMMAND(hwnd, wp, lp, Main_OnCommand);
 *  case WM_CREATE:
 *    return HANDLE_WM_CREATE(hwnd, wp, lp, Main_OnCreate);
 *  case WM_SIZE:
 *    return HANDLE_WM_SIZE(hwnd, wp, lp, Main_OnSize);
 */
  case WM_DESTROY:
    return HANDLE_WM_DESTROY(hwnd, wp, lp, Main_OnDestroy);
  case WM_SYSCOLORCHANGE:
    return HANDLE_WM_SYSCOLORCHANGE(hwnd, wp, lp, Main_SysColorChange);
  }
  return DefWindowProc (hwnd, msg, wp, lp);
}

static void
Main_SysColorChange(HWND hwnd)
{
  DeleteObject((HANDLE)GetClassLong(hwnd,GCL_HBRBACKGROUND));
  SetClassLong(hwnd, GCL_HBRBACKGROUND,
	       (LONG)CreateSolidBrush(GetSysColor(COLOR_WINDOW)));
  InvalidateRect(hwnd, NULL, TRUE);
}

static void
Main_OnDestroy(HWND hwnd)
{
  DeleteObject((HANDLE)GetClassLong(hwnd,GCL_HBRBACKGROUND));
  SetClassLong(hwnd,GCL_HBRBACKGROUND,(LONG)GetStockObject(WHITE_BRUSH));
  PostQuitMessage(0);
}

/*
 * Local variables:
 * indent-tabs-mode: nil
 * End:
 */
"
"Template for new windows C programs.")

(defun pat-insert-win-template ()
  "Inserts a template for a new Windoze C program.
The template is provided from `pat-win-template'
Bound to \\[pat-insert-win-template]"
  (interactive)
  (save-excursion
    (insert (message "%s" pat-win-template)))
  (forward-char 3))

;; You can send commands to wintegrate from win32 emacs using this.
;(win-comline "porky" "Enter \"ls\"")
;(win-comline "porky" "Enter 'echo hello'")
(defun pat-win-comline (session cmd)
  "A WIN.COMLINE equivalent for emacs lisp to talk to wintegrate.
This function uses DDE to send commands to wintegrate for execution.
The first argument is the session name and the second is the wintegrate
command to be sent. For example:
  (win-comline \"porky\" \"MessageBox Sessions(1,9)\")
"
  (interactive "sSession Name: \nsCommand: ")
  (if (string-equal session "")
      (error "You must provide a session name to win-comline"))
  (save-excursion
    (set-buffer (get-buffer-create " *ddeclient*"))
    (erase-buffer)
    (insert cmd)
    (call-process-region (point-min) (point-max)
			 "ddeclient" nil nil nil "winteg" session)))


(provide 'patfunc)
(provide 'patfuncx)