;; Some emacs functions to make porting documentation to the GHC wiki less painful
;; Functions intended for direct use are marked with USE


;; Note that the function below does non-eager content matching
;; so that the correct closing tag is chosen.
;; Otherwise it erroneously picks up two tagged contents on the
;; same line as one.
;; Also, the regular expression records the content in register \1
(defun wk-tag-regexp (tag)
  "Make a regular expression that matches tagged content."
  (format "<%s>\\(.*?\\)</%s>" tag tag))

;; USE
;; The function below can be used to replace
;;    "<indexterm> ... </indexterm>"
;; into
;;    ""
;; for example.
;; The arguments in that case should be "indexterm" and ""
;; Note that above I am quoting the backslash but interactively
;; it is not needed
(defun wk-rebracket (tag dest)
  "Replace the tagged content by the specified result."
  (interactive "sRebracket content in tag: \nsReplace it by :\n")
  (query-replace-regexp (wk-tag-regexp tag) dest))

;; USE
;; This function replaces all content tagged by indexterm with the
;; empty string.
(defun wk-kill-idx ()
  "Remove all occurrences of indexterm content from document."
  (interactive "")
  (query-replace-regexp (wk-tag-regexp "indexterm") ""))

;; USE
;; Replace the given open/closing tags by {{{ /  }}} braces
;; todo, get the format out of the loop
;;       and give a message with the number of replacements
(defun wk-rebrace (str open close)
  "Replace the tags by the appropriate wiki braces"
  (interactive "sPick tag to replace by braces : \nsOpening brace : \nsClosing brace : \n")
  (let ((orig (point)))
    ;; Replace opening tags
    ;; The regexp after the tag name is used to catch attributes.
    (while (re-search-forward (format "<%s.*?>" str) nil t)
      (replace-match open nil nil))
    ;; Go back where we started and replace the closing tag.
    (goto-char orig)
    (while (re-search-forward (format "</%s>" str) nil t)
      (replace-match close nil nil))
    ;; and just go back where we started
    (goto-char orig)))

;; USE (uses the fun. above to fix many tags)
;; Rebrace many many tags
(defun wk-rebrace-many ()
  "Replace the tags of GHC's docs to trac wiki markup"
  (interactive "")
  ;; Rebrace to trac type setting
  (mapcar (lambda (arg) (wk-rebrace arg "{{{" "}}}"))
	  '("command" "filename" "constant" "function"
	    "literal" "option"))
  ;; Replace optional things by angle brackets
  (mapcar (lambda (arg) (wk-rebrace arg "<" ">"))
	  '("optional" "replaceable"))
  ;; Remove no longer needed tags
  (mapcar (lambda (arg) (wk-rebrace arg "" ""))
	  '("para" "parameter"))
  ;; Translate emphasis
  (mapcar (lambda (arg) (wk-rebrace arg "''" "''"))
	  '("emphasis"))
  ;; Translate quote
  (mapcar (lambda (arg) (wk-rebrace arg "\"" "\""))
	  '("quote"))
  )

;; USE
;; Useful to do this later
(defun wk-rebrace-many2 ()
  "Replace the tags of GHC's docs to trac wiki markup, phase2"
  (interactive "")
  ;; Rebrace to trac type setting
  (mapcar (lambda (arg) (wk-rebrace arg "{{{\n" "\n}}}"))
	  '("screen" "programlisting"))
  ;; Remove no longer needed tags
  (mapcar (lambda (arg) (wk-rebrace arg "" ""))
	  '("para" "sect2" "parameter"))
  )


;; buggy
(defun wk-rebracket-multi (tag dest)
  "Replace the tagged multiline content by the specified result."
  (interactive "sRebracket multiline content in tag: \nsReplace it by :\n")
  ;; The way this works is that the content should be at least one non-new-line
  ;; character and then several optional new-line followed by characters.
  (query-replace-regexp (format "<%s>\(.*\(?:\n.+\)*?\)</%s>" tag tag) dest))

;; Helper function
(defun my-replace (str1 str2)
  "Replace string"
  (let ((orig (point)))
    (while (re-search-forward str1 nil t)
      (replace-match str2 nil nil))
    (goto-char orig)
    ))

;; USE
;; Replace entities by their represented characters
(defun wk-repenc ()
  "Replace some HTML encodings"
  (interactive)
  (my-replace "&lowbar;" "_")
  (my-replace "&dollar;" "$")
  (my-replace "&ldquo;" "\"")
  (my-replace "&rdquo;" "\"")
  (my-replace "&mdash;" "--")
  (my-replace "&lt;" "<")
  (my-replace "&gt;" "->")
  (my-replace "&#60;" "->")
  )

;; MACROS
;; Use with care.
;; they are meant to replace uses of list items with their TRAC wiki counterparts
;; hard to document, just try them and see if it works for you.
;; careful, the undo is too fine grained.

;; Note that the macros below assume that C-w is replaced by C-x C-k
;; it can be achieved by doing:
;;(global-set-key "\C-c\C-k" 'kill-region)


;; Keyboard macro recorded with M-x insert-kbd-macro
;; after naming it with M-x name-last-kbd-macro
;;   info from http://www.emacswiki.org/cgi-bin/wiki/KeyboardMacros
;; This arranges list entries as trac wiki expects
(fset 'arrange-list-item
   [?\C-s ?< ?l ?i ?s ?t ?i ?t ?e ?m ?> ?\C-a ?\C-k ?\C-k ?\C-  ?\C-s ?< ?/ ?l ?i ?s ?t ?i ?t ?e ?m ?> ?\C-a ?\C-k ?\C-\M-\\ ?\C-3 ?\C-x tab ?\C-x ?\C-x ?\C-f ?* ?\C-d ?\C-x ?\C-x])


;; Not always terribly useful, especially when nested lists and programlistings are involved
(global-set-key (kbd "C-c l") 'arrange-list-item)

(fset 'arrange-var-list-item
   [?\C-s ?< ?v ?a ?r ?l ?i ?s ?t ?e ?n ?t ?r ?y ?> ?\C-a ?\C-  ?\C-s ?< ?t ?e ?r ?m ?> ?\C-x ?\C-k ?\C-e ?\C-w backspace backspace ?\C-  ?\C-s ?< ?l ?i ?s ?t ?i ?t ?e ?m ?> ?\C-x ?\C-k ?\C-a ?\C-  ?\C-s ?< ?/ ?l ?i ?s ?t ?i ?t ?e ?m ?> ?\C-a ?\C-\M-\\ ?\C-3 ?\C-x tab ?\C-x ?\C-x ?\C-f ?* ?\C-d ?\C-x ?\C-x ?\C-k ?\C-k ?\C-k ?\C-k])

;; this one is wrong
;;(fset 'arrange-var-list-item
;;   [?\C-s ?< ?v ?a ?r ?l ?i ?s ?t ?e ?n ?t ?r ?y ?> ?\C-a ?\C-k ?\C-s ?< ?t ?e ?r ?m ?\M-b ?\C-b ?\M-d ?\C-d ?\C-n ?\C-a ?\C-k ?\C-k ?\C-k ?\C-k ?\C-k ?\C-p ?\C-  ?\C-s ?< ?/ ?l ?i ?s ?t ?i ?t ?e ?m ?> ?\C-a ?\C-\M-\\ ?\C-3 ?\C-x tab ?\C-x ?\C-x ?\C-f ?* ?\C-d ?\C-x ?\C-x ?\C-k ?\C-k ?\C-k ?\C-k])

(global-set-key (kbd "C-c v") 'arrange-var-list-item)

;; Arranges a varlist as a subsubsection (===)
(fset 'arrange-var-list-item2
   [?\C-s ?< ?v ?a ?r ?l ?i ?s ?t ?e ?n ?t ?r ?y ?> ?\C-a ?\C-  ?\C-s ?t ?e ?r ?m ?> ?\C-x ?\C-k ?\C-  ?= ?= ?= ?  ?\C-e ?  ?= ?= ?= ?\C-n ?\C-a ?\C-k ?\C-k ?\C-k ?\C-k ?\C-  ?\C-s ?< ?/ ?l ?i ?s ?t ?i ?t ?e ?m ?> ?\C-a ?\C-k ?\C-k ?\C-k ?\C-\M-\\])

(global-set-key (kbd "C-c o") 'arrange-var-list-item2)