;;; eev-wrap.el --- wrap the current line into a hyperlink ;; Copyright (C) 2013,2016,2017,2019,2020 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: 20201206 ;; Keywords: e-scripts ;; ;; Latest version: ;; htmlized: ;; See also: ;; ;; ;; (find-eev-intro) ;; (find-wrap-intro) ;;; Commentary: ;; 2019: all the `define-key's in this file are now commented out. ;; They were moved to: ;; (find-eevfile "eev-mode.el" "eewrap-anchor") ;; «.ee-template0» (to "ee-template0") ;; «.ee-S» (to "ee-S") ;; «.ee-this-line-wrapn» (to "ee-this-line-wrapn") ;; «.find-eewrap-links» (to "find-eewrap-links") (require 'eev-template0) ; (find-eev "eev-template0.el") (defvar ee-hyperlink-prefix "# " "Hyperlinks created by `ee-HS' are prefixed with this. The best way to change this variable interactively is by running `M-x ee-hyperlink-prefix'.") (defvaralias 'ee-H 'ee-hyperlink-prefix) ;;; ____ ;;; ___ ___ / ___| ;;; / _ \/ _ \____\___ \ ;;; | __/ __/_____|__) | ;;; \___|\___| |____/ ;;; ;;; «ee-S» (to ".ee-S") ;; ee-S and ee-HS, for pretty-printing of sexps (mainly for use in ;; ee-template0). ;; Tests: ;; (find-estring (ee-S '(foo "bar\nplic"))) ;; (find-estring (ee-HS '(foo "bar\nplic"))) ;; (find-estring (ee-H "Some string") ;; `(setq a ,(ee-add-quote "foo")) ;; `(setq a ,(ee-add-quote '(+ 1 2))) ;; (ee-S `(setq a ,(ee-add-quote '(+ 1 2)))) ;; (defun ee-S (object) "Convert OBJECT (usually a sexp) into a string, for use in hyperlinks. Quote newlines to make it fit in a single line. The result of this function is always a string that can be `read' as Lisp. The name of this function comes from the \"S\" in `(format \"%S\" )'." (let ((str (let ((print-escape-newlines t) (print-escape-nonascii t) ; isn't escaping esc, \r, etc (print-quoted t)) (prin1-to-string object)))) (replace-regexp-in-string "\r" "\\\\r" str))) (defun ee-HS (object) (concat ee-hyperlink-prefix (ee-S object))) (defun ee-H (str) (format "%s%s" ee-hyperlink-prefix str)) (defun ee-add-quote (obj) "Return OBJ is OBJ is constant; else return 'OBJ." (if (or (numberp obj) (stringp obj) (eq obj nil) (eq obj t) (keywordp obj)) obj (list 'quote obj))) (defalias 'ee-pp0 'ee-S) (defun ee-ppp0 (list) (concat "(" (mapconcat 'ee-pp0 list "\n ") ")\n")) ;; «ee-template0» (to ".ee-template0") ;; Moved to: (find-eev "eev-template0.el") ;;; _ _ _ _ _ ;;; | |_| |__ (_)___ | (_)_ __ ___ ;;; | __| '_ \| / __|_____| | | '_ \ / _ \ ;;; | |_| | | | \__ \_____| | | | | | __/ ;;; \__|_| |_|_|___/ |_|_|_| |_|\___| ;;; ;; «ee-this-line-wrapn» (to ".ee-this-line-wrapn") ;; The main function in this block is `ee-this-line-wrapn' - ;; all the `eewrap-*' functions defined below call it. (defun ee-splitn (n str) "Example: (ee-splitn 3 \"aa bb cc dd ee\") --> (\"aa\" \"bb\" \"cc dd ee\")" (if (= n 1) (list str) (if (string-match "^\\`[ \t]*\\([^ \t]+\\)[ \t]*" str) (cons (match-string 1 str) (ee-splitn (- n 1) (substring str (match-end 0)))) (cons "" (ee-splitn (- n 1) ""))))) (defun ee-this-line-extract () "Delete the contents of the current line and return it as a string." (delete-and-extract-region (ee-bol) (ee-eol))) (defun ee-this-line-extractn (n) "Delete the contents of the current line and return it as a list." (ee-splitn n (ee-no-properties (ee-this-line-extract)))) (defun ee-this-line-wrapn (n f) "Run F on the current line, after splitting it into N strings. F is a function that receives N arguments and returns a string. This function extracts the contents of the curren line, splits it, runs F on the result of the splitting, inserts the result in the place of what was deleted, and moves down one line. If an error happens the original contents are not restored; you have to run an \"undo\"." (insert (apply f (ee-this-line-extractn n))) (ee-next-line 1)) ;;; -------------------- ;;; All the standard wrapping functions, bound to M-UPPERCASE keys. ;;; Note that they are listed in alphabetical order below, and that in ;;; each section the higher level functions come first. ;;; __ __ _ _ ;;; | \/ | / \ _ __ _ _ __ ___| |__ ___ _ __ ;;; | |\/| |_____ / _ \ (_) / _` | '_ \ / __| '_ \ / _ \| '__| ;;; | | | |_____/ ___ \ _ | (_| | | | | (__| | | | (_) | | ;;; |_| |_| /_/ \_(_) \__,_|_| |_|\___|_| |_|\___/|_| ;;; ;; See: (find-eev-quick-intro "8.3. Creating index/section anchor pairs") ;; (find-anchors-intro "Creating index/section anchor pairs") ;; (define-key eev-mode-map "\M-A" 'eewrap-anchor) (defun eewrap-anchor () (interactive) (ee-this-line-wrapn 1 'ee-wrap-anchor)) (defun ee-wrap-anchor (line) "An internal function used by `eewrap-anchor'." (if (string-match "^\\(.*\\)<\\([^<>]*\\)>" line) (ee-wrap-anchor0 (match-string 1 line) (match-string 2 line)) (error "Does not match"))) (defun ee-wrap-anchor0 (prefix anchor) "An internal function used by `ee-wrap-anchor'." (ee-template0 (ee-tolatin1 "\ {prefix}«.{anchor}»\t(to \"{anchor}\") {prefix}«{anchor}» (to \".{anchor}\")"))) ;;; __ __ _ _ _ _ _ _ ;;; | \/ | | |__ _ ___ ___ ___ _ __(_)_ __ | |_ | |__ | | | __ ;;; | |\/| |_____| '_ (_) / _ \/ __|/ __| '__| | '_ \| __| | '_ \| | |/ / ;;; | | | |_____| |_) | | __/\__ \ (__| | | | |_) | |_ | |_) | | < ;;; |_| |_| |_.__(_) \___||___/\___|_| |_| .__/ \__| |_.__/|_|_|\_\ ;;; |_| ;; ;; See: (find-eev-quick-intro "8.4. Creating e-script blocks") ;; (define-key eev-mode-map "\M-B" 'eewrap-escript-block) (defun eewrap-escript-block () (interactive) (ee-this-line-wrapn 2 'ee-wrap-escript-block)) (defun ee-wrap-escript-block (anchor title &optional date) "An internal function used by `ee-wrap-escript-block'." (setq date (or date (downcase (format-time-string "%Y%b%d")))) (if (equal title "") (setq title anchor)) (ee-template0 (ee-tolatin1 "\ ##### # # {title} # {date} # ##### # «.{anchor}»\t(to \"{anchor}\") # «{anchor}» (to \".{anchor}\")"))) ;;; __ __ ____ _ _ ;;; | \/ | / ___|_ ___ ___ __| | ___ ___ __| | ;;; | |\/| |_____| | (_) / __/ _ \ / _` |/ _ \_____ / __|____ / _` | ;;; | | | |_____| |___ _ | (_| (_) | (_| | __/_____| (_|_____| (_| | ;;; |_| |_| \____(_) \___\___/ \__,_|\___| \___| \__,_| ;;; ;; See: (find-code-c-d-intro) ;; (define-key eev-mode-map "\M-C" 'eewrap-code-c-d) (defun eewrap-code-c-d () (interactive) (ee-this-line-wrapn 2 'ee-wrap-code-c-d)) (defun ee-wrap-code-c-d (c d) "An internal function used by `eewrap-code-c-d'." (ee-template0 "\ \(code-c-d \"{c}\" \"{d}\"\) ;; (find-{c}file \"\")")) ;;; __ __ ____ _ _ _ ;;; | \/ | | _ \ _ __| | ___| |__ (_) __ _ _ __ ;;; | |\/| |_____| | | (_) / _` |/ _ \ '_ \| |/ _` | '_ \ ;;; | | | |_____| |_| |_ | (_| | __/ |_) | | (_| | | | | ;;; |_| |_| |____/(_) \__,_|\___|_.__/|_|\__,_|_| |_| ;;; ;; (define-key eev-mode-map "\M-D" 'eewrap-debian) (defun eewrap-debian () (interactive) (ee-this-line-wrapn 1 'ee-wrap-debian)) (defun ee-wrap-debian (stem) (ee-template0 "\ {ee-H}(find-status \"{stem}\") {ee-H}(find-vldifile \"{stem}.list\") {ee-H}(find-udfile \"{stem}/\")")) ;;; __ __ _____ __ _ _ ;;; | \/ | | ___| / _(_) | ___ ;;; | |\/| |_____| |_ (_) | |_| | |/ _ \ ;;; | | | |_____| _| _ | _| | | __/ ;;; |_| |_| |_| (_) |_| |_|_|\___| ;;; ;; See: (find-wrap-intro "") ;; (define-key eev-mode-map "\M-F" 'eewrap-find-fline) (defun eewrap-find-fline () (interactive) (ee-this-line-wrapn 1 'ee-wrap-find-fline)) (defun ee-wrap-find-fline (fname) "An internal function used by `eewrap-find-fline'." (ee-HS `(find-fline ,fname))) ;;; __ __ _ _ ;;; | \/ | | |_ ___ ___ (_)_ _ _ __ ___ _ __ ;;; | |\/| |_____ _ | (_) / _ \/ _ \| | | | | '_ ` _ \| '_ \ ;;; | | | |_____| |_| |_ | __/ __/| | |_| | | | | | | |_) | ;;; |_| |_| \___/(_) \___|\___|/ |\__,_|_| |_| |_| .__/ ;;; |__/ |_| ;; ;; See: (find-eev-quick-intro "7.1. `eejump'") ;; (find-eev-quick-intro "7.1. `eejump'" "meta-uppercase-j") ;; Old: (find-eejump-intro "Producing `eejump-nnn's and `eejump-nnn*'s") ;; (define-key eev-mode-map "\M-J" 'eewrap-eejump) (defun eewrap-eejump () (interactive) (ee-this-line-wrapn 2 'ee-wrap-eejump)) (defun ee-wrap-eejump (n sexp) "An internal function used by `eewrap-eejump'." (if (string-match-p "^[0-9]+$" n) (if (equal sexp "") (ee-template0 "(defun eejump-{n}* () (find-efunction 'eejump-{n}*))") (ee-template0 "(defun eejump-{n} () {sexp})")) (ee-template0 "(defun {n} () (interactive) {sexp})"))) ;; ;; Old: ;; (defun ee-wrap-eejump (n sexp) ;; "An internal function used by `eewrap-eejump'." ;; (if (equal sexp "") ;; (ee-template0 "(defun eejump-{n}* () (find-efunction 'eejump-{n}*))") ;; (ee-template0 "(defun eejump-{n} () {sexp})"))) ;;; __ __ __ __ ;;; | \/ | | \/ |_ _ __ ___ __ _ _ __ ;;; | |\/| |_____| |\/| (_) | '_ ` _ \ / _` | '_ \ ;;; | | | |_____| | | |_ | | | | | | (_| | | | | ;;; |_| |_| |_| |_(_) |_| |_| |_|\__,_|_| |_| ;;; ;; See: (find-wrap-intro "") ;; (define-key eev-mode-map "\M-M" 'eewrap-man) (defun eewrap-man () (interactive) (ee-this-line-wrapn 1 'ee-wrap-man)) (defun ee-wrap-man (str) "An internal function used by `eewrap-man'." (ee-HS `(find-man ,str))) ;;; __ __ ____ _ __ _ _ _ ;;; | \/ | | _ \ _ _ __ __| |/ _| (_) | _____ ;;; | |\/| |_____| |_) (_) | '_ \ / _` | |_| | | |/ / _ \ ;;; | | | |_____| __/ _ | |_) | (_| | _| | | < __/ ;;; |_| |_| |_| (_) | .__/ \__,_|_| |_|_|_|\_\___| ;;; |_| ;; ;; See: (find-pdf-like-intro) ;; (define-key eev-mode-map "\M-P" 'eewrap-pdflike) (defun eewrap-pdflike () (interactive) (ee-this-line-wrapn 2 'ee-wrap-pdflike)) (defun ee-wrap-pdflike (stem fname) "An internal function used by `eewrap-pdflike'." (ee-template0 "\ ;; (find-fline {(ee-S (file-name-directory fname))}) \(code-pdf-page \"{stem}\" \"{fname}\") \(code-pdf-text \"{stem}\" \"{fname}\") ;; \(find-{stem}page) ;; \(find-{stem}text) ")) ;;; __ __ ___ _ __ _ _ _ _ _ _ ;;; | \/ | / _ \ _ _ __ __| |/ _| (_) | _____ | (_)_ __ | | __ ;;; | |\/| |_____| | | (_) | '_ \ / _` | |_| | | |/ / _ \_____| | | '_ \| |/ / ;;; | | | |_____| |_| |_ | |_) | (_| | _| | | < __/_____| | | | | | < ;;; |_| |_| \__\_(_) | .__/ \__,_|_| |_|_|_|\_\___| |_|_|_| |_|_|\_\ ;;; |_| ;; ;; See: (find-pdf-like-intro) ;; (define-key eev-mode-map "\M-Q" 'eewrap-pdflike-link) ;; OBSOLETE. (defun eewrap-pdflike-link () (interactive) (ee-this-line-wrapn 2 'ee-wrap-pdflike-link)) (defun ee-wrap-pdflike-link (n text) "An internal function used by `eewrap-pdflike-link'." (format "%s\n%s" (ee-wrap-pdflike-link1 "page" n text) (ee-wrap-pdflike-link1 "text" n text))) (defun ee-wrap-pdflike-link1 (what n text) "An internal function used by `eewrap-pdflike-link'." (ee-template0 "{ee-H}(find-{ee-page-c}{what} (+ {ee-page-offset} {n}) {(ee-S text)})")) ;;; __ __ ____ __ _ _ _ ;;; | \/ | | _ \ _ _ __ _ __ ___ / / __ ___ | | ____| (_)_ __ ;;; | |\/| |_____| |_) (_) | '__| '_ ` _ \ / / '_ ` _ \| |/ / _` | | '__| ;;; | | | |_____| _ < _ | | | | | | | |/ /| | | | | | < (_| | | | ;;; |_| |_| |_| \_(_) |_| |_| |_| |_/_/ |_| |_| |_|_|\_\__,_|_|_| ;;; ;; (define-key eev-mode-map "\M-R" 'eewrap-rm/mkdir/cd) (defun eewrap-rm/mkdir/cd () (interactive) (ee-this-line-wrapn 1 'ee-wrap-rm/mkdir/cd)) (defun ee-wrap-rm/mkdir/cd (dir) "An internal function used by `eewrap-rm/mkdir/cd'." (ee-template0 "\ # (find-fline \"{dir}\") rm -Rv {dir} mkdir {dir} cd {dir}")) ;;; __ __ ____ __ _ _ _ ;;; | \/ | / ___|_ / _(_)_ __ __| | ___| |__ ;;; | |\/| |____\___ (_) | |_| | '_ \ / _` |_____/ __| '_ \ ;;; | | | |_____|__) | | _| | | | | (_| |_____\__ \ | | | ;;; |_| |_| |____(_) |_| |_|_| |_|\__,_| |___/_| |_| ;;; ;; See: (find-wrap-intro "") ;; (define-key eev-mode-map "\M-S" 'eewrap-sh) (defun eewrap-sh () (interactive) (ee-this-line-wrapn 1 'ee-wrap-sh)) (defun ee-wrap-sh (str) "An internal function used by `eewrap-sh'." (ee-HS `(find-sh ,str))) (defun eewrap-sh0 () (interactive) (ee-this-line-wrapn 1 'ee-wrap-sh0)) (defun ee-wrap-sh0 (str) "An internal function used by `eewrap-sh0'." (ee-HS `(find-sh0 ,str))) ;;; __ __ _____ _ _ _ ;;; | \/ | |_ _| ___ ___ _ __ (_) |_ ___| |__ ;;; | |\/| |_____| |(_) / _ \/ _ \ '_ \| | __/ __| '_ \ ;;; | | | |_____| | _ | __/ __/ |_) | | || (__| | | | ;;; |_| |_| |_|(_) \___|\___| .__/|_|\__\___|_| |_| ;;; |_| ;; (define-key eev-mode-map "\M-T" 'eewrap-eepitch) ;; (find-eev "eepitch.el" "eepitch-wrap") ;;; __ __ __ __ _ _ _ _ ;;; | \/ | \ \ / / __ _ _ _ __| (_) _____ _(_) __| | ___ ___ ;;; | |\/| |____\ \ / (_) / _` | | | |/ _` | |/ _ \ \ / / |/ _` |/ _ \/ _ \ ;;; | | | |_____\ V / _ | (_| | |_| | (_| | | (_) \ V /| | (_| | __/ (_) | ;;; |_| |_| \_/ (_) \__,_|\__,_|\__,_|_|\___/ \_/ |_|\__,_|\___|\___/ ;;; ;; See: (find-audiovideo-intro) ;; (define-key eev-mode-map "\M-V" 'eewrap-audiovideo) (defun eewrap-audiovideo () (interactive) (ee-this-line-wrapn 2 'ee-wrap-audiovideo)) (defun ee-wrap-audiovideo (stem fname) "An internal function used by `eewrap-audiovideo'." (ee-template0 "\ ;; (find-fline {(ee-S (file-name-directory fname))}) ;; (find-audio \"{fname}\") ;; (find-video \"{fname}\") \(code-audio \"{stem}\" \"{fname}\") \(code-video \"{stem}\" \"{fname}\") ;; \(find-{stem}) ;; \(find-{stem} \"0:00\") ;; \(find-{stem} t) ;; \(eev-avadj-mode 1) ")) ;;; __ __ _____ __ _ _ _ ;;; | \/ | |__ /_ / _(_)_ __ __| | _______| |__ ;;; | |\/| |_____ / /(_) | |_| | '_ \ / _` |____|_ / __| '_ \ ;;; | | | |_____/ /_ _ | _| | | | | (_| |_____/ /\__ \ | | | ;;; |_| |_| /____(_) |_| |_|_| |_|\__,_| /___|___/_| |_| ;;; ;; (define-key eev-mode-map "\M-Z" 'eewrap-zsh) (defun eewrap-zsh () (interactive) (ee-this-line-wrapn 1 'ee-wrap-zsh)) (defun ee-wrap-zsh (str) "An internal function used by `eewrap-zsh'." (ee-HS `(find-zsh ,str))) ;;; __ __ _ _ ____ _ _ _ ;;; | \/ | _| || |_ _ |___ \ ___ ___ _ __ (_) |_ ___| |__ ___ ___ ;;; | |\/| |_____|_ .. _(_) __) | / _ \/ _ \ '_ \| | __/ __| '_ \ / _ \/ __| ;;; | | | |_____|_ _|_ / __/ | __/ __/ |_) | | || (__| | | | __/\__ \ ;;; |_| |_| |_||_| (_) |_____| \___|\___| .__/|_|\__\___|_| |_|\___||___/ ;;; |_| ;; See: (find-multiwindow-intro "Several eepitch targets") ;; (find-eewrap-links "#" "two-eepitches" "b c") ;; M-#: two-eepitches ;; (define-key eev-mode-map "\M-#" 'eewrap-two-eepitches) (defun eewrap-two-eepitches () (interactive) (ee-this-line-wrapn 2 'ee-wrap-two-eepitches)) (defun ee-wrap-two-eepitches (b c) "An internal function used by `eewrap-two-eepitches'." (ee-template0 "\  (find-3EE '(eepitch-{b}) '(eepitch-{c}))  (find-3ee '(eepitch-{b}) '(eepitch-{c}))  (eepitch-{b})  (eepitch-{c}) ")) ;;; /\ ____ ;;; ___ _____ ___ __ __ _ _ __|/\|___ \ ;;; / _ \/ _ \ \ /\ / / '__/ _` | '_ \ __) | ;;; | __/ __/\ V V /| | | (_| | |_) | / __/ ;;; \___|\___| \_/\_/ |_| \__,_| .__/ |_____| ;;; |_| ;; ;; See: (find-eev "eev-tlinks.el" "find-find-links-links") ;; (find-wrap-intro "eewrap-eewrap") ;; This is somewhat similar to `find-find-links-links', ;; but it is MUCH more primitive - consider it a demo! (defun eewrap-eewrap () (interactive) (ee-this-line-wrapn 3 'ee-wrap-eewrap)) (defun ee-wrap-eewrap (C stem args) (let ((n (length (ee-split args)))) (ee-template0 " ;; M-{C}: {stem} \(define-key eev-mode-map \"\\M-{C}\" 'eewrap-{stem}) \(defun eewrap-{stem} () (interactive) (ee-this-line-wrapn {n} 'ee-wrap-{stem})) \(defun ee-wrap-{stem} ({args}) \"An internal function used by `eewrap-{stem}'.\" (ee-template0 \"\\ {<}(ee-HS `(find-{stem} ,{args})){>}\"))\n"))) ;; «find-eewrap-links» (to ".find-eewrap-links") ;; A more standard way to create `eewrap-*' functions. ;; (find-find-links-links "" "eewrap" "C stem args") ;; (defun find-eewrap-links (&optional C stem args &rest pos-spec-list) "Visit a temporary buffer containing hyperlinks for foo." (interactive) (setq C (or C "{C}")) (setq stem (or stem "{stem}")) (setq args (or args "{args}")) (apply 'find-elinks-elisp `((find-eewrap-links ,C ,stem ,args ,@pos-spec-list) ;; Convention: the first sexp always regenerates the buffer. (find-efunction 'find-eewrap-links) ,(ee-wrap-eewrap C stem args) ) pos-spec-list)) ;; Test: (find-eewrap-links) ;;; _ ;;; ___ ___ _ __ ___ _ __ __ _| |_ ;;; / __/ _ \| '_ ` _ \| '_ \ / _` | __| ;;; | (_| (_) | | | | | | |_) | (_| | |_ ;;; \___\___/|_| |_| |_| .__/ \__,_|\__| ;;; |_| ;; (defalias 'ee-H 'ee-hyperlink-prefix) ;; (defalias 'ee-S 'ee-pp0) (provide 'eev-wrap) ;; Local Variables: ;; coding: utf-8-unix ;; no-byte-compile: t ;; End: