(defun ee-concat (list &optional sep)
(setq list (ee-flatten list))
(or sep (setq sep "\n"))
(setq list (mapcar (lambda (str) (concat str sep)) list))
(apply 'concat list))
(defun find-elinks (list &rest rest)
(let ((ee-buffer-name "*Elisp hyperlinks*"))
(apply 'find-estring (ee-concat list) rest)))
(defun ee-pp0 (object &optional tick)
(let ((str (let ((print-escape-newlines t)
(print-escape-nonascii t) (print-quoted t))
(prin1-to-string object))))
(setq str (replace-regexp-in-string "\r" "\\\\r" str))
(if (and tick (consp object))
(setq str (concat "'" str)))
str))
(defun eemakelinks-eboundkey (key f)
(list (ee-pp0 `(where-is ',f))
(ee-pp0 `(describe-function ',f))
(ee-pp0 `(find-efunctiondescr ',f))
(ee-pp0 `(find-efunction ',f))
(ee-pp0 `(find-efunctionpp ',f))
(ee-pp0 `(find-estring (documentation ',f)))
(ee-pp0 `(find-estring (documentation ',f t)))
""
(ee-pp0 `(describe-key ,key))
(ee-pp0 `(describe-key-briefly ,key))
(ee-pp0 `(find-ekeydescr ,key))
(ee-pp0 `(Info-goto-emacs-key-command-node ,key))
(ee-pp0 `(Info-goto-emacs-command-node ',f))
(ee-pp0 `(find-enode "Command Index" ,(format "* %S:" f)))
(ee-pp0 `(find-elnode "Index" ,(format "* %S:" f)))
""
(ee-pp0 `(key-description ,key))
(ee-pp0 `(format-kbd-macro ,key))
(ee-pp0 `(format-kbd-macro ,key t))
(ee-pp0 `(key-binding ,key))
))
(defun eemakelinks-efunction (f)
(list (ee-pp0 `(where-is ',f))
(ee-pp0 `(describe-function ',f))
(ee-pp0 `(find-efunctiondescr ',f))
(ee-pp0 `(find-efunction ',f))
(ee-pp0 `(find-efunctionpp ',f))
(ee-pp0 `(find-estring (documentation ',f)))
(ee-pp0 `(find-estring (documentation ',f t)))
""
(if (commandp f)
(list (ee-pp0 `(Info-goto-emacs-command-node ',f))
(ee-pp0 `(find-enode "Command Index" ,(format "* %S:" f)))
))
(ee-pp0 `(find-elnode "Index" ,(format "* %S:" f)))
))
(defun eemakelinks-evariable (var)
(list (ee-pp0 var)
(ee-pp0 `(describe-variable ',var))
(ee-pp0 `(find-evardescr ',var))
(ee-pp0 `(find-evariable ',var))
(ee-pp0 `(find-epp ,var))
""
(ee-pp0 `(find-enode "Variable Index" ,(format "* %S:" var)))
(ee-pp0 `(find-elnode "Index" ,(format "* %S:" var)))
))
(defun find-ekey-links (key &rest rest)
(interactive "kElisp hyperlinks for key: ")
(let ((longkey (format-kbd-macro key))
(longkey+ (replace-regexp-in-string "[ \t][ \t]+" " "
(format-kbd-macro key t)))
(binding (key-binding key)))
(apply 'find-elinks
(list (ee-pp0 `(find-ekey-links ,key))
(ee-pp0 `(find-elongkey-links ,longkey))
(ee-pp0 `(find-elongkey-links ,longkey+))
(ee-pp0 longkey+)
""
(eemakelinks-eboundkey key binding))
rest)))
(defun find-elongkey-links (longkey &rest rest)
(interactive "sElisp hyperlinks for key (long format): ")
(let* ((key (read-kbd-macro longkey))
(binding (key-binding key)))
(apply 'find-elinks
(list (ee-pp0 `(find-elongkey-links ,longkey))
(ee-pp0 `(find-ekey-links ,key))
""
(eemakelinks-eboundkey key binding))
rest)))
(defun find-efunction-links (f &rest rest)
(interactive (find-function-read))
(apply 'find-elinks
(list (ee-pp0 `(find-efunction-links ',f))
""
(eemakelinks-efunction f))
rest))
(defun find-evariable-links (var &rest rest)
(interactive (find-function-read 'variable))
(apply 'find-elinks
(list (ee-pp0 `(find-evariable-links ',var))
""
(eemakelinks-evariable var))
rest))
(defun ee-filter (function list)
"Return a sublist of LIST with only the elements for which (FUNCTION elt) is true."
(let (newlist)
(while (consp list)
(if (funcall function (car list))
(setq newlist (cons (car list) newlist)))
(setq list (cdr list)))
(nreverse newlist)))
(defun ee-prefixp (prefix str)
"Return t if STR begins with PREFIX."
(and (<= (length prefix) (length str))
(equal prefix (substring str 0 (length prefix)))))
(defun code-c-d-prefixes (path)
"Return the entries (C D) in `code-c-d-list' for which D is a prefix of PATH."
(ee-filter (lambda (c-d) (ee-prefixp (car (cdr c-d)) path))
code-c-d-list))
(defun ee-remove-prefix (prefix str)
(substring str (length prefix)))
(defun eemakelinks-findxxxfile-1 (c d path)
(list (intern (format "find-%sfile" c))
(ee-remove-prefix d path)))
(defun eemakelinks-findxxxfile (path)
(mapcar (lambda (c-d) (ee-pp0 (eemakelinks-findxxxfile-1
(car c-d) (nth 1 c-d) path)))
(code-c-d-prefixes path)))
(defun find-file-links (fname &rest rest)
(interactive (list (or (buffer-file-name) default-directory)))
(apply 'find-elinks
(list (ee-pp0 `(find-file-links ,fname))
""
(ee-pp0 `(find-fline ,fname))
""
(eemakelinks-findxxxfile (ee-expand fname)))
rest))
(defun find-einfo-links (&rest rest)
(interactive)
(let* ((book+ (with-current-buffer "*info*" Info-current-file))
(book- (file-name-nondirectory book+))
(code- (file-name-nondirectory ee-info-file))
(code (if (string= book- code-) code-))
(find-xxxnode (if code (read (format "find-%snode" ee-info-code))))
(node (with-current-buffer "*info*" Info-current-node))
(booknode (format "(%s)%s" book- node)))
(apply 'find-elinks
(list (ee-pp0 '(find-einfo-links))
""
(ee-pp0 `(info ,booknode))
(ee-pp0 `(find-node ,booknode))
(if find-xxxnode (ee-pp0 `(,find-xxxnode ,node))))
rest)))
(defun eemklinks-manpage-name (&optional bufname)
(if (null bufname)
(setq bufname (buffer-name)))
(and bufname
(string-match "^\\*Man \\(.*\\)\\*$" bufname)
(match-string 1 bufname)))
(defun find-last-manpage-links (manpagename &rest rest)
(interactive (list (eemklinks-manpage-name)))
(apply 'find-elinks
(list (ee-pp0 `(find-man-links ,manpagename))
""
(ee-pp0 `(find-man ,manpagename)))
rest))
(defun find-manpage-links (manpagename &rest rest)
(interactive (list (ee-manpagename-ask)))
(apply 'find-elinks
(list (ee-pp0 `(find-man-links ,manpagename))
""
(ee-pp0 `(find-man ,manpagename)))
rest))
(defun ee-dfs0 (pkg ext)
(let ((fname (concat pkg "." ext)))
(if (file-exists-p (ee-vldifile fname))
(format "(find-vldifile \"%s\")" fname))))
(defun eemakelinks-debpkg (pkg)
(list (format "(find-status \"%s\")" pkg)
(format "(find-vldifile \"%s.list\")" pkg)
(format "(find-udfile \"%s/\")" pkg)))
(defun eemakelinks-debpkg-extra-vldi (pkg)
(list (ee-dfs0 pkg "preinst") (ee-dfs0 pkg "postinst")
(ee-dfs0 pkg "prerm") (ee-dfs0 pkg "postrm")
(ee-dfs0 pkg "conffiles") (ee-dfs0 pkg "config")
(ee-dfs0 pkg "templates")
(ee-dfs0 pkg "md5sums") (ee-dfs0 pkg "shlibs")))
(defun find-debpkg-links (pkgname &rest rest)
(interactive (list (ee-debpkgname-ask)))
(apply 'find-elinks
(list (ee-pp0 `(find-debpkg-links ,pkgname))
""
(ee-pp0 `(find-available ,pkgname))
""
(eemakelinks-debpkg pkgname)
""
(eemakelinks-debpkg-extra-vldi pkgname)
""
(concat "http://packages.debian.org/" pkgname)
(concat "http://packages.debian.org/src:" pkgname)
(if (string-match "^\\(lib\\)?." pkgname)
(format "http://ftp.debian.org/debian/pool/main/%s/%s/"
(match-string 0 pkgname) pkgname))
(format "http://bugs.debian.org/cgi-bin/pkgreport.cgi?which=pkg&data=%s&archive=no" pkgname))
rest))
(defun eemklinks-yank-pos-spec ()
(interactive)
(goto-char (1- (point-at-eol))) (insert " " (ee-pp0 (ee-no-properties (car kill-ring)))))
(defun eemklinks-duplicate-this-line ()
(interactive)
(let ((line (buffer-substring (ee-bol) (ee-eol))))
(save-excursion (beginning-of-line) (insert line "\n"))))
(defvar ee-comment-prefix nil)
(make-variable-buffer-local 'ee-comment-prefix)
(defun ee-comment-prefix ()
(or ee-comment-prefix "#")) (defun ee-set-comment-prefix (value)
(interactive "Xee-comment-prefix (in Lisp): ")
(set (make-variable-buffer-local 'ee-comment-prefix) value))
(defun ee-no-properties (str)
(setq str (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)))
(infofile-nondirectory (file-name-nondirectory infofile))
(parenstr (if code "" (format "(%s)" infofile-nondirectory))))
(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-udfile \"%s/\")")
prefix pkgname prefix pkgname prefix pkgname))
(next-line 1))))
(defun ee-ill (N)
(interactive "p")
(dotimes (i N)
(beginning-of-line)
(if (looking-at "^\\(.*\\)\n\\1/")
(delete-region (point) (progn (forward-line 1) (point)))
(cond ((looking-at
"^[^\n]*/man./\\([^\n\t /]+\\)\\.\\([0-9A-Za-z]+\\)\\.gz$")
(replace-match (format "%s (find-man \"%s %s\")"
(ee-comment-prefix)
(match-string 2)
(match-string 1)) t t))
((looking-at "^/usr/share/doc/\\(.*\\)")
(replace-match (format "%s (find-udfile \"%s\")"
(ee-comment-prefix)
(match-string 1)) t t))
((looking-at "^\\([^\n]*\\)$")
(replace-match (format "%s (find-fline \"%s\")"
(ee-comment-prefix)
(match-string 1)) t t)))
(forward-line 1))))
«»