;; Copyright (C) 1999, 2000, 2004 Free Software Foundation, Inc.

;; Author:     Eduardo Ochs <edrx@mat.puc-rio.br>
;; Maintainer: Eduardo Ochs <edrx@mat.puc-rio.br>
;; Version:    2004mar23
;; Keywords:   help, hypertext, hyperlinks, e-scripts, shell, tex
;;
;; This file was copylefted to prevent against patent psychopaths; if
;; you want a version with any other license you'll have to write it
;; yourself. More formally,
;;
;; 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 of the
;; License, or (at your option) any later version.

;;; Commentary:

;; This is an interim release! Eev is being rewritten.
;; The comments and docstrings will come back soon.
;; If you miss them then take a look at the "old/" directory.

;; I usually do the work on the code of eev using this file, that
;; doesn't have docstrings or comments and is not split into several
;; small files - thus, `eev-dev.el'.

;; In any non-hackers-only release of eev (not this one!) the code in
;; this file should be equivalent to code of `eev-links.el',
;; `eev-mklinks.el', `eev-scripts.el', `eev-gud.el', and
;; `eev-invasive.el' combined.



;;;;;
;;
;; Hyperlinks
;;
;;;;;

(defun ee-goto-position (&optional pos-spec &rest rest)
  (if (or pos-spec rest)
      (goto-char (point-min)))
  (when pos-spec
    (cond ((numberp pos-spec)
           (forward-line (1- pos-spec)))
          ((stringp pos-spec)
           (search-forward pos-spec))
          (t (error "This is not a valid pos-spec: %S" pos-spec)))
    (if rest (ee-goto-rest rest))))

(defun ee-goto-rest (list)
  (cond ((stringp (car list))
         (search-forward (car list))
         (ee-goto-rest (cdr list)))))



(defun ee-substitute-in-file-name (fname)
  (if (string-match "^\\$\\([A-Za-z_][0-9A-Za-z_]*\\)\\(.*\\)" fname)
      (concat (getenv (match-string 1 fname))
              (match-string 2 fname))
    fname))

(defun find-fline (fname &rest pos-spec-list)
  (find-file (ee-substitute-in-file-name fname))
  (apply 'ee-goto-position pos-spec-list))

(autoload 'Info-goto-node "info")

(defun find-node (nodestr &rest pos-spec-list)
  (if (Info-goto-node nodestr)
      (apply 'ee-goto-position pos-spec-list)))



(defmacro ee-same-window (samewindowbuffername &rest body)
  `(let ((same-window-buffer-names
         (cons ,samewindowbuffername same-window-buffer-names)))
    (progn . ,body)
    (switch-to-buffer ,samewindowbuffername)))

(defun find-efunction (symbol &rest rest)
  (interactive (find-function-read))
  (let ((location (find-function-noselect symbol)))
    (switch-to-buffer (car location))
    (goto-char (cdr location))
    (ee-goto-rest rest)))

(defun find-evariable (symbol &rest rest)
  (interactive (find-function-read 'variable))
  (let ((location (find-variable-noselect symbol)))
    (switch-to-buffer (car location))
    (goto-char (cdr location))
    (ee-goto-rest rest)))

(defun find-efunctiondescr (symbol &rest rest)
  (interactive (find-function-read))
  (ee-same-window "*Help*" (describe-function symbol))
  (apply 'ee-goto-position rest))

(defun find-evariabledescr (symbol &rest rest)
  (interactive (find-function-read 'variable))
  (ee-same-window "*Help*" (describe-variable symbol))
  (apply 'ee-goto-position rest))

(defun find-ekeydescr (key &rest rest)
  (interactive "kFind function on key: ")
  (ee-same-window "*Help*" (describe-key key))
  (apply 'ee-goto-position rest))

(defalias 'find-evardescr 'find-evariabledescr)

(defun find-efacedescr (face &rest rest)
  (interactive (list (read-face-name "Describe face")))
  (ee-same-window "*Help*" (describe-face face))
  (apply 'ee-goto-position rest))

(defun find-efaces (&rest rest)
  (interactive)
  (ee-same-window "*Faces*" (list-faces-display))
  (apply 'ee-goto-position rest))

(defun find-etpat (&rest rest)
  (interactive)
  (let ((tpat (text-properties-at (point)))
        (buffername "*(text-properties-at (point))*"))
    (if (bufferp buffername) (kill-buffer buffername))
    (switch-to-buffer buffername)
    (insert "(text-properties-at (point))\n   ==>\n")
    (pp tpat (current-buffer))
    (apply 'ee-goto-position rest)))



(defun find-progoutput (command &rest pos-spec-list)
  (interactive "sShell command: ")
  (if (get-buffer command)              ; if the buffer already exists
      (switch-to-buffer command)        ; then just switch to it
    (switch-to-buffer command)          ; otherwise create it
    (insert (shell-command-to-string command)) ; prepare its contents
    (goto-char (point-min)))            ; and place point at its beginning
  (apply 'ee-goto-position pos-spec-list))



(defvar ee-find-man-flag nil)
(defvar ee-find-man-pos-spec-list nil)

(defadvice Man-notify-when-ready (around find-man (man-buffer) activate)
  (if (not ee-find-man-flag)
      ad-do-it
    (switch-to-buffer man-buffer)
    (apply 'ee-goto-position ee-find-man-pos-spec-list)
    (setq ee-find-man-flag nil)))

(defun find-man (manpage &rest pos-spec-list)
  (setq ee-find-man-flag t
        ee-find-man-pos-spec-list pos-spec-list)
    (man manpage))



(defun find-dvipage (fname n)
  (let ((command (format "xdvi +%d %s &" n fname)))
    (eev command nil)
    command))

(defun find-pspage (fname n)
  (let ((command (format "gv -page %d %s &" n fname)))
    (eev command nil)
    command))



(defun find-Package (fname &optional packagename &rest rest)
  (find-fline fname)
  (if packagename
      (apply 'ee-goto-position (format "\nPackage: %s\n" packagename) rest)))

(defun find-status (packagename &rest rest)
  (interactive "sPackage name: ")
  (apply 'find-Package "/var/lib/dpkg/status" packagename rest))

(defun find-available (packagename &rest rest)
  (interactive "sPackage name: ")
  (apply 'find-Package "/var/lib/dpkg/available" packagename rest))

(defun find-availablegrep (grepargs &rest rest)
  (interactive "sgrep-available ")
  (apply 'find-progoutput (concat "grep-available " grepargs) rest))



(defun find-anchor (fname &optional tag &rest rest)
  (find-fline fname)
  (if tag (apply 'ee-goto-position (format ee-anchor-format tag) rest)))

(defun ee-to (anchor &rest rest)
  (interactive "sAnchor: ")
  (apply 'ee-goto-position (format ee-anchor-format anchor) rest))



(defun find-w3m (url &rest rest)
  (interactive "Murl: ")
  (let ((enable-local-variables nil))   ; work-around for a w3m-el bug
    (w3m (ee-substitute-in-file-name url)))
  (ee-goto-rest rest))




;;;;;
;;
;; creating hyperlink functions
;;
;;;;;

(defun ee-eval-read-format (formatstr &rest rest)
  (let ((s (apply 'format (concat "(progn " formatstr ")") rest)))
    (if (not ee-arg)
        (eval (read s))
      (insert "\n" s))))

(defun code-ps (code psfile)
  (ee-eval-read-format
   "(defun find-%spage (n &rest comments) (find-pspage %S n))"
   code psfile))

(defun code-dvi (code dvifile)
  (ee-eval-read-format
   "(defun find-%spage (n &rest comments) (find-dvipage %S n))"
   code dvifile))



(defun ee-find-tag (tag &rest pos-spec-list)
  (let ((tags-add-tables nil))
    (find-tag tag))
  (ee-goto-rest pos-spec-list))

(defvar ee-info-file nil)
(defvar ee-info-code nil)

(defun ee-find-codenode (code infofile nodename &rest pos-spec-list)
  (if code (setq ee-info-code code
                 ee-info-file infofile))
  (apply 'find-node (format "(%s)%s" infofile nodename) pos-spec-list))

(defun code-c-d (c d &optional infofile)
  (ee-eval-read-format "
    (setq ee-%sdir \"%s\")
    (setq ee-%stagsfile \"%sTAGS\")
    (defun ee-%sfile (str)
      (concat (ee-substitute-in-file-name ee-%sdir) str))
    (defun ee-use-%s-tags ()
      (setq tags-file-name ee-%stagsfile))
    (defun find-%sfile (str &rest pos-spec-list)
      (ee-use-%s-tags)
      (apply 'find-fline (ee-%sfile str) pos-spec-list))
    (defun find-%stag (str &rest pos-spec-list)
      (ee-use-%s-tags) (apply 'ee-find-tag str pos-spec-list))
    (defun find-%sw3m (furl &rest pos-spec-list)
      (apply 'find-w3m (ee-%sfile furl) pos-spec-list))
    (setq ee-info-code %S)
    (setq ee-info-file %S)
    " c d  c d  c c  c c  c c c  c c  c c  c infofile)
  (if infofile
     (ee-eval-read-format "
       (defun find-%snode (nodename &rest pos-spec-list)
          (apply 'ee-find-codenode %S %S nodename pos-spec-list))"
                          c c infofile)))

(defun code-c-d-anchor (c d &optional infofile)
  (code-c-d c d infofile)
  (ee-eval-read-format "(defun find-%s (file &rest rest)
    (apply 'find-anchor (ee-%sfile file) rest))" c c))

(defun code-c-d-linux (c d)
  (code-c-d c d)
  (ee-eval-read-format "(defun find-%sconfvar (var &rest rest)
    (apply 'find-%sfile \"Documentation/Configure.help\"
           (concat \"\\n\" var \"\\n\") rest))" c c))

(defun code-c-d-gdb (c d &optional infofile)
  (code-c-d c d infofile)
  (ee-eval-read-format "
    (defun eegud-%sgdb-bounded (once &optional fname)
      (ee-use-%s-tags)
      (eegud-gdb-bounded (once ee-%sdir fname)))" c c c))



;;;;;
;;
;; inserting hyperlinks
;;
;;;;;

(defvar ee-comment-prefix nil)
(make-variable-buffer-local 'ee-comment-prefix)
(defun  ee-comment-prefix ()
  (or ee-comment-prefix "#"))           ; to do: mode -> "#"/"%"/" *"/"--"


(defun ee-no-properties (str)
  (setq stq (copy-sequence str))
  (set-text-properties 0 (length str) nil str)
  str)


(defun ee-info-file-code (infofile)
  (if (and infofile
           ee-info-file
           (string= (file-name-nondirectory infofile)
                    (file-name-nondirectory ee-info-file)))
      ee-info-code))

(defun ee-string-to-posspec (str)
  (if str (replace-regexp-in-string "\n" "\\\\n" (format " %S" str))
    ""))

(defun ee-info-file-link0 (usecode infofile infonode posstr)
  (let* ((code (and usecode (ee-info-file-code infofile)))
         (parenstr (if code "" (format "(%s)" infofile))))
    (format "(find-%snode \"%s%s\"%s)"
            (or code "")
            parenstr
            infonode
            (ee-string-to-posspec posstr))))

(defun ee-info-file-link (usecode posstr)
  (format "%s %s\n"
          (ee-comment-prefix)
          (ee-info-file-link0
           usecode
           (save-excursion (set-buffer "*info*") Info-current-file)
           (save-excursion (set-buffer "*info*") Info-current-node)
           posstr)))

(defun ee-inn (arg)
  (interactive "P")
  (insert (ee-info-file-link arg nil)))

(defun ee-inns (arg)
  (interactive "P")
  (insert (ee-info-file-link arg (ee-no-properties (current-kill 0)))))

(defun ee-delete-and-extract-line ()
  (delete-and-extract-region (progn (beginning-of-line) (point))
                             (progn (end-of-line) (point))))

(defun ee-dfa (N)
  (interactive "p")
  (dotimes (i N)
    (insert (format "%s (find-available \"%s\")"
                    (ee-comment-prefix) (ee-delete-and-extract-line)))
    (next-line 1)))

(defun ee-dff (N)
  (interactive "p")
  (dotimes (i N)
    (let ((pkgname (ee-delete-and-extract-line))
          (prefix (ee-comment-prefix)))
      (insert (format (concat "%s (find-status \"%s\")\n"
                              "%s (find-vldifile \"%s.list\")\n"
                              "%s (find-fline \"/usr/doc/%s/\")")
                      prefix pkgname prefix pkgname prefix pkgname))
      (next-line 1))))



;;;;;
;;
;; saving scripts
;;
;;;;;

(defvar ee-file         "~/eev-0.94/ee.sh")
(defvar ee-file-tex     "~/eev-0.94/ee.tex")
(defvar ee-file-gdb     "~/eev-0.94/ee.gdb")
(defvar ee-file-generic "~/eev-0.94/ee.eeg")

(defvar eelatex-eevscript "cd ~/eev-0.94/; latex tmp.tex && xdvi tmp.dvi &")

(defun ee-se-to-string (s e)
  (cond ((numberp s) (buffer-substring s e))
        ((stringp s) s)))

(defun octal-to-num (str)
  (let ((lastv (- (string-to-char (substring str -1)) ?0))
        (rest (substring str 0 -1)))
    (if (string= "" rest) lastv (+ lastv (* 8 (octal-to-num rest))))))

(defun ee-write-string (str &optional altfile fmode)
  (let ((fname (substitute-in-file-name (or altfile ee-file))))
    (write-region str nil fname)        ; a standard kludge
    (if fmode (set-file-modes fname (octal-to-num fmode)))))

(defun ee-write (s e pre post &optional altfile fmode)
  (ee-write-string (concat pre (ee-se-to-string s e) post)
                   altfile fmode))

(defun ee-se-to-string-with-nl (s e)
  (let ((str (ee-se-to-string s e)))
    (if (string-match "[^\n]\\'" str) (concat str "\n") str)))

(defun ee-write-with-nl (s e pre post &optional altfile fmode)
  (ee-write-string (concat pre (ee-se-to-string-with-nl s e) post)
                   altfile fmode))



(defun eev (s &optional e altfile)
  (interactive "r")
  (ee-write-with-nl s e "" "" altfile)
  (format "eev: wrote %s" (or altfile ee-file)))

(defun eelatex (s &optional e)
  (interactive "r")
  (ee-write s e "" "" ee-file-tex)
  (eev eelatex-eevscript nil)
  (format "eelatex: wrote %s and %s" ee-file-tex ee-file))

(defun eegdb (s &optional e)
  (interactive "r")
  (ee-write s e "" "" ee-file-gdb)
  (format "eegdb: wrote %s" ee-file-gdb))

(defun eeg (s &optional e)
  (interactive "r")
  (ee-write s e "" "" ee-file-generic)
  (format "eeg: wrote %s" ee-file-gdb))


(defun ee-default-directory ()
  (if (eq major-mode 'w3-mode)
      (let ((url (url-view-url 0)))
        (if (string-match "^file:\\(.*/\\)[^/]*$" url)
            (match-string 1 url)
          (error "Current url is %S, which is not a local file" url)))
    default-directory))

(defun eecd (&optional command)
  (interactive)
  (eev (concat "cd " (ee-default-directory) "\n"
               (or command ""))))



;;;;;
;;
;; saving regions between delimiters
;;
;;;;;

(defvar ee-delimiter-hash    "\n#*\n")
(defvar ee-delimiter-percent "\n%*\n")

(defun ee-search-backward (str)
  (+ (save-excursion (search-backward str))
     (length str)))
(defun ee-search-forward (str)
  (- (save-excursion (search-forward str))
     (length str)))

(defvar ee-bounded-function 'eev-bounded)
(defun  ee-bounded (ee-arg)
  (interactive "P")
  (funcall ee-bounded-function))

(defmacro ee-define-bounded (eexxx eexxx-bounded sstr &optional estr)
  `(defun ,eexxx-bounded (&optional once)
     (interactive)
     (if (not once) (setq ee-bounded-function ',eexxx-bounded))
     (,eexxx (ee-search-backward ,sstr)
             (ee-search-forward  ,(or estr sstr)))))

(ee-define-bounded eev     eev-bounded     ee-delimiter-hash)
(ee-define-bounded eeg     eeg-bounded     ee-delimiter-hash)
(ee-define-bounded eegdb   eegdb-bounded   ee-delimiter-hash)
(ee-define-bounded eelatex eelatex-bounded ee-delimiter-percent)




;;;;;
;;
;; gud "hyperlinks"
;;
;;;;;

(if (not (fboundp 'define-minor-mode))  ; for Emacs20
    (defalias 'define-minor-mode 'easy-mmode-define-minor-mode))

(defun eegud-kill-buffer (s)
  (interactive "sConfirm killing: ")
  (let ((buffer (current-buffer)))
    (condition-case nil (delete-window (selected-window)))
    (kill-buffer buffer)))

(define-minor-mode eegud-keys-mode
 "eegud keys mode"
 nil
 " eegudk"
 '(("\M-s" . gud-step)
   ("\M-n" . gud-next)
   ("\M-c" . gud-cont)
   ("\M-f" . gud-finish)
   ("\M-k" . eegud-kill-buffer)))

(defun eegud-gdb-bounded (once dir &optional fname)
  (eegdb-bounded once)
  (gdb (format "gdb %s%s" dir (or fname "")))
  (eegud-keys-mode))

(defun eegud-perldb-bounded (once dir &optional fname)
  (if do-eeg-bounded (eeg-bounded))
  (perldb (format "perl %s%s" dir (or rest "")))
  (eegud-keys-mode))




;;;;;
;;
;; eval-sexp-eol
;;
;;;;;

(defvar ee-arg nil)

(defun ee-eval-sexp-eol (ee-arg)        ; this ee-arg shadows the global one
  (interactive "P")
  (end-of-line)
  (eval-last-sexp nil))




;;;;;
;;
;; functions to invade the global keymap and namespace
;;
;;;;;

(defun ee-invade-global-keymap ()
  (interactive)
  (global-set-key "\M-e" 'ee-eval-sexp-eol)
  (global-set-key "\M-E" 'ee-eval-sexp-eol)
  (global-set-key "\M-k" 'kill-buffer)
  (global-set-key "\M-A" 'back)
  (global-set-key [f3]   'ee-bounded))

(defun ee-invade-global-namespace ()
  (interactive)
  (defalias 'to   'ee-to)
  (defalias 'back 'ee-back)
  (defalias 'inn  'ee-inn)
  (defalias 'inns 'ee-inns)
  (defalias 'dff  'ee-dff)
  (defalias 'dfa  'ee-dfa))




;;;;;
;;
;; the "(eev)" entry in the menubar
;;
;;;;;

(defvar menu-bar-eev-menu (make-sparse-keymap "(eev)"))
(define-key menu-bar-eev-menu   [ee-eval-sexp-eol]
  '("ee-eval-sexp-eol (M-e)"   . ee-eval-sexp-eol))
(define-key menu-bar-eev-menu   [eval-last-sexp]
  '("eval-last-sexp (C-x C-e)" . eval-last-sexp))
(define-key menu-bar-eev-menu   [kill-buffer]
  '("kill-buffer (M-k)"        . kill-buffer))
(define-key menu-bar-eev-menu [separator-eev-menu]
  '("--"))
(define-key menu-bar-eev-menu [tutorial]
  '("eev manual and tutorial" .
    (lambda () (interactive) (find-eevfile "manual.e"))))
(define-key menu-bar-eev-menu [key-help]
  '("main emacs keys" .
    (lambda () (interactive) (find-eevfile "keys.e"))))

(defun ee-invade-global-menu-bar ()
  (interactive)
  (define-key global-map [menu-bar eev] (cons "(eev)" menu-bar-eev-menu)))





;;;;;
;;
;; etc (not used yet)
;;
;;;;;



;; Local Variables:
;; coding:            raw-text-unix
;; ee-anchor-format:  "«%s»"
;; ee-comment-prefix: ";;"
;; End: