;; ttp.el - tools for editing text with arbitrary text properties
;; Author and version: Edrx, 2005feb02
;; (find-anggfile "TCL/tcl.ttp")

;;;;
;;;; qref - buttons for "quick reference" pages
;;;;

(defun eeflash-prop-region ()
  (interactive)
  (eeflash (previous-char-property-change (1+ (point)))
	   (next-char-property-change (point))
	   '(:background "Orange")))

(defun qref-do-help ()
  (interactive)
  (message "%S" (get-text-property (point) 'action))
  (eeflash-prop-region))

(defun qref-do-action ()
  (interactive)
  (eval (get-text-property (point) 'action)))

(defvar qref-keymap
  '(keymap (13 . qref-do-action)
	   (?? . qref-do-help)))

(defvar qref-link nil
  "Text properties for qref's \"underlined\" links.
Only the proplist of this variable matters.
See: (find-epp (symbol-plist 'qref-link))")

(defvar qref-button nil
  "Text properties for qref's \"button\" links.
Only the proplist of this variable matters.
See: (find-epp (symbol-plist 'qref-link))")

(setplist 'qref-link
	  `(face (:underline t)
	    active-face (:background "Orange")
	    mouse-face (:foreground "green")
	    keymap ,qref-keymap))

(setplist 'qref-button
	  `(face (:foreground "LightGray"
		  :background "DarkOliveGreen4")
	    active-face (:background "Orange")
	    mouse-face (:foreground "green")
	    keymap ,qref-keymap))



;;;;
;;;; highlighting the link and showing its action
;;;;

(setq qref-overlay nil)

(defun qref-point-at-link-p ()
  (get-text-property (point) 'action))

(defun qref-point-at-overlay-p ()
  (if qref-overlay
      (memq qref-overlay (overlays-at (point)))))

(defun qref-destroy-overlay ()
  (delete-overlay qref-overlay)
  (setq qref-overlay nil))

(defun qref-create-overlay ()
  (setq qref-overlay
	(make-overlay (previous-char-property-change (1+ (point)))
		      (next-char-property-change (point))))
  (overlay-put qref-overlay 'face
	       (get-text-property (point) 'active-face)))

(defun qref-show-target ()
  (message (ee-pp1 (get-text-property (point) 'action))))

(defun qref-highlight-current-link ()
  (if qref-overlay
      (qref-destroy-overlay))
  (when (qref-point-at-link-p)
    (qref-create-overlay)
    (qref-show-target)))




;;;;
;;;; <f3>
;;;;

(setq ttp-good-properties '(category action face))

(defun tpack (start end)
  (interactive "r")
  (ttp-pack start end))
  
(defun tunpack (start end)
  (interactive "r")
  (ttp-filter-keep start end ttp-good-properties)
  (ttp-unpack start end))

(defun tflip (start end)
  (interactive "r")
  (cond ((eq current-prefix-arg 1) (tpack start end))
	((eq current-prefix-arg 2) (tunpack start end))
	(t (error "Bad prefix arg; must be 1 to pack or 2 to unpack"))))

(eeb-define 'eeb-tpack   'tpack    'ee-delimiter-semicolon   nil t t)
(eeb-define 'eeb-tunpack 'tunpack  'ee-delimiter-semicolon   nil t t)
(eeb-define 'eeb-tflip   'tflip    'ee-delimiter-semicolon   nil t t)



;;;;
;;;; Tests / demos
;;;;

;; (find-efunction 'yank)
;; (find-efunction 'insert-for-yank-1)
;; (find-efunction 'remove-yank-excluded-properties)
;; (find-es "emacs" "flet")
;;
(defun ttp-yank (&optional arg)
  (interactive "*P")
  (flet ((remove-yank-excluded-properties (start end)))
    (yank arg)))

(defun ttp-mode (arg)
  "Determine if links are highlighted and targets shown or not."
  (interactive "p")
  (if (> arg 0)
      (add-hook  'post-command-hook 'qref-highlight-current-link nil 'local)
    (remove-hook 'post-command-hook 'qref-highlight-current-link nil 'local)))

;; (add-hook    'post-command-hook 'qref-highlight-current-link nil 'local)
;; (remove-hook 'post-command-hook 'qref-highlight-current-link nil 'local)

(defun pq (text category action)
  (propertize text 'category category 'action action))

'
(insert "\n;;*\n"
	";; (ttp-mode 1)\n"
        ";; (setq eeb-defaults eeb-tflip)\n"
        (pq "'foo" 'qref-button '(next-line 1))     "\n"
	(pq "'foo" 'qref-button '(previous-line 1)) "\n"
        ";;*\n"
	)

;; (find-elnode "Special Properties" "`invisible'")
;; (find-elnode "Sticky Properties")
;; (find-elnode "Invisible Text" "main editing loop moves point")


'
(insert "\n;;*\n"
	";; (ttp-mode 1)\n"
        ";; (setq eeb-defaults eeb-tflip)\n"
        (pq "'foo" 'qref-button '(next-line 1))     "\n"
	(pq "'foo" 'qref-button '(previous-line 1)) "\n"
        ";;*\n"
	)