;;; cjm-misc.el --- Miscellaneous functions by Christopher J. Madsen
;;
;; Copyright 2007 Christopher J. Madsen
;;
;; Author: Christopher J. Madsen <emacs@cjmweb.net>
;; Created: 17 Feb 1999
;; Version: $Rev: 794 $ ($Date: 2013-02-08 11:48:35 -0600 (Fri, 08 Feb 2013) $)
;; Keywords: c languages tools
;;
;; This file is not part of GNU Emacs.
;;
;; This program 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:
;;
;; This is a collection of miscellaneous functions that I have found useful
;; at one time or another, but aren't big enough to deserve their own
;; package.  Some of them I use all the time; some I never use anymore.
;; Use at your own risk.
;;
;; Most of them are preceded by comments giving suggested usage or keybindings.
;;
;; The most recent version of this package can be found at:
;;   http://www.cjmweb.net/emacs/
;;
;; Here are some of my favorites:
;;   cjm-delete-trailing-space
;;   cjm-allow-trailing-space
;;   cjm-insert-divider
;;   cjm-lineup
;;   cjm-lineup-after
;;   cjm-lineup-after-colon
;;   cjm-lineup-equals
;;   cjm-move-line-down
;;   cjm-move-line-up
;;   cjm-number-rectangle
;;   cjm-string-length
;;   cjm-sum-column
;;   cjm-yank-as-rectangle
;;   cjm-make-c-function
;;   cjm-finish-perl-construct  (used to be cjm-make-perl-function)
;;   cjm-vc-log-and-diff

;; LCD Archive Entry:
;; cjm-misc|Christopher J. Madsen|emacs@cjmweb.net|
;; Miscellaneous functions by Christopher J. Madsen|
;; $Date: 2013-02-08 11:48:35 -0600 (Fri, 08 Feb 2013) $|$Rev: 794 $||

(eval-when-compile
  (require 'cl))                        ;Need incf, push, & pop macros

;;=========================================================================
;; General purpose functions:
;;-------------------------------------------------------------------------
(autoload 'ansi-color-apply-on-region "ansi-color")

(defun cjm-ansi-colorize ()
  "Interpret ANSI color codes in current buffer."
  (interactive)
  (ansi-color-apply-on-region (point-min) (point-max)))

;;-------------------------------------------------------------------------
(defun cjm-compile (automatic)
  "Invoke `compile'.  With prefix arg, save buffer & use default command."
  (interactive "P")
  (if automatic
      (progn
        (save-buffer)
        (compile (eval compile-command)))
    (call-interactively 'compile)))

;;-------------------------------------------------------------------------
(defun cjm-convert-crlf (&optional force)
  "Replace CR/LF pairs with LF.
The buffer-modified flag is not changed."
  (interactive (list t))
  (save-excursion
    (goto-char (point-min))
    (if (or force (looking-at "[^\n\r]*\r\n"))
        (let ((was-mod (buffer-modified-p))
              (buffer-read-only nil))
          (message "Converting CR/LF pairs in %s..." (buffer-name))
          (while (search-forward "\r\n" nil t)
            (replace-match "\n" nil t))
          (message "Converting CR/LF pairs in %s... done" (buffer-name))
          (set-buffer-modified-p was-mod)))))

;;-------------------------------------------------------------------------
;; Automatically remove trailing whitespace:
;;
;; ; add-hook no longer accesses the global value for write-contents-hooks:
;; (let ((old-hook (default-value 'write-contents-hooks)))
;;   (or (memq 'cjm-delete-trailing-space old-hook)
;;       (setq-default write-contents-hooks (cons 'cjm-delete-trailing-space
;;                                                old-hook))))
;; (global-set-key "\C-csa" 'cjm-allow-trailing-space)

(defun cjm-delete-trailing-space ()
  "Delete all spaces or tabs from the end of lines."
  (interactive)
  (or buffer-read-only                  ;Do nothing if read-only
      (save-excursion
        (goto-char (point-min))
        (while (re-search-forward "[ \t]+$" nil t)
          (replace-match "" nil nil))))
  nil)                                  ;We did not write the file

(defun cjm-allow-trailing-space ()
  "Remove `cjm-delete-trailing-space' from write-contents-hooks."
  (interactive)
  (make-local-variable 'write-contents-hooks)
  (remove-hook 'write-contents-hooks 'cjm-delete-trailing-space t)
  (message "Trailing space allowed."))

;;-------------------------------------------------------------------------
(defun cjm-describe-prefix-arg (prefix-arg)
  "Return a string describing PREFIX-ARG as it might appear in the echo area."
  (cond
   ((null prefix-arg)     "")
   ((integerp prefix-arg) (format "C-u %d " prefix-arg))
   ((eq '\- prefix-arg)   "M-- ")
   ((consp prefix-arg)
    (let* ((value (car prefix-arg))
           (sign (if (>= value 0)
                     ""
                   (setq value (- value))
                   "M-- ")))
      (apply 'concat (cons sign (make-list (round (log value 4)) "C-u ")))))
   (t (warn "Unknown prefix-arg %s" prefix-arg) "")))

;;-------------------------------------------------------------------------
;; (global-set-key "\C-co" 'cjm-find-related-file)

(defvar vc-parent-buffer nil)
(defvar cjm-related-file nil)
(defvar cjm-cpp-header ".hpp")
(make-variable-buffer-local 'cjm-related-file)
(put 'cjm-related-file 'permanent-local t)
(put 'cjm-related-file 'safe-local-variable 'stringp)
(defun cjm-find-related-file (&optional other-window)
  "Find a file related to this one.
Prefix arg means use a different window."
  (interactive "P")
  (let ((b (or (and cjm-related-file
                    (find-file-noselect cjm-related-file))
               vc-parent-buffer
               (let* ((fn (or (buffer-file-name)
                              (error "Not visiting a file")))
                      (ext (or (numberp (string-match "\\.~[0-9.]+~$" fn))
                               (and (string-match "\\.[^./\\\\]+$" fn)
                                    (match-string 0 fn)))))
                 (find-file-noselect
                  (replace-match
                   (cond
                    ((eq ext t) "")     ;Numbered backup file
                    ((string= ext ".cpp") cjm-cpp-header)
                    ((string= ext cjm-cpp-header) ".cpp")
                    ((string= ext ".pm") ".xs")
                    ((string= ext ".xs") ".pm")
                    ((string= ext ".texi") ".tmp")
                    ((string= ext ".tmp") ".texi")
                    (t (error "Don't recognize extension `%s'" ext)))
                   t t fn))))))
    (cond ((get-buffer-window b) (select-window (get-buffer-window b)))
          (other-window          (switch-to-buffer-other-window b))
          (t                     (switch-to-buffer b)))))

;;-------------------------------------------------------------------------
(defun cjm-insert-divider (divider-char)
  "Insert a divider line before the line containing point.

The divider consists of the comment marker followed by enough repetitions
of DIVIDER-CHAR to bring the total width of the divider up to fill-column.

The comment marker is `;;' if comment-start is `;'; otherwise it is
comment-start minus any trailing spaces."
  (interactive "*cDivider character:")
  (beginning-of-line)
  (insert (cond
           ((string= comment-start ";")   ";;\n") ;Lisp mode
           ((eq comment-start nil) ?\n)           ;Text mode (no comments)
           (t (concat comment-start "\n"))))      ;Use normal comment start
  (backward-char)
  ;; Remove trailing spaces from comment-start:
  (delete-region (point) (progn (skip-chars-backward " \t") (point)))
  (insert-char divider-char (- fill-column (current-column)))
  (forward-char))

;;-------------------------------------------------------------------------
(defun cjm-insert-timestamp (&optional no-time)
  "Insert the current date & time in Mon dd yyyy hh:mm:ss format.
Prefix-arg means omit the time.  Double C-u means use Month dd, yyyy format."
  (interactive "P")
  (insert (if no-time
              (if (< 4 (prefix-numeric-value no-time))
                  ; C-u C-u means spell out the month:
                  (format-time-string "%B %-d, %Y")
                  ; C-u means omit time:
                (format-time-string "%b %d %Y"))
            ; No prefix arg:
            (format-time-string "%b %d %Y %T"))))

;;-------------------------------------------------------------------------
(defun cjm-lineup (start end at &optional regexp after)
  "Align parts of the current region."
  (interactive "r\nMLineup at: ")
  (goto-char end)
  (or (bolp)
      (forward-line 1))
  (setq end (copy-marker (point) t))
  (let ((col 0)
        (search    (if regexp 're-search-forward 'search-forward))
        (match-pos (if after 'match-end 'match-beginning))
        x)
    (goto-char start)
    (while (funcall search at end t)
      (goto-char (funcall match-pos 0))
;;      (skip-chars-backward " \t")
      (setq col (max col (current-column)))
      (forward-line))
;;    (incf col)
    (goto-char start)
    (while (funcall search at end t)
      (goto-char (funcall match-pos 0))
      (setq x (current-column))
      (cond ((> x col)
             (delete-region (- (+ (point) col) x) (point)))
            ((< x col)
             (insert-and-inherit (make-string (- col x) ?\ ))))
      (forward-line)))
  (set-marker end nil))

(defun cjm-lineup-after (start end at)
  (interactive "r\nMLineup after: ")
  (cjm-lineup start end at nil t))

(defun cjm-lineup-after-colon (start end)
  (interactive "r")
  (cjm-lineup start end ":\\s-*" t t))

(defun cjm-lineup-second-column (start end)
  (interactive "r")
  (cjm-lineup start end "^\\s-*\\S-+\\s-*" t t))

(defun cjm-lineup-equals (start end)
  (interactive "r")
  (cjm-lineup start end "="))

;;-------------------------------------------------------------------------
(defun cjm-mouse-wheel-scroll-line (event)
  "Scroll the window under the mouse by `mouse-wheel-scroll-amount'."
  (interactive "e")
  (let ((old-win (selected-window)))
    (condition-case nil
        (progn
          (select-window (posn-window (event-start event)))
          (if (< (car (cdr (cdr event))) 0)
              (scroll-up mouse-wheel-scroll-amount)
            (scroll-down mouse-wheel-scroll-amount)))
      (error nil))
    (select-window old-win)))

;;-------------------------------------------------------------------------
(defun cjm-move-line-down (count)
  "Move the current line down a line.
With prefix arg, move it down that many lines."
  (interactive "p")
  (beginning-of-line)
  (let ((start (point))
        line)
    (forward-line)
    (or (bolp)
        (insert-and-inherit ?\n))
    (setq line (buffer-substring start (point)))
    (delete-region start (point))
    (forward-line count)
    (or (bolp)
        (insert-and-inherit ?\n))
    (setq start (point))
    (insert line)
    (goto-char start)))

(defun cjm-move-line-up (count)
  "Move the current line up a line.
With prefix arg, move it up that many lines."
  (interactive "p")
  (cjm-move-line-down (- count)))

;;-------------------------------------------------------------------------
(defun cjm-next-file-by-name (count)
  "Find the next file (by name) in this directory.
Ignores files matching completion-ignored-extensions.
With prefix arg, advance that many files."
  (interactive "p")

  (let* ((ignore (concat "\\(?:^\\.+\\|"
                         (regexp-opt completion-ignored-extensions) "\\|#\\)$"))
         (files (delete-if (function
                            (lambda (x) (string-match ignore x)))
                           (directory-files default-directory)))
         (curfn (file-name-nondirectory buffer-file-name))
         (i (position curfn files :test 'string=))
         (revert-without-query '(".")))
    (find-file (or (elt files (+ i count))
                   (error "No next file")))))

(defun cjm-previous-file-by-name (count)
  "Find the previous file (by name) in this directory.
Ignores files matching completion-ignored-extensions.
With prefix arg, go back that many files."
  (interactive "p")
  (cjm-next-file-by-name (- (or count 1))))

;;-------------------------------------------------------------------------
(defun cjm-next-line-this-col (count)
  "Move cursor vertically down COUNT lines, remaining at the same column.
(Moves up if COUNT is negative.)  Spaces are inserted if necessary.
If there isn't room, go as far as possible (no error)."
  (interactive "p")
  (let ((col (current-column)))
    (forward-line count)
    (move-to-column col t)))

(defun cjm-previous-line-this-col (count)
  "Move cursor vertically up COUNT lines, remaining at the same column."
  (interactive "p")
  (cjm-next-line-this-col (- count)))

;;-------------------------------------------------------------------------
(defun cjm-number-lines (begin end)
  "Number the lines in the region, beginning with 1."
  (interactive "r")
  (goto-char begin)
  (beginning-of-line)
  (let* ((num-lines (count-lines (point) end))
         (frm-str (format "%%%dd: " (1+ (truncate (log10 (max num-lines 1))))))
         (line-num 0))
    (while (< line-num num-lines)
      (insert (format frm-str (setq line-num (1+ line-num))))
      (forward-line))))

;;-------------------------------------------------------------------------
(defvar cjm-next-line-num 1)
(defun cjm-number-rectangle (begin end start-at)
  "Insert numbers in the rectangle.
Without prefix arg, start numbering at 1.
With numeric prefix arg, start numbering at that number.
With any other prefix arg, prompt for the starting number."
  (interactive "r\nP")
  (setq start-at
        (cond
         ((not start-at) 1)
         ((integerp start-at) start-at)
         (t (setq start-at (number-to-string cjm-next-line-num))
            (while (not (string-match
                         "^[ \t]*[0-9]+[ \t]*$"
                         (setq start-at
                               (read-string "Start numbering at: " start-at))))
              (ding))
            (string-to-number start-at))))
  (require 'rect)                       ;Need apply-on-rectangle

  (let* ((cjm-frm-str
          (format "%%%dd"
                  (1+ (truncate (log10 (+ start-at (count-lines begin end)
                                          -1))))))
         string)
    (setq cjm-next-line-num (1- start-at))
    (apply-on-rectangle
     (function
      (lambda (start end)
        (setq cjm-next-line-num (1+ cjm-next-line-num))
        (string-rectangle-line start end (format cjm-frm-str cjm-next-line-num) t)))
     begin end))
  (setq cjm-next-line-num (1+ cjm-next-line-num)))

;;-------------------------------------------------------------------------
(defun cjm-query-replace-regexp-with-lines (regexp source-buffer
                                            &optional repeat-count start end)
  "Like `query-replace-regexp', but getting replacements from SOURCE-BUFFER.
Each line of SOURCE-BUFFER is used as the replacement text in sequence.
Prefix arg means to use each line that many times."
  (interactive
   (let* ((from (if query-replace-interactive
		    (car regexp-search-ring)
		  (read-from-minibuffer "Map query replace (regexp): "
					nil nil nil
					'query-replace-history nil t)))
	  (source-buffer
           (read-buffer (format "Query replace %s with lines from: "
                                (query-replace-descr from))
                        (other-buffer (current-buffer) t) t)))
     (list from source-buffer
	   (and current-prefix-arg
		(prefix-numeric-value current-prefix-arg))
	   (if (and transient-mark-mode mark-active)
	       (region-beginning))
	   (if (and transient-mark-mode mark-active)
	       (region-end)))))
  (let ((replacements
         (with-current-buffer source-buffer
           (split-string (buffer-substring-no-properties (point-min)
                                                         (point-max))
                         "\r?\n"))))
    (perform-replace regexp replacements t t nil repeat-count nil start end)))

;;-------------------------------------------------------------------------
(defun cjm-revert-buffer ()
  "Revert current buffer without querying (unless it's modified)."
  (interactive)
  (let ((revert-without-query '(".")))
    (revert-buffer)))

;;-------------------------------------------------------------------------
;; (substitute-key-definition 'scroll-left  'cjm-scroll-left  global-map)
;; (substitute-key-definition 'scroll-right 'cjm-scroll-right global-map)

(defun cjm-scroll-left (arg)
  "Scroll selected window display ARG columns left.
Default for ARG is window width divided by 4."
  (interactive "P")
  (let* ((cols (if arg
                   (prefix-numeric-value arg)
                 (/ (window-width) 4)))
         (cur (current-column))
         (newleft (+ cols (window-hscroll))))

    (if (< cur newleft)
        (move-to-column newleft))
    (scroll-left cols)))

(defun cjm-scroll-right (arg)
  "Scroll selected window display ARG columns right.
Default for ARG is window width divided by 4."
  (interactive "P")
  (scroll-right (if arg
                    (prefix-numeric-value arg)
                  (/ (window-width) 4))))

;;-------------------------------------------------------------------------
(defun cjm-string-length (&optional single)
  "Print the number of characters in the string which point is inside.

With prefix arg, use single quotes, not double quotes, as delimeters."
  (interactive "P")
  (let* ((quote-char (if single
                         ?\'
                       ?\"))
         (quote-string (format "^%c\n" quote-char)))
    (save-excursion
      (skip-chars-forward quote-string)
      (if (/= (following-char) quote-char)
          (error "Point is not inside string"))
      (let ((length (- (point)
                       (progn
                         (skip-chars-backward quote-string)
                         (if (/= (preceding-char) quote-char)
                             (error "Point is not inside string"))
                         (point)))))
        (message "String has %d (0x%x) characters" length length)))))

;;-------------------------------------------------------------------------
(defun cjm-sum-column (start end time)
  "Sum the numbers in the current rectangle.
With prefix arg, assume they are times."
  (interactive "r\nP")
  (require 'rect)                       ; Need operate-on-rectangle
  (let ((total 0))
    (operate-on-rectangle 'cjm-sum-column-line start end nil)
    (cond (time (message "Sum: %d:%02d:%02d"
                         (/ total 3600) (/ (% total 3600) 60) (% total 60)))
          ((floatp-safe total) (message "Sum: %g" total))
          (t                   (message "Sum: %d" total)))))

(defun cjm-sum-column-line (startdelpos begextra endextra)
  (let ((line (buffer-substring-no-properties startdelpos (point))))
    (cond ((string-match "^[ \t]*$" line)) ;Skip blank lines
          ;; Hours, minutes, seconds:
          ((and time
                (string-match
               "^[ \t]*\\([0-9]+:\\)?\\([0-9]+:\\)?\\([0-9]+\\)[ \t]*$" line))
           (let ((hours (match-string 1 line))
                 (minutes (match-string 2 line))
                 (seconds (match-string 3 line)))
             (if (and hours (not minutes))
                 (setq minutes hours
                       hours   nil))
             (setq total (+ total
                            (* 3600 (string-to-number (or hours "")))
                            (*   60 (string-to-number (or minutes "")))
                            (string-to-number seconds)))))
          ;; Integer or floating point:
          ((and (not time)
                (string-match "^[ \t]*[0-9]*\\.?[0-9]+[ \t]*$" line))
           (setq total (+ total (string-to-number line))))
          (t (error "Non numeric data `%s' on line %d" line
                    (1+ (count-lines (point-min)
                                     (progn (beginning-of-line) (point))))))
          )))

;;-------------------------------------------------------------------------
(defun cjm-yank-as-rectangle ()
  "Reinsert (\"paste\") the last stretch of killed text like a rectangle.
This splits the text into lines, then inserts each one like
`yank-rectangle' does.  Note that the lines may not be the same length."
  (interactive)
  (insert-rectangle (split-string (current-kill 0) "\r?\n")))

;;-------------------------------------------------------------------------
(defun cjm-underline-region (start end)
  "Underline the region on a word-by-word basis.
It inserts N underscores and N backspaces before each word in the region."
  (interactive "r")
  (let (b len)
    (save-restriction
      (narrow-to-region start end)
      (goto-char (point-min))
      (forward-word 1)
      (while
          (if (setq b (bounds-of-thing-at-point 'word))
              (progn
                (setq len (- (cdr b) (car b)))
                (goto-char (car b))
                (insert-and-inherit (make-string len ?_) (make-string len ?\^H))
                (forward-word 2)))))))

;;-------------------------------------------------------------------------
(defun cjm-underline-word ()
  "Underline the word at point by inserting underscores and backspaces."
  (interactive)
  (let* ((b (or (bounds-of-thing-at-point 'word)
                (error "No word at point")))
         (len (- (cdr b) (car b))))
    (goto-char (car b))
    (insert-and-inherit (make-string len ?_) (make-string len ?\^H))))

;;=========================================================================
;; Functions for specific modes and/or packages:
;;-------------------------------------------------------------------------
;; Buffer Menu:

(defun cjm-buffer-menu (&optional arg)
  "Display a list of buffers in another window or update the current list."
  (interactive "P")
  (if (string= (buffer-name) "*Buffer List*")
      (buffer-menu arg)
    (buffer-menu-other-window arg)))

;;-------------------------------------------------------------------------
;; CC Mode (C/C++)

(defun cjm-make-c-function ()
  "Add the curly braces and closing comment for a C function definition."
  (interactive)
  (let ((save-point (point))            ;Remember end of argument list
        start end)
    (if (/= ?\) (preceding-char))       ;Is the argument list closed?
        (if (and (= ?t (preceding-char));Is this a "const" function?
                 (forward-word -1)
                 (looking-at "const"))
            nil                         ;Yes, it's a const function
          (goto-char save-point)        ;No, supply a closing paren
          (insert ")")
          (setq save-point (point))))
    (backward-sexp)                     ;Skip over function arguments
    (skip-syntax-backward " ")          ;Skip space between name & arg list
    (setq end (point))                  ;Remember end of function name
    (skip-syntax-backward "^w_")        ;This might be an operator
    (skip-syntax-backward "w_")         ;Find beginning of function name
    (if (= ?~ (preceding-char))         ;If it is a destructor,
        (backward-char 2))              ; include the tilde
    (if (= ?: (preceding-char))         ;If it is a class member function,
        (progn                          ; include the class name
          (backward-char 2)
          (skip-syntax-backward "w_")))
    (setq start (point))                ;Remember where function name starts
    (goto-char save-point)              ;Go back to end of argument list
    (insert "\n{\n\n} " comment-start "end ")
    (insert-buffer-substring (current-buffer) start end)
    (insert comment-end "\n")
    (if (looking-at "\n\n")             ;Leave only one blank line after
        (delete-blank-lines))           ; the new function
    (goto-char save-point)              ;Go back to end of argument list
    (forward-line 2)                    ;Move to blank line between braces
    (indent-for-tab-command)))          ;Indent line so we can start typing

;;-------------------------------------------------------------------------
;; HTML Editing:

;;(add-hook 'html-mode-hook  ;Or whatever your HTML mode hook is
;; (function (lambda () (add-hook 'write-contents-hooks 'cjm-html-timestamp))))

(defun cjm-html-timestamp ()
  "Update the timestamp in an HTML buffer.

This function searches for an HTML comment that looks like
  <!-- mod-date=\"FORMAT\" -->
Everything from this comment to the end of the line is replaced by the
current date, which is formatted by passing FORMAT to `format-time-string'.

Any text preceding the comment on the line is not changed."
  (save-excursion
    (goto-char (- (point-max) 1000))
    (if (re-search-forward "<!-- *mod-date=\"\\([^\"\n]+\\)\" *-->\\(.*\\)$"
                           nil t)
        (let* ((newstr (format-time-string (match-string 1) (current-time))))
          (or (string= newstr (match-string 2))
              (replace-match newstr t t nil 2)))))
  nil)


;;(setq auto-coding-functions
;;      (cons 'cjm-html-meta-auto-coding-function
;;            (delq 'sgml-html-meta-auto-coding-function auto-coding-functions)))

(defun cjm-html-meta-auto-coding-function (size)
  "Determine the coding system from HTML <meta> tag."
  (let ((case-fold-search t))
    (setq size (min (+ (point) size)
		    (save-excursion
		      ;; Limit the search by the end of the HTML header.
		      (or (search-forward "</head>" (+ (point) size) t)
			  ;; In case of no header, search only 10 lines.
			  (forward-line 10))
		      (point))))
    ;; Make sure that the buffer really contains an HTML document, by
    ;; checking that it starts with a doctype or a <HTML> start tag
    ;; (allowing for whitespace at bob).  Note: 'DOCTYPE NETSCAPE' is
    ;; useful for Mozilla bookmark files.
    (when (and (re-search-forward "\\`[[:space:]\n]*\\(<!doctype[[:space:]\n]+\\(html\\|netscape\\)\\|<html\\)" size t)
               (or (re-search-forward "<meta\\s-+charset=[\"']?\\([^ \r\n\t\"'>]+\\)" size t)
                   (re-search-forward "<meta\\s-+content=[\"']text/\\sw+;\\s-*charset=\\(.+?\\)[\"']\\s-+http-equiv=[\"']?content-type[\"']?" size t)
                   (re-search-forward "<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']text/\\sw+;\\s-*charset=\\(.+?\\)[\"']" size t)))
      (let* ((match (match-string 1))
	     (sym (intern (downcase match))))
	(if (coding-system-p sym)
	    sym
	  (message "Warning: unknown coding system \"%s\"" match)
	  nil)))))

;;-------------------------------------------------------------------------
;; Perl Mode:

;; (define-key cperl-mode-map "\C-cf" 'cjm-finish-perl-construct)

(defun cjm-finish-perl-construct ()
  "Add the curly braces and closing comment for a Perl construct."
  (interactive)
  (let ((save-point (point))            ;Remember end of construct
        end-comment fixup-function)
    (skip-chars-backward " \t")
    (and (= (char-before) ?\) )
         (backward-sexp))
    (beginning-of-line)
    ;; Let's see what we've got:
    (cond
     ;; CONSTRUCT: sub name
     ((looking-at "\\s-*sub\\s-+\\(\\(?:\\w\\|\\s_\\|:\\)+\\)")
      ;; Want opening brace at beginning-of-line
      (goto-char save-point)
      (insert "\n")
      (setq save-point (point)
            end-comment (match-string-no-properties 1) ;sub name
            ;; Special cleanup for subroutines only:
            fixup-function
            (function
             (lambda ()
               (if (looking-at "\n\n")   ;Leave only one blank line after
                   (delete-blank-lines)) ; the new function
               (goto-char save-point)    ;Go back to starting brace
               (indent-according-to-mode); and reindent it
               (forward-line 2)          ;Go back to ending brace
               (indent-according-to-mode); and reindent it
               (forward-line -1)         ;Move to blank line between braces
               (indent-for-tab-command)  ;Indent line so we can start typing
               (insert "my ($) = @_;")
               (backward-char 7)))))
     ;; CONSTRUCT: if/elseif/while/unless (cond)
     ((looking-at "\\s-*}?\\s-*\\(elsif\\|if\\|while\\|unless\\)\\s-*(\\(.+?\\)\\(?:)\\|$\\)")
      (setq end-comment (concat (match-string-no-properties 1) " "
                                (match-string-no-properties 2))))
     ;; CONSTRUCT: else
     ((looking-at "\\s-*}?\\s-* else")
      (setq end-comment "else "
            fixup-function
            (function
             (lambda ()
               (goto-char save-point)
               (forward-line 1)         ;Move to the blank line
               (indent-for-tab-command)
               (move-end-of-line 2))))) ;Leave point after the comment
     ;; CONSTRUCT: foreach my? $var (@list)  or  foreach my? $var (...)
     ((looking-at "\\s-*foreach\\s-+\\(?:my\\s-+\\)?\\(\\$\\(?:\\w\\|\\s_\\)+\\)\\(?:\\s-*(\\(@\\$?\\(?:\\w\\|\\s_\\|:\\)+\\))\\)?")
      (setq end-comment (concat "foreach " (match-string-no-properties 1)
                                (if (match-beginning 2)
                                    (concat " in " (match-string-no-properties 2))))))
     ;; CONSTRUCT: for my? $var (@list)  or  foreach my? $var (...)
     ((looking-at "\\s-*for\\s-+\\(?:my\\s-+\\)?\\(\\$\\(?:\\w\\|\\s_\\)+\\)\\(?:\\s-*(\\(@\\$?\\(?:\\w\\|\\s_\\|:\\)+\\))\\)?")
      (setq end-comment (concat "for each " (match-string-no-properties 1)
                                (if (match-beginning 2)
                                    (concat " in " (match-string-no-properties 2))))))
     ;; CONSTRUCT: for (...)   or  foreach (...)
     ((looking-at "\\s-*\\\(for\\(?:each\\)?\\)\\b")
      (setq end-comment (match-string-no-properties 1)))
     ;; CONSTRUCT: unrecognized
     ((error "Unable to find start of construct")))
    ;; Go back to original position and cleanup whitespace:
    (goto-char save-point)
    (or (bolp)
        (just-one-space))
    ;; Insert braces and ending comment:
    (insert "{\n\n} " comment-start "end " end-comment comment-end)
    (indent-according-to-mode)          ;Indent ending brace
    (insert "\n")
    ;; Finish up and position cursor:
    (if fixup-function
        (funcall fixup-function)        ;Handle special case
      ;; Default fixup:
      (goto-char save-point)
      (forward-line 1)                  ;Move to the blank line
      (indent-for-tab-command))))

;;-------------------------------------------------------------------------
;; Version Control (VC Mode):

(defvar cjm-project-name nil)
(defun cjm-checkout-project (path &optional project-name)
  "Check out the standard VC++ project files."
  (interactive
   (let ((dir (expand-file-name
               (read-file-name "Project directory: " nil nil t ""))))
     (or (file-directory-p dir)
         (setq dir (file-name-directory dir)))
     (list (file-name-as-directory dir)
           (if current-prefix-arg
               (read-string "Project name: "
                            (or cjm-project-name
                                (file-name-nondirectory
                                 (directory-file-name dir))))
             nil))))
  (or project-name
      (setq project-name (file-name-nondirectory (directory-file-name path))))
  (let ((files '("resource.h"))
        (extensions '(".dsp" ".dsw" ".clw" ".rc"))
        i)
    (while (setq i (pop extensions))
      (push (concat project-name i) files))
    (while (setq i (pop files))
      (message "Checking %s..." i)
      (setq i (concat path i))
      (vc-file-clearprops i) ;Re-test the file (cache may have wrong case)
      (or (if (fboundp 'vc-locking-user)
              (vc-locking-user i)       ;Emacs 20 or less
            ;; Emacs 21:
            (not (and (file-exists-p i)
                      (vc-backend i)
                      (memq (vc-state i) '(up-to-date needs-patch)))))
          (vc-checkout i t))))
  (message "Done..."))

(defun cjm-svn-root ()
  (with-temp-buffer
    (ignore-errors
      (call-process "svn" nil (current-buffer) nil "info")
      (goto-char (point-min))
      (and (re-search-forward "^Working Copy Root Path: +\\(.+\\)" nil t)
           (match-string-no-properties 1)))))

(defun cjm-vc-back-to-dired ()
  "Switch back to the VC dired buffer."
  (interactive)
  (switch-to-buffer
   (catch 'foundbuf
     (let ((buflist (buffer-list))
           buf)
       (while (setq buf (pop buflist))
         (if (eq 'vc-dired-mode
                 (cdr-safe (assoc 'major-mode (buffer-local-variables buf))))
             (throw 'foundbuf buf)))
       (error "No VC dired buffer")))))

(defun cjm-vc-log-and-diff (&optional force-diff)
  "Display the VC log and diff buffers.
If there is no *VC-log* buffer, create one for the current file.
This also works in Buffer Menu and Dired buffers.
Prefix arg means always run diff."
  (interactive "P")
  (require 'vc)
  (let ((cjm-log (get-buffer "*VC-log*"))
        (cjm-diff (and (not force-diff)
                       (get-buffer "*vc-diff*")))
        cjm-parent)
    ;; See if the *vc-diff* buffer is current:
    ;;   We must do this now, because vc-next-action can put brief diff
    ;;   output into the *vc-diff* buffer.
    (if cjm-diff
        (or (eq cjm-parent
                (cdr-safe (assoc 'vc-parent-buffer
                                 (buffer-local-variables cjm-diff))))
            (setq cjm-diff nil)))
    ;; Switch to *VC-log*, creating it if necessary:
    (if cjm-log
        (set-buffer cjm-log)            ;Existing *VC-log* buffer
      (and (eq major-mode 'Buffer-menu-mode)
           (Buffer-menu-this-window))
      (and (memq major-mode '(vc-dired-mode dired-mode))
           (dired-find-file))
      (and vc-parent-buffer
           (set-buffer vc-parent-buffer))
      (and (or buffer-read-only (not vc-mode))
           (error "File is not locked"))
      (vc-next-action nil)
      (setq cjm-log (current-buffer)))
    (setq cjm-parent vc-parent-buffer)
    ;; Switch to the *vc-diff* buffer, updating it if necessary:
    (if cjm-diff
        (set-buffer cjm-diff)
      (set-buffer cjm-parent)
      (vc-diff nil nil)) ;Don't continue if the buffer isn't saved
    (switch-to-buffer (current-buffer))
    ;; Now we're in *vc-diff*, so set up the window display:
    (delete-other-windows)
    (switch-to-buffer-other-window cjm-log)
    (enlarge-window (- 13 (window-height))) ;Make log window 12 lines high
    (other-window 1)
    (sit-for 0)
    (goto-char (1- (window-end)))       ;Move cursor to bottom of diff window
    (beginning-of-line)
    (other-window 1)))                  ;Back to log window

(defun cjm-vc-status (&optional check-remote)
  "Display the appropriate VC status window.
If CVS, runs `cvs-examine'.
If Git, runs `git-status'.
If Subversion, runs `svn-status-update'.
Prefix arg means check status against the remote repository (if SVN)."
  (interactive "P")
  (let (root)
    (cond
     ((file-directory-p (expand-file-name "CVS"))
      (cvs-examine default-directory '("-d" "-P"))) ; Always checks remote repository
     ((file-directory-p (expand-file-name ".svn"))
      (if (get-buffer "*svn-process*")
          (svn-status-update check-remote)
        (svn-status default-directory check-remote)))
     ;; Subversion 1.7 uses only 1 .svn directory per working copy
     ((setq root (cjm-svn-root))
      (svn-status root check-remote))
     ;; If git-get-top-dir doesn't error, then it's a GIT repository.
     ((condition-case nil
          (progn
            (and (fboundp 'git-status)
                 (not (fboundp 'git-get-top-dir))
                 (require 'git))
            (git-status (git-get-top-dir default-directory))
            t)
        (error nil)))
     (t (error "%s does not appear to be under version control" default-directory)))))

(provide 'cjm-misc)

;;; cjm-misc.el ends here