;;; annotate.el --- annotation helper functions.
;; Copyright 2007 by Martin Howse <m@1010.co.uk>
;; $Revision: 1.2 $

;; annotate.el is free software distributed under the terms of the GNU General
;; Public Licence, version 3. For details see the file COPYING.


;; TODO: 

;; - 1] extensive testing with Palm Pilot DONE

;; - 2] links/tags and inheritance structuring // further markup.  - some
;; - is in place - saving KR worlds

;; - 3] images DONE

;; images - make use of iimage mode:

;;   As minor mode with org-mode we use <foo.png> syntax for images which
;;   can be embedded under headings and so on.

;; would be nice to have some sort of thumbnailing mode - annotation
;; resources section (also for glossary etc.)

;; /www tag support and browsing - using org-mode and [[ ]] syntax

;; - 4] further integration with version control/RCS check in and check
;; - out / auto-save annotation file. co when annotate starts checkin on exit

;; - 5] cycling through (TAB) - display clearly formatted annotation
;; - [font/narrow-to-region] // cycle through text
;; - annotation/filmclip(played)/image

;; start by using org-toc-show

;; - 6] film/audio annotation format and insertion DONE

;; see orgmedia.el

;; DOCUMENTATION

;; briefly for org-mode: [TAB] cycles headings, C-c C-o - visit link at point

;; formatting:
;; P: [page [if known]] - must be matched with poor online text copy

;; b: [start word]

;; e: [end word] - if we don't have page reference then we need to search
;; start and end word proximity

;; c: [categories/link/KR data] - suggested catgeory

;; t: [annotation] - or from marked text


(require 'pilot)

(require 'org)

;; for org-mode:

(setq org-return-follows-link t)

(defconst number-regexp
 "-?\\([0-9]+\\.?\\|\\.\\)[0-9]*\\(e[0-9]+\\)?"

  "Regular expression for recognizing numbers.")


(defvar annotation-types
  '(("text" "t:") ("video" "f:") ("scratch" "s:") ("image" "i:") ("audio" "a:") ("process" "p:") ("code" "k:"))
  "The available annotation types.")

(defvar annotation-default-type "text"
  "The default annotation type.")

(defvar default-file-name "/root/experiment/lifecode/GravitysRainbow.txt")

(defvar default-annotation-file-name "/root/experiment/GR/autotate")

(defvar default-ratio 5)

(defvar pilot-device "/dev/ttyUSB0")

(defun palm-ann ()
  ;; enter palm memo into buffer
  (interactive)
  (save-excursion
    (let ((buf (set-buffer (get-buffer-create "**pilot**"))))
      (erase-buffer)
      (pilot-run-command (format "pilot-memos -c GR -p /dev/ttyUSB0")
			 "Press the HotSync button now to import annotations." t)

  (message "Done.")

;; get rid of From Palm.Handheld to Subject (next line)
  (beginning-of-buffer)
  (while (re-search-forward "From Palm.Handheld" nil t)
    (beginning-of-line)
    (setq ptr (point))
    (re-search-forward "Subject" nil t)
    (next-line 1)
    (delete-region ptr (point)))
    (annotate_buffer))))


(defun annotate_region (rb re)
  ;; make annotations from a region marked as p: type as default b: e:
  ;; c: and with t: marking beginning of text block

  ;; start of region
  (interactive "r")
  (let ((type annotation-default-type))
  (save-excursion
    (save-restriction
      (narrow-to-region rb re)
      (goto-char (point-min))
      (search-forward "P: ")
      (setq page (thing-at-point 'word))
      (search-forward "b: ") ;; snip first three characters
      (setq begin_word (subseq (thing-at-point 'sentence) 3))
      (search-forward "e: ")  ;; snip first three characters
      (setq end_word (subseq (thing-at-point 'sentence) 3))
      (search-forward "c: ")  ;; snip first three characters
      (setq category_list (subseq (thing-at-point 'sentence) 3)) ;; whitespace??
      (search-forward "t: ")
      (setq text (buffer-substring (point) (point-max)))
      (palm_annotate page text type category_list begin_word end_word)))))

(defun annotate_buffer ()
  (interactive)
  (beginning-of-buffer)
  (while (re-search-forward "P: " nil t)
    (setq ptt (- (point) 3))
    (if (re-search-forward "P: " nil t)
	(progn
	  (previous-line 1)
	  (setq pttt (point)))
      (setq pttt (point-max)))
    (annotate_region ptt pttt))) ;; to be tested
      
(defun annotate_template ()
  (interactive)
  (insert (format "\nP: \n\nb: \n\ne: \n\nc: \n\nt: \n"))
  (re-search-backward "P: ")
  (goto-char (+ 3 (point))))

(defun inter_annotate ()
  (interactive)
        (let ((page (read-string "Page: " nil nil "" t))
	      (type (completing-read
		(concat "Type (" annotation-default-type "): ") ;; prompt
		annotation-types ;; alist used for completion
		nil ;; limiting completion to a subset of
		    ;; `annotation-types' is not done
		t ;; only input from `annotation-types' or null
		  ;; is allowed
		nil ;; no initial input inserted into minibuffer
		nil ;; no history list is used for input
		annotation-default-type ;; the default value
		t))
	      (begin_word (read-string "First word: " nil nil "" t))
	      (end_word (read-string "Last word: " nil nil "" t))
	      (category_list (read-string "Categories: " nil nil "" t))
	      ;; text as marked region
	      (text (delete-and-extract-region (region-beginning) (region-end))))
	(palm_annotate page text type category_list begin_word end_word)))

(defun strip-html ()
  "Remove HTML tags from the current buffer, 
   (this will affect the whole buffer regardless of the restrictions in effect)."
  (interactive "*")
  (save-excursion
    (save-restriction
      (widen)
      (goto-char (point-min))
      (while (re-search-forward "<[^<]*>" (point-max) t)
        (replace-match "\\1"))
      (goto-char (point-min))
      (replace-string "&copy;" "(c)")
      (goto-char (point-min))
      (replace-string "&amp;" "&")
      (goto-char (point-min))
      (replace-string "&lt;" "<")
      (goto-char (point-min))
      (replace-string "&gt;" ">")
      (goto-char (point-min)))))




(defun annotate_hyperarts ()
  (interactive)
  (goto-char (point-min))
  (while (re-search-forward "<h3" nil t)
    (re-search-forward ">" nil t)
;;    (setq st (point))
;;    (re-search-forward "</p>")
;;    (setq end (- (point) 4))
;;    (narrow-to-region st end)
    (let ((category_list (progn
			   (setq st (point))
			   (re-search-forward "</h3>" nil t)
			   (setq category_list (buffer-substring st (- (point) 5)))))
	  (type "text-hyper")
	  (page (progn
		  (re-search-forward "<p>" nil t)
		  (setq ppp (point))
		  (re-search-forward "[0-9]+;" nil t)
		  (re-search-backward " \\|>")
		  (goto-char (+ (point) 1))
		  (matcherz)))
	  (begin_word category_list)
	  (end_word " ")
	  (text (progn
;;		  (setq st (+ (point) 2))
		  (re-search-forward "</p>")
		  (buffer-substring ppp (- (point) 5)))))
      (palm_annotate page text type category_list begin_word end_word)
	     (switch-to-buffer (other-buffer)))))
       


(defun annotate_wiki ()
  (interactive)
  (goto-char (point-min))
  (while (re-search-forward "Page " nil t) ;; but what of sub-pages/end page
    (let ((page (matcherz)) 
	  ;;	   (while (re-search-forward "^   \\([0-9]+\\)\\.\\([0-9]+\\)") ;; number.number[space] - can not exist
	  (type "text-wiki")
	  (category_list "")
	  (begin_word (progn 
			(next-line 1) 
			(re-search-forward "\\([0-9]+\\)\\.\\([0-9-]+\\)" nil t)			;; number.number[space] 
			;;(re-search-forward "[^0-9]" nil t)
			(setq pt (point))
			(end-of-line)
			(substring (buffer-substring pt (point)) 1)))
	  (end_word " ")
	     (text (progn
;;		     (next-line 1) ;; may not be next line ????
		     (setq pt (point))
		     (if (re-search-forward "Page "nil t)
			 (setq ptr (point))
		       (setq ptr (point-max)))
		     (previous-line 1)
		     (buffer-substring pt (point)))));; to end of next page
	     (palm_annotate page text type category_list begin_word end_word)
	     (switch-to-buffer (other-buffer)))))
		 

(defun page-exists (page)
  (if (re-search-forward (format "Page: %s " page) nil t)
      t
    nil))

(defun format-text (unburden heading-level category_list type page begin_word end_word text)

(if unburden
  (jump-to-end))
  ;; inheritance and tags/links for org-mode - do in formatting
  (insert (format "\n"))
  (let ((x 0))
    (while (< x heading-level)
      (insert (format "*"))
    (setq x (+ x 1))))
      

(insert (format " page: %s :%s:\n:PROPERTIES:\n:cat:%s\n:type:%s\n:END:\n" page (mapconcat (lambda (x) (subseq x 1)) (split-string (concat " " category_list) ",") ":") category_list type))


  (insert (format "\n\\\[Type: %s ] \n\\\[Page: %s ] \n\\\[First: %s ] \n\\\[Last: %s ] \n\\\[Categories: %s ] \n\\\[text: %s ] \n" type page begin_word end_word category_list text))

;;  (insert (format "\n\\\[Page: %s ] \n\\\[First: %s ] \n\\\[text: %s ] \n" page begin_word end_word text))


;; remove leading white space
;;(setq end (point))
(progn 
(re-search-backward "\\[text:")
(setq pnt (+ (point) 7))
(goto-char pnt)
(re-search-forward "[^ \n]" nil t)
(delete-and-extract-region pnt (- (point) 2))
(re-search-forward " ] \n" nil t)

 ;; remove trailing white space

(re-search-backward "[]]" nil t)
(setq pt (point))
(re-search-backward "[^ \n]" nil t)
(delete-and-extract-region (+ (point) 1) pt)
(re-search-forward "[]]" nil t)
(next-line 1))
;; format the region

(fill-region pnt (point) nil t)

(deletefront pnt (point))

;; as property list - spaces in category list

;;process - add link to source.

(insert-link page begin_word end_word))


(defun palm_annotate (page text type category_list begin_word end_word)

;; main annotation function

  ;;(set-buffer (get-buffer-create "*annotate__*"))
  ;;(erase-buffer)
  ;;
  ;; place in correct place according only to page number - also maybe
  ;; goto start and jump page numbers till we can insert
  (switch-to-buffer (find-file-noselect default-annotation-file-name))
    (goto-char (point-min))
;; check page exists already// in which case???? - line number question?
;; just return existence as 1 or 2 from search rather than searching twice

;;(format-text 2 category_list type page begin_word end_word text)
;;(while (find-next-number page) (setq x (+ x 1)))

;; first page

 (if (and (search-forward "Page: " nil t) (< (string-to-number page) (setq mmmm (matcher))))
     ;; first
     (progn
       (goto-char (point-min))
       (format-text nil 1 category_list type page begin_word end_word text))

;; page exists // doesn't exist

(format-text t (find-next-number page) category_list type page begin_word end_word text)))

(defun deletefront (start end)
  (save-excursion
      (save-restriction
        (narrow-to-region start end)
	(goto-char (point-min))
        (while (not (eobp))
          (setq ppp (point))
	  (skip-chars-forward " ")
	  (delete-region ppp (point)) 
          (forward-line)))))

(defun find-next-number (page)
   (while (and (search-forward "Page: " nil t) (>= (string-to-number page) (setq mmmm (matcher))))
     (progn
       (setq mmmmm mmmm)
       (setq pt (point))))
    (if (= (string-to-number page) mmmmm)
	(progn
	(goto-char pt)
	2)
      (progn
	(goto-char pt)
	1)))

(defun matcher ()
    (let (string)
      (if (looking-at number-regexp)
	  (goto-char (match-end 0)))
	(setq string (buffer-substring (match-beginning 0) (point)))
	(string-to-number string)))


(defun matcherz ()
    (let (string)
      (if (looking-at number-regexp)
	  (goto-char (match-end 0)))
	(setq string (buffer-substring (match-beginning 0) (point)))
	string))




(defun jump-to-end ()
;; jump to end of text block - how?
  (if (re-search-forward "Link:" (point-max) t)
      (next-line)
  t))
  


(defun insert-link (page begin_word end-word)
;; lookup page and place
  (let ((realpoint (find-page default-file-name page begin_word end_word)))
    ;; insert link to this LINE NUMBER in the default file - org-mode 
    ;; eg. [[file:~/code/main.c::255]]
      (set-buffer (get-file-buffer default-annotation-file-name))
    (insert (format "\\\Link: [[file:%s::%d][page:%s]]\n"
		    default-file-name realpoint page))))
  
(defvar range 200)

(defun find-page (file page begin_word end_word)
;; open file/buffer
  (set-buffer (find-file-noselect file))
;; goto-approx line number
;;  (goto-line 0)
  (goto-line (line-calc page))

      (while  (and 
	  (setq startpoint (search-forward begin_word nil t))
	  (setq endpoint (search-forward end_word nil t))
	(< endpoint startpoint)
	(< range (- endpoint startpoint)))
	(goto-char startpoint))
	


      (if (and startpoint endpoint)
	     ;; return line number
	(progn
;;	  (set-buffer (get-file-buffer default-annotation-file-name))
	  (line-number startpoint))
	    0)) 


(defun line-number (pointy)
  (line-number-at-pos pointy))

	  
(defun line-calc (page)
  (truncate (* (string-to-number page) default-ratio)))

(defun make-regex (word)
  (regexp-quote word))

;;(find-page default-file-name "536" "Osbie has" "is waiting") 

;;(find-page default-file-name "457" "On shore," "own substance.") 

;;(find-page default-file-name "348" "Results have" "desire it.") 

;;(palm_annotate "15" "____xxxxx" "text" "none" "He watches" "low hill")