;;; eev-explain.el -- explain an eev sexp.
;; Explain some difficult sexps, like eejump-nnn and code-xxx.
;; This is an experimental feature - I am using it in tutorials and
;; videos.
;; Copyright (C) 2019 Free Software Foundation, Inc.
;;
;; This file is part of GNU eev.
;;
;; GNU eev 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 3 of the License, or
;; (at your option) any later version.
;;
;; GNU eev is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see .
;;
;; Author: Eduardo Ochs
;; Maintainer: Eduardo Ochs
;; Version: 20190806
;; Keywords: e-scripts
;;
;; Latest version:
;; htmlized:
;; See also:
;;
;; (find-eev-intro)
;;; Commentary:
;; (load "eev-explain.el")
;; This is very new. Everything is going to change.
;;
;; Terminology: a "bet" is a triple of the form (begin end text); the
;; global variable `ee-bets' holds a list of bets.
;;
;; The tests below show some of the things we do with ee-bets:
;;
;; (defun eejump-100 () (set-frame-font "nil2"))
;; (progn (eek " C-e") (ee-bets-set))
;; (progn (eek "2* C-e") (cdr (ee-bets-set)))
;; ee-bets
;; (ee-bets-text 0)
;; (ee-bets-text 1)
;; (ee-bets-text 2)
;; (ee-bets-flash 0)
;; (ee-bets-flash 2)
;; (ee-bets-flash 2 7 0)
;; (ee-bets-flash 2 7 0 nil 'eepitch-star-face)
;; (ee-bets-flash 3)
;; (ee-bets-flash 4)
;;
;; (ee-explain-eejump)
;; (eev-explain)
;;; _ _
;;; | |__ ___| |_ ___
;;; | '_ \ / _ \ __/ __|
;;; | |_) | __/ |_\__ \
;;; |_.__/ \___|\__|___/
;;;
(defun ee-forward-sexp1 ()
"Like `ee-forward-sexp' but returns point on success and nil on error."
(interactive)
(condition-case nil
(progn (ee-forward-sexp) (point))
(error nil)))
(defun ee-forward-sexp3 ()
"Like `ee-forward-sexp1' but returns (pos1 pos2 text), or nil on error."
(interactive)
(looking-at "[ \t\n]*\\(;[^\n]*\n[ \t\n]*\\)*")
(goto-char (match-end 0)) ; skip whitespace and comments
(let ((pos1 (point)))
(if (ee-forward-sexp1)
(let* ((pos2 (point))
(text (buffer-substring-no-properties pos1 pos2)))
(list pos1 pos2 text)))))
(defun ee-forward-sexp3s ()
"Like `ee-forward-sexp3' but returns a list of triples like (begin end text)."
(interactive)
(let ((bets ()))
(catch 'no-more-sexps
(while t
(let ((bet (ee-forward-sexp3)))
(if bet
(setq bets (cons bet bets))
(throw 'no-more-sexps nil)))))
(reverse bets)))
(defun ee-subsexps-before-point ()
(save-excursion
(ee-backward-sexp)
(let ((whole-sexp (save-excursion (ee-forward-sexp3))))
(when (eq (following-char) (aref "(" 0))
(forward-char 1)
(cons whole-sexp (ee-forward-sexp3s))))))
(defvar ee-bets ()
"A list of triples of the form (begin end text) corresponding
to the subsexps of the sexp before point.")
(defun ee-bets-set ()
(interactive)
(setq ee-bets (ee-subsexps-before-point)))
(defun ee-bets-begin (n) (nth 0 (nth n ee-bets)))
(defun ee-bets-end (n) (nth 1 (nth n ee-bets)))
(defun ee-bets-text (n) (nth 2 (nth n ee-bets)))
;;; __ _ _
;;; / _| | __ _ ___| |__
;;; | |_| |/ _` / __| '_ \
;;; | _| | (_| \__ \ | | |
;;; |_| |_|\__,_|___/_| |_|
;;;
;; (find-es "emacs" "set-string-face")
;; (find-angg ".emacs" "find-epalette")
;; (find-efaces)
;; (find-ecolors)
(defun ee-set-string-property (str property-name value)
(put-text-property 0 (length str) property-name value str)
str)
(defun ee-set-string-face (str &optional face)
(ee-set-string-property str 'face face))
(defun ee-set-string-fg (str &optional fg)
(ee-set-string-face str (cons 'foreground-color fg)))
(defun ee-bets-flash (n &optional b-adj e-adj spec face)
(let* ((b (+ (or b-adj 0) (nth 0 (nth n ee-bets))))
(e (+ (or e-adj 0) (nth 1 (nth n ee-bets))))
(text (buffer-substring-no-properties b e))
)
(eeflash+ b e (or spec ee-highlight-spec))
(if face (ee-set-string-face text face))
text))
;; The `ee-explain' functions.
;; They work on the current value of the variable `ee-bets'.
;; Tests:
;;
;; (defun eejump-100 () (set-frame-font "nil2"))
;; (progn (eek " C-e") (cdr (ee-bets-set)))
;;
;; (find-2a nil '(find-estring (ee-explain-eejump)))
;;
;; (code-c-d "ud" "/usr/share/doc/")
;; (progn (eek " C-e") (cdr (ee-bets-set)))
;;
;; (find-2a nil '(find-estring (ee-explain-code-c-d)))
;; (buffer-substring 1 10)
(defun ee-explain-eejump ()
(when (and (equal "defun" (ee-bets-text 1))
(string-match "^eejump-" (ee-bets-text 2)))
(ee-bets-flash 2 7 0)
(ee-bets-flash 4)
(format "The sexp %s
Makes `M-%sj' execute this one-liner: %s
See: (find-eev-quick-intro \"7.1. `eejump'\")"
(ee-bets-text 0)
(substring (ee-bets-text 2) 7)
(ee-bets-text 4))))
(defun ee-explain-code-c-d ()
(when (equal "code-c-d" (ee-bets-text 1))
(ee-bets-flash 2 1 -1)
(ee-bets-flash 3 1 -1)
(let* ((c (substring (ee-bets-text 2) 1 -1))
(d (substring (ee-bets-text 3) 1 -1))
(cpos (- (ee-bets-begin 2) (ee-bets-begin 0)))
(dpos (- (ee-bets-begin 3) (ee-bets-begin 0)))
)
(format "The sexp %s
makes: (find-%sfile \"FNAME\")
act as: (find-fline \"%sFNAME\")
See: (find-eev-quick-intro \"9.1. `code-c-d'\")"
(ee-bets-text 0)
c
d))))
(defun ee-explain-code-c-d ()
(when (equal "code-c-d" (ee-bets-text 1))
(let* ((c (ee-bets-flash 2 1 -1 nil 'eepitch-star-face))
(d (ee-bets-flash 3 1 -1))
)
(format "The sexp %s
makes: (find-%sfile \"FNAME\")
act as: (find-fline \"%sFNAME\")
See: (find-eev-quick-intro \"9.1. `code-c-d'\")"
(ee-bets-text 0)
c
d))))
;; (substring "abcdef" 1 -1)
;; (substring "abcdef" 1 nil)
;; (substring "abcdef" nil nil)
;; (substring "abcdef" 0 -1)
(defun eev-explain ()
(interactive)
(let ((ee-buffer-name "*eev-explain*")
(str (or (ee-explain-eejump)
(ee-explain-code-c-d)
(ee-explain-code-pdf-page)
)
))
(if str
(find-2a nil '(find-estring str)))))
;; (defun eejump-100 () (set-frame-font "nil2"))
;; (progn (eek " C-e") (ee-bets-set))
;; ee-bets
;;
;; (ee-explain-eejump)
;; (eev-explain)
(provide 'eev-explain)
;; Local Variables:
;; coding: utf-8-unix
;; no-byte-compile: t
;; End: