|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
;;; eev-kl-here.el -- Kill link to here. -*- lexical-binding: nil; -*-
;; Copyright (C) 2023-2024 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 <http://www.gnu.org/licenses/>.
;;
;; Author: Eduardo Ochs <eduardoochs@gmail.com>
;; Maintainer: Eduardo Ochs <eduardoochs@gmail.com>
;; Version: 20241002
;; Keywords: e-scripts
;;
;; Latest version: <http://anggtwu.net/eev-current/eev-kl-here.el>
;; htmlized: <http://anggtwu.net/eev-current/eev-kl-here.el.html>
;; See also: <http://anggtwu.net/eev-current/eev-beginner.el.html>
;; <http://anggtwu.net/eev-intros/find-kl-here-intro.html>
;; (find-kl-here-intro)
;;; Commentary:
;; This file implements the command `M-x kl', that "kills a link to
;; here", and its variants `M-x kll' and `M-x kls'. The documentation
;; is in this intro:
;;
;; (find-kl-here-intro)
;;
;;
;; in which we only generate a single "link to here", and we push that
;; into the kill ring. It is a cross between this,
;;
;; (find-here-links-intro "3. `find-here-links'")
;; (find-here-links-intro "9. The hlang")
;; (find-kla-intro)
;;
;; 4. the current version of this file defines the functions `kl',
;; `kll' and `kls', that don't start with the valid prefixes.
;; Index:
;; «.ee-find-linkis» (to "ee-find-linkis")
;; «.hprog» (to "hprog")
;; «.kl» (to "kl")
;; «.find-kl-debug-links» (to "find-kl-debug-links")
;; «.aliases» (to "aliases")
(require 'eev-kla) ; (find-eev "eev-kla.el")
(require 'eev-hlinks) ; (find-eev "eev-hlinks.el")
;;; __ _ _ _ _ _ _
;;; ___ ___ / _(_)_ __ __| | | (_)_ __ | | _(_)___
;;; / _ \/ _ \_____| |_| | '_ \ / _` |_____| | | '_ \| |/ / / __|
;;; | __/ __/_____| _| | | | | (_| |_____| | | | | | <| \__ \
;;; \___|\___| |_| |_|_| |_|\__,_| |_|_|_| |_|_|\_\_|___/
;;;
;; These functions are used by the hprogram in the next section. Each
;; `ee-find-{stem}-linki' is similar to the corresponding
;; `ee-find-{stem}-links', but the `...-links' function generates
;; several elisp hyperlinks and the `...-linki' function generates
;; just one. The `i' in the `linki' was originally a `1', but the `i'
;; is easier to type, to read, and to pronounce.
;;
;; See:
;; (find-eaproposf "ee-find.*link[is]")
;; (find-eev "eev-htests.el" "tests")
;;
;; «ee-find-linkis» (to ".ee-find-linkis")
;; Skel: (find-linki-links "info")
(defun ee-find-info-linki ()
(if (ee-info-shortp)
`(,(ee-info-shortf) ,(ee-info-node))
`(find-node ,(ee-info-fullnode))))
;; Skel: (find-linki-links "intro")
(defun ee-find-intro-linki ()
(let* ((stem (ee-intro-stem))
(find-xxx-intro (ee-intern "find-%s-intro" stem)))
(list find-xxx-intro)))
;; Skel: (find-linki-links "man")
(defun ee-find-man-linki ()
`(find-man ,(ee-buffer-re ee-man-re)))
;; Skel: (find-linki-links "file")
(defun ee-find-file-linki ()
(let* ((fname0 (or (buffer-file-name) default-directory))
(fname (ee-shorten-file-name fname0)))
(if (ee-kl-c)
`(,(ee-kl-find-cfile) ,(ee-kl-shorterfname))
`(find-fline ,fname))))
;; Skel: (find-linki-links "epackage")
(defun ee-find-epackage-linki ()
(let ((p (ee-epackage-bufferp)))
`(find-epackage-links ',p)))
;; Skel: (find-linki-links "epackages")
(defun ee-find-epackages-linki ()
(let ((pkgsymbol (ee-packages-package-here)))
`(find-epackages ',pkgsymbol)))
;; Skel: (find-linki-links "custom")
(defun ee-find-custom-linki ()
(let* ((name (ee-buffer-re ee-custom-re))
(symbol (ee-custom-lispify-tag-name name)))
`(find-customizegroup ',symbol)))
;; Skel: (find-linki-links "custom-f")
(defun ee-find-custom-f-linki ()
(let* ((name (ee-buffer-re ee-custom-f-re))
(symbol (ee-custom-lispify-tag-name name)))
`(find-customizeface ',symbol)))
;; Skel: (find-linki-links "custom-v")
(defun ee-find-custom-v-linki ()
(let* ((name (ee-buffer-re ee-custom-v-re))
(symbol (ee-custom-lispify-tag-name name)))
`(find-customizevariable ',symbol)))
;; Skel: (find-linki-links "ecolors")
(defun ee-find-ecolors-linki ()
'(find-ecolors))
;; Skel: (find-linki-links "efaces")
(defun ee-find-efaces-linki ()
'(find-efaces))
;; Skel: (find-linki-links "eshortdoc")
(defun ee-find-eshortdoc-linki ()
(let ((symbol (intern (ee-eshortdoc-bufferp))))
`(find-eshortdoc ',symbol)))
;; Skel: (find-linki-links "wgetes")
(defun ee-find-wgetes-linki ()
(let ((stem (ee-wgetes-bufferp))
(tag (ee-preceding-tag-flash-no-error)))
`(find-es ,stem ,@(if tag (list tag)))))
;; Skel: (find-linki-links "wgetangg")
(defun ee-find-wgetangg-linki ()
(let ((stem (ee-wgetangg-bufferp))
(tag (ee-preceding-tag-flash-no-error)))
`(find-angg ,stem ,@(if tag (list tag)))))
;; Skel: (find-linki-links "wget")
(defun ee-find-wget-linki ()
(let ((url (ee-wget-bufferp)))
`(find-wget ,url)))
;; Skel: (find-linki-links "efunctiondescr")
(defun ee-find-efunctiondescr-linki ()
(let ((f (ee-efunctiondescr-bufferp)))
;; `(find-efunctiondescr ',f)
`(find-efunction-links ',f)
))
;; Skel: (find-linki-links "efacedescr")
(defun ee-find-efacedescr-linki ()
(let ((f (ee-efacedescr-bufferp)))
;; `(find-efacedescr ',f)
`(find-eface-links ',f)
))
;; Skel: (find-linki-links "evardescr")
(defun ee-find-evardescr-linki ()
(let ((v (ee-evardescr-bufferp)))
;; `(find-evardescr ',v)
`(find-evariable-links ',v)
))
;; Not included in the test suite:
;; Skel: (find-linki-links "libera")
(defun ee-find-libera-linki ()
`(find-libera-2a ,rcirc-target))
;; Skel: (find-linki-links "epackage")
;; Needs a rename
;;; _
;;; | |__ _ __ _ __ ___ __ _
;;; | '_ \| '_ \| '__/ _ \ / _` |
;;; | | | | |_) | | | (_) | (_| |
;;; |_| |_| .__/|_| \___/ \__, |
;;; |_| |___/
;;
;; This is an hprogram similar to the one used by `find-here-links',
;; but in this one each `:if' returns a single sexp (for `kl').
;; See:
;; (find-here-links-intro "9. The hlang")
;; (find-eev "eev-hlinks.el" "hprog")
;; Tests:
;; (find-eev "eev-htests.el" "tests")
;;
;; «hprog» (to ".hprog")
(defvar ee-hprog-for-linki
'(:or
;; By major mode:
(:if (ee-info-bufferp) (ee-find-info-linki)) ; done
(:if (ee-man-bufferp) (ee-find-man-linki)) ; done
(:if (ee-dired-bufferp) (ee-find-file-linki)) ; done
(:if (ee-wdired-bufferp) (ee-find-file-linki)) ; done
(:if (ee-epackages-bufferp) (ee-find-epackages-linki)) ; done
;;
;; By buffer name:
(:if (ee-intro-bufferp) (ee-find-intro-linki)) ; done
(:if (ee-custom-bufferp) (ee-find-custom-linki)) ; done
(:if (ee-custom-f-bufferp) (ee-find-custom-f-linki)) ; done
(:if (ee-custom-v-bufferp) (ee-find-custom-v-linki)) ; done
(:if (ee-ecolors-bufferp) (ee-find-ecolors-linki)) ; done
(:if (ee-efaces-bufferp) (ee-find-efaces-linki)) ; done
(:if (ee-pdftext-bufferp) (ee-find-pdftext-linki)) ; not yet
(:if (ee-eshortdoc-bufferp) (ee-find-eshortdoc-linki)) ; done
(:if (ee-wgetes-bufferp) (ee-find-wgetes-linki))
(:if (ee-wgetangg-bufferp) (ee-find-wgetangg-linki))
(:if (ee-wget-bufferp) (ee-find-wget-linki))
;;
;; By buffer name, when it is "*Help*":
(:if (ee-efunctiondescr-bufferp) (ee-find-efunctiondescr-linki)) ; done
(:if (ee-efacedescr-bufferp) (ee-find-efacedescr-linki)) ; done
(:if (ee-evardescr-bufferp) (ee-find-evardescr-linki)) ; done
(:if (ee-epackage-bufferp) (ee-find-epackage-linki)) ; done
;;
;; Other cases:
(:if (ee-libera-bufferp) (ee-find-libera-linki)) ; not yet
(:if (ee-freenode-bufferp) (ee-find-freenode-linki)) ; not yet
(:if (ee-file-bufferp) (ee-find-file-linki)) ; done
;;
(:if t (error "Buffer type not supported by ee-hprog-linki"))
))
;; Similar to:
;; (find-efunction 'ee-detect-here)
(defun ee-detect-linki ()
(ee-hlang-run ee-hprog-for-linki))
(defun ee-get-linki ()
(ee-detect-linki)
(eval ee-hlang-sexp2))
;;; _ _
;;; | | _| |
;;; | |/ / |
;;; | <| |
;;; |_|\_\_|
;;;
;; «kl» (to ".kl")
;; Similar to:
;; (find-eev "eev-kla.el" "kill-sexps")
;; (find-eev "eev-kla.el" "aliases")
(defun eekl (&optional arg)
"<K>ill <L>ink to here. Tries to be smart."
(interactive "P")
(ee-detect-linki)
(if arg
(find-kl-debug-links 'kl)
(ee-kl-kill (ee-get-linki))))
(defun eekll (&optional arg)
"<K>ill <L>ink to here; add a <L>ine. Tries to be smart."
(interactive "P")
(ee-detect-linki)
(if arg
(find-kl-debug-links 'kl)
(ee-kl-kill (append (ee-get-linki) (list (ee-kl-line))))))
(defun eekls (&optional arg)
"<K>ill <L>ink to here; add a <S>tring. Tries to be smart."
(interactive "P")
(ee-detect-linki)
(if arg
(find-kl-debug-links 'kl)
(ee-kl-kill (append (ee-get-linki) (list (ee-kl-region))))))
;;; ____ _
;;; | _ \ ___| |__ _ _ __ _
;;; | | | |/ _ \ '_ \| | | |/ _` |
;;; | |_| | __/ |_) | |_| | (_| |
;;; |____/ \___|_.__/ \__,_|\__, |
;;; |___/
;;
;; «find-kl-debug-links» (to ".find-kl-debug-links")
;; Skel: (find-find-links-links-new "kl-debug" "symbol" "")
;; Test: (find-kl-debug-links 'KL)
;;
(defun find-kl-debug-links (&optional symbol &rest pos-spec-list)
"Visit a temporary buffer containing hyperlinks for kl-debug."
(interactive)
(apply
'find-elinks
`((find-kl-debug-links ',symbol ,@pos-spec-list)
;; Convention: the first sexp always regenerates the buffer.
(find-efunction 'find-kl-debug-links)
""
,(ee-template0 "\
# The last call to
# '({symbol} ARG)
# -> '(ee-detect-linki)
# -> '(ee-hlang-run ee-hprog-for-linki)
# produced this:
# ee-hlang-sexp1 => {(ee-S ee-hlang-sexp1)}
# ee-hlang-sexp2 => {(ee-S ee-hlang-sexp2)}
# See:
# ee-hlang-sexp1
# ee-hlang-sexp2
# (find-efunction '{(car ee-hlang-sexp1)})
# (find-efunction '{(car ee-hlang-sexp2)})
# And:
# (find-kl-here-intro \"5. The innards\")
# (find-here-links-intro \"8. Debugging\")
# (find-here-links-intro \"8. Debugging\" \"Each test tests\")
# (find-eev \"eev-kl-here.el\" \"hprog\")
# (find-eev \"eev-kl-here.el\" \"kl\")
")
)
pos-spec-list))
;;; _ _
;;; __ _| (_) __ _ ___ ___ ___
;;; / _` | | |/ _` / __|/ _ \/ __|
;;; | (_| | | | (_| \__ \ __/\__ \
;;; \__,_|_|_|\__,_|___/\___||___/
;;;
;; «aliases» (to ".aliases")
;; Moved to: (find-eev "eev-aliases.el" "kl-here")
;; See: (find-kla-intro "4. Aliases")
(provide 'eev-kl-here)
;; Local Variables:
;; coding: utf-8-unix
;; no-byte-compile: t
;; End: