How-to: Emacs Lisp

(defun add-hook-autoremove (hook function &optional depth local)
  "Add FUNCTION to HOOK.
FUNCTION will automatically remove itself from HOOK after running once.
DEPTH and LOCAL are the same as in `add-hook', which see.
Requires lexical binding.

Example calls:
(add-hook-autoremove 'org-mode-hook 'org-toggle-link-display)"
  ;; Argument validation:
  ;; The only argument we need to validate is FUNCTION, because it's
  ;; not validated in `add-hook', and by the time it's `funcall'ed,
  ;; it will be already too late for recovery.
  (or (functionp function)
      (signal 'wrong-type-argument (list 'functionp function)))
  ;; Code:
  ;; Normally, uninterned symbols with the same name are not `eq',
  ;; but in this case we will be using a reference to the same
  ;; uninterned symbol, so there is no problem.
  (let ((fn (make-symbol "FN")))
    ;; Since `symbol-function' is itself a function, FN will get
    ;; evaluated and what will be passed is the symbol it holds. It's
    ;; the same for `add-hook' and `remove-hook'.
    (setf (symbol-function fn)
          (lambda () (funcall function) (remove-hook hook fn local)))
    (add-hook hook fn depth local)))

;;; Even though lexical-binding is nil,
;;; this produces a closure regardless.
(eval
 (let ((x "hello"))
   (lambda () (message x)))
 t)

(defmacro with-lexical-binding (&rest body)
  "Evaluate BODY in lexical environment.
Every variable to be lexically scoped needs to be defined in BODY, as
environment outside the call to this macro cannot be accessed."
  ;; Tell the debugger that all arguments are evaluated, and that
  ;; there are no distinguished arguments (everything is part of the
  ;; body.)
  (declare (debug t) (indent 0))
  `(eval '(progn ,@body) t))

(defun keyword-to-symbol (keyword)
  "Turn a :keyword into 'keyword.

Example calls:
(keyword-to-symbol :::test) => 'test"
  ;; Handle :symbol, ::symbol, etc.
  (intern (string-trim-left (symbol-name keyword) "^:+")))

(defun symbol-to-keyword (symbol)
  "Turn a 'symbol into :symbol.

Example calls:
(symbol-to-keyword 'test) => :test"
  (if (keywordp symbol)
      symbol
    ;; Add colon as the first character,
    ;; which turns the name into a keyword name.   
    (intern (concat ":" (symbol-name symbol)))))

(defun insert-read-only (&rest args)
  "Insert ARGS into the buffer with the read-only property.
See `insert' for more information.

Example calls:
(insert-read-only)
(insert-read-only \"Emacs\" \"Lisp\")"
  (let ((inhibit-read-only t))
    (insert (propertize (apply #'concat args) 'read-only t))))

(defun remove-read-only (start end &optional buffer)
  "Remove the read-only property from text between START and END.
BUFFER defaults to the current buffer.

Example calls:
(remove-read-only (point-min) (point-max))"
  (with-current-buffer (or buffer (current-buffer))
    (let ((inhibit-read-only t))
      (remove-list-of-text-properties start end '(read-only)))))

(defun derived-mode-all-parents (mode &optional try-loading)
  "Return a list of MODE's parents.
This works if MODE was defined using `define-derived-mode'.

TRY-LOADING will try to recursively autoload modes to get
more accurate information on their parents.

(derived-mode-all-parents 'org-mode) => (outline-mode text-mode)"
  ;; Argument validation. Can be removed for performance.
  (or (and (symbolp mode) (not (keywordp mode)))
      (error "Wrong type argument: expected symbol, got %s" (type-of mode)))
  (let* ((loader (lambda (mode try-loading)
                   (let ((parent (get mode 'derived-mode-parent)))
                     (or
                      ;; No need to do any loading
                      ;; if we can find the parent.
                      parent
                      (and try-loading
                           (let ((file (symbol-file mode)))
                             (and file
                                  ;; Autoloaded mode will probably
                                  ;; have relative path; if it's
                                  ;; absolute, it was either already
                                  ;; loaded or not autoloaded in the
                                  ;; first place.
                                  (not (file-name-absolute-p file))
                                  (require (intern file) nil t)
                                  (get mode 'derived-mode-parent))))))))
         (parent (funcall loader mode try-loading))
         ;; No particular reason for putting mode as the car in cons.
         ;; It could have very well been nil instead, but this makes
         ;; the function easier to modify in case we want to return
         ;; a list where mode is in car and its parents in cdr.
         (head (and parent (cons mode nil)))
         (tail head))
    (while parent
      (let ((el (cons parent nil)))
        (setcdr tail el)
        (setq tail el))
      (setq parent (funcall loader parent try-loading)))
    (cdr head)))

(defun find-symbol-origin (symbol)
  "Check if SYMBOL is available and where.
Should be called in a fresh emacs -Q instance."
  (or (let* ((file (and lisp-directory (symbol-file symbol nil)))
             ;; .elc files in preloaded-file-list are saved without extension.
             (file-normalized (and file (if (string-equal (file-name-extension file) "elc")
                                            (file-name-sans-extension file)
                                          file)))
             (remove-prefix (and file-normalized
                                 ;; Define string-remove-prefix to avoid pulling subr-x.el.
                                 (lambda (prefix string)
                                   (if (string-prefix-p prefix string)
                                       (substring string (length prefix))
                                     string))))
             (preloaded (and file-normalized
                             ;; Files in preloaded-file-list are stored as a path relative
                             ;; to lisp-directory, while our path is absolute.
                             ;; We correct that here.
                             (member (funcall remove-prefix lisp-directory file-normalized)
                                     preloaded-file-list))))
        (and preloaded (message "Preload")))
      ;; If it's not preloaded, but still has a file associated with
      ;; it, it must be available via autoload. This will return nil
      ;; for functions/symbols defined in C.
      (and (symbol-file symbol nil) (message "Autoload"))
      (and (help-C-file-name symbol 'var) (message "C variable"))
      (and (help-C-file-name symbol 'subr) (message "C function"))
      ;; Search definition-prefixes directly for a matching
      ;; prefix. This gives a list of features where this symbol could
      ;; be defined. It would be possible to then load these features
      ;; and determine where exactly the symbol is coming from, like
      ;; `help-fns.el' does, but I'm okay with this.
      (let* ((name (symbol-name symbol))
             (len (length name))
             (pkgs nil))
        (while (and (null pkgs) (> len 0))
          (setq pkgs (gethash (substring name 0 len) definition-prefixes))
          (setq len (1- len)))
        (when pkgs
          (message "Require %s" pkgs)))
      (message "Unknown")))

(let ((prefixes (radix-tree-prefixes (help-definition-prefixes) string)))
  (help--load-prefixes prefixes)))

#!/bin/bash
# ./script "<sym1>" ... "<symn>"
# Checks if each symbol is available in default Emacs session, and where it came from.

function check() {
    # check <symbol>
    emacs -Q --batch --eval "(defun find-symbol-origin (symbol) (or (let* ((file (and lisp-directory (symbol-file symbol nil))) (file-normalized (and file (if (string-equal (file-name-extension file) \"elc\") (file-name-sans-extension file) file))) (remove-prefix (and file-normalized (lambda (prefix string) (if (string-prefix-p prefix string) (substring string (length prefix)) string)))) (preloaded (and file-normalized (member (funcall remove-prefix lisp-directory file-normalized) preloaded-file-list)))) (and preloaded (message \"Preload\"))) (and (symbol-file symbol nil) (message \"Autoload\")) (and (help-C-file-name symbol 'var) (message \"C variable\")) (and (help-C-file-name symbol 'subr) (message \"C function\")) (let* ((name (symbol-name symbol)) (len (length name)) (pkgs nil)) (while (and (null pkgs) (> len 0)) (setq pkgs (gethash (substring name 0 len) definition-prefixes)) (setq len (1- len))) (when pkgs (message \"Require %s\" pkgs))) (message \"Not found\")))" --eval "(find-symbol-origin '$1)" 2>&1
}

# Get the length of the longest symbol.
OFFSET="$(printf '%s\n' "$@" | awk '{l=length($0)}l>max{max=l}END{print max}')"

until [ $# -le 0 ]
do
    # Print <symbol> - <type>.
    printf "%-${OFFSET}s - %s\n" "$1" "$(check "$1")"
    shift 1
done

(progn
  (setq lexical-binding t)
  ;; Even though lexical-binding is now t, the following will not
  ;; create a closure:
  (let ((x "hello"))
    (lambda () (message x))))

;;; Start of test-lexical.el
;;; This is essentially a no-op.
(setq lexical-binding t)

;; Even though lexical-binding is now t, the following will not
;; create a closure:
(let ((x "hello"))
  (lambda () (message x)))
;;; End of test-lexical.el

;;; lexical-binding will not change after `load'.
(load "test-lexical.el")