The Emacs Package Developer's Handbook

(let ((strings (cl-loop for i from 1 to 1000
                        collect (number-to-string i))))
  (garbage-collect)
  (--sort (< (caddr it) (caddr other))
          (cl-loop for times in '(1 10 100)
                   append (a-list "(loop do (insert ..."
                                  (cons times
                                        (benchmark-run-compiled times
                                          (with-temp-buffer
                                            (cl-loop for string in strings
                                                     do (insert string)))))
                                  "(apply #'insert ..."
                                  (cons times
                                        (benchmark-run-compiled times
                                          (with-temp-buffer
                                            (apply #'insert strings))))
                                  "(insert (apply #'concat ..."
                                  (cons times
                                        (benchmark-run-compiled times
                                          (with-temp-buffer
                                            (insert (apply #'concat strings)))))))))

(let ((list (cl-loop for i from 1 to 1000
                     collect i)))
  (bench-multi :times 100
    :ensure-equal t
    :forms (("(-non-nil (--map (when ..." (-non-nil
                                           (--map (when (cl-evenp it) it) list)))
            ("(delq nil (--map (when ..." (delq nil
                                                (--map (when (cl-evenp it) it) list)))
            ("cl-loop" (cl-loop for i in list
                                when (cl-evenp i)
                                collect i))
            ("-select" (-select #'cl-evenp list))
            ("cl-remove-if-not" (cl-remove-if-not #'cl-evenp list))
            ("seq-filter" (seq-filter #'cl-evenp  list)))))

(datetime-format "%Y-%m-%d")  ;=> "2018-08-22"
(datetime-format 'atom)  ;=> "2018-08-22T18:23:47-05:00"
(datetime-format 'atom "2112-09-03 00:00:00" :timezone "UTC")  ;=> "2112-09-03T00:00:00+00:00"

(defun ap/iedit-or-flyspell ()
  "Call `iedit-mode' or correct misspelling with flyspell, depending..."
  (interactive)
  (if (or iedit-mode
          (and (derived-mode-p 'prog-mode)
               (not (or (nth 4 (syntax-ppss))
                        (nth 3 (syntax-ppss))))))
      ;; prog-mode is active and point is in a comment, string, or
      ;; already in iedit-mode
      (call-interactively #'ap/iedit-mode)
    ;; Not prog-mode or not in comment or string
    (if (not (equal flyspell-previous-command this-command))
        ;; FIXME: This mostly works, but if there are two words on the
        ;; same line that are misspelled, it doesn't work quite right
        ;; when correcting the earlier word after correcting the later
        ;; one

        ;; First correction; autocorrect
        (call-interactively 'flyspell-auto-correct-previous-word)
      ;; First correction was not wanted; use popup to choose
      (progn
        (save-excursion
          (undo)) ; This doesn't move point, which I think may be the problem.
        (flyspell-region (line-beginning-position) (line-end-position))
        (call-interactively 'flyspell-correct-previous-word-generic)))))

(defun ap/iedit-mode (orig-fn)
  "Call `iedit-mode' with function-local scope by default, or global scope if called with a universal prefix."
  (interactive)
  (pcase current-prefix-arg
    ('nil (funcall orig-fn '(0)))
    ('(4) (funcall orig-fn))
    (_ (user-error "`ap/iedit-mode' called with prefix: %s" prefix))))

;; Override default `iedit-mode' function with advice.
(advice-add #'iedit-mode :around #'ap/iedit-mode)

(advice-add 'iedit-mode :after (lambda (&optional ignore)
                                 (when iedit-mode
                                   (minibuffer-message "iedit session started. Press C-; to end."))))

;;; package-name.el --- Package description (don't include the word "Emacs")  -*- lexical-binding: t; -*-

;; Copyright (C) 2017 First Last

;; Author: First Last <name@example.com>
;; URL: http://example.com/package-name.el
;; Version: 0.1-pre
;; Package-Requires: ((emacs "25.2"))
;; Keywords: something

;; This file is not part of GNU Emacs.

;;; Commentary:

;; This is my package.  It is nice.  You should try it.

;;;; Installation

;;;;; MELPA

;; If you installed from MELPA, you're done.

;;;;; Manual

;; Install these required packages:

;; + foo
;; + bar

;; Then put this file in your load-path, and put this in your init
;; file:

;; (require 'package-name)

;;;; Usage

;; Run one of these commands:

;; `package-name-command': Frobnicate the flange.

;;;; Tips

;; + You can customize settings in the `package-name' group.

;;;; Credits

;; This package would not have been possible without the following
;; packages: foo[1], which showed me how to bifurcate, and bar[2],
;; which takes care of flanges.
;;
;;  [1] https://example.com/foo.el
;;  [2] https://example.com/bar.el

;;; License:

;; This program 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.

;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Code:

;;;; Requirements

(require 'foo)
(require 'bar)

;;;; Customization

(defgroup package-name nil
  "Settings for `package-name'."
  :link '(url-link "http://example.com/package-name.el"))

(defcustom package-name-something nil
  "This setting does something."
  :type 'something)

;;;; Variables

(defvar package-name-var nil
  "A variable.")

;;;;; Keymaps

;; This technique makes it easier and less verbose to define keymaps.

(defvar package-name-map
  ;; This makes it easy and much less verbose to define keys
  (let ((map (make-sparse-keymap "package-name map"))
        (maps (list
               ;; Mappings go here, e.g.:
               "RET" #'package-name-RET-command
               [remap search-forward] #'package-name-search-forward
               )))
    (cl-loop for (key fn) on maps by #'cddr
             do (progn
                  (when (stringp key)
                    (setq key (kbd key)))
                  (define-key map key fn)))
    map))

;;;; Functions

;;;;; Commands

;;;###autoload
(defun package-name-command (args)
  "Frobnicate the flange."
  (interactive)
  (package-name--something)
  (bar))

;;;;; Support

(defun package-name--something (args)
  "This function helps frobnicate the flange."
  (foo))

;;;; Footer

(provide 'package-name)

;;; package-name.el ends here

#+PROPERTY: LOGGING nil

# Note: This readme works with the org-make-toc <https://github.com/alphapapa/org-make-toc> package, which automatically updates the table of contents.

* package-name
:PROPERTIES:
:TOC:      ignore
:END:

file:https://melpa.org/packages/package-name-badge.svg file:https://stable.melpa.org/packages/package-name-badge.svg

This is my package.  It is nice.  You should try it.

** Screenshots

This screenshot shows how to frobnicate the fripulator:

screenshot1.png

* Contents                                                         :noexport:
:PROPERTIES:
:TOC:      this
:END:
  -  Installation
  -  Usage
  -  Changelog
  -  Credits
  -  Development
  -  License

* Installation
:PROPERTIES:
:TOC:      0
:END:

** MELPA

If you installed from MELPA, you're done.  Just run one of the commands below.

** Manual

  Install these required packages:

  + foo
  + bar

  Then put this file in your load-path, and put this in your init file:

  #+BEGIN_SRC elisp
(require 'package-name)
  #+END_SRC

* Usage
:PROPERTIES:
:TOC:      0
:END:

  Run one of these commands:

  + package-name-command: Frobnicate the flange.

** Tips

+ You can customize settings in the package-name group.

* Changelog
:PROPERTIES:
:TOC:      0
:END:

** 1.1.0

Additions
+  Add command package-name-debarnacle to de-barnacle the hull.

Changes
+ Command package-name-anchor now takes an argument, weigh or let-go.

Internal
+  Rewrote input parsing.
+  Factored out anchor-weighing.

** 1.0.1

Fixes
+  Ensure anchor is secure before returning from package-name-anchor.

** 1.0.0

Initial release.

* Credits

  This package would not have been possible without the following packages: foo which showed me how to bifurcate, and bar, which takes care of flanges.

* Development

Bug reports, feature requests, suggestions — oh my!

* License

GPLv3

# Local Variables:
# eval: (require 'org-make-toc)
# before-save-hook: org-make-toc
# org-export-with-properties: ()
# org-export-with-title: t
# End:

(defun sx-question-list--print-info (question-data)
  "DOC"
  (let-alist question-data
    (list
     question-data
     (vector
      (int-to-string .score)
      (int-to-string .answer_count)
      .title " "
      .owner.display_name
      .last_activity_date sx-question-list-ago-string
      " " .tags))))

(defmacro with-dict (key-vals &rest body)
  "A context-manager for a plist where each key is a callable
function that returns the value."
  (declare (indent 1))
  (let* ((g (if (symbolp key-vals)
                (symbol-value key-vals)
              key-vals))
         (keys (-slice g 0 nil 2)))
    `(labels ,(loop for key in keys
                    collect
                    (list key '() `(plist-get ',g ,key)))
       ,@body)))

;; Used as:

(with-dict (:a 1 :b 'some-symbol :c 3)
           (:b))

(let ((d '(:key1 1 :key2 some-other-symbol :key3 3)))
  (with-dict d
             (format "We got %s" (:key2))))

(defmacro with-plist-vals (plist &rest body)
  "Bind the values of a plist to variables with the name of the keys."
  (declare (indent 1))
  `(let ,(loop for key in (-slice plist 0 nil 2)
               for val in (-slice plist 1 nil 2)
               collect (list (intern
                              (substring (symbol-name key) 1))
                             val))
     ,@body))

;; Used like:

(with-plist-vals (:a 4 :b 6)
                 (* 2 a))

(cl-defmacro bench (&optional (times 100000) &rest body)
  "Call `benchmark-run-compiled' on BODY with TIMES iterations, returning list suitable for Org source block evaluation.
Garbage is collected before calling `benchmark-run-compiled' to
avoid counting existing garbage which needs collection."
  (declare (indent defun))
  `(progn
     (garbage-collect)
     (list '("Total runtime" "# of GCs" "Total GC runtime")
           'hline
           (benchmark-run-compiled ,times
             (progn
               ,@body)))))

(bench 1000000
  (cons 'time (current-time)))

(cl-defmacro bench-multi (&key (times 1) forms ensure-equal)
  "Run FORMS with `benchmark-run-compiled' for TIMES iterations, returning list suitable for Org source block evaluation.

When ENSURE-EQUAL is non-nil, compare the results of FORMS and
ensure they are `equal'.  If they aren't, raise an error, and if
the results are sequences, show the difference between them using
`seq-difference'.

If the first element of a form is a string, the string is used as
the form's description in the results; otherwise, forms are
numbered from 0.

Before `benchmark-run-compiled' is called for each form,
`garbage-collect' is called."
  (declare (indent defun))
  (let ((results (gensym))
        (result-times (gensym))
        (header '(("Form" "x faster than next" "Total runtime" "# of GCs" "Total GC runtime")
                  hline))
        (descriptions (cl-loop for form in forms
                               for i from 0
                               collect (if (stringp (car form))
                                           (prog1 (car form)
                                             (setf (nth i forms) (cadr (nth i forms))))
                                         i))))
    `(let* ((,results (make-hash-table))
            (,result-times (sort (list ,@(cl-loop for form in forms
                                                  for i from 0
                                                  for description = (nth i descriptions)
                                                  collect `(progn
                                                             (garbage-collect)
                                                             (cons ,description
                                                                   (benchmark-run-compiled ,times
                                                                     ,(if ensure-equal
                                                                          `(puthash ,description ,form ,results)
                                                                        form))))))
                                 (lambda (a b)
                                   (< (second a) (second b))))))
       ,(when ensure-equal
          `(cl-loop with keys = (hash-table-keys ,results)
                    for i from 0 to (- (length keys) 2)
                    unless (equal (gethash (nth i keys) ,results)
                                  (gethash (nth (1+ i) keys) ,results))
                    do (if (sequencep (gethash (car (hash-table-keys ,results)) ,results))
                           (let* ((k1) (k2)
                                  ;; If the difference in one order is nil, try in other order.
                                  (difference (or (setq k1 (nth i keys)
                                                        k2 (nth (1+ i) keys)
                                                        difference (seq-difference (gethash k1 ,results)
                                                                                   (gethash k2 ,results)))
                                                  (setq k1 (nth (1+ i) keys)
                                                        k2 (nth i keys)
                                                        difference (seq-difference (gethash k1 ,results)
                                                                                   (gethash k2 ,results))))))
                             (user-error "Forms' results not equal: difference (%s - %s): %S"
                                         k1 k2 difference))
                         ;; Not a sequence
                         (user-error "Forms' results not equal: %s:%S  %s:%S"
                                     (nth i keys) (nth (1+ i) keys)
                                     (gethash (nth i keys) ,results)
                                     (gethash (nth (1+ i) keys) ,results)))))
       ;; Add factors to times and return table
       (append ',header
               (cl-loop with length = (length ,result-times)
                        for i from 0 to (1- length)
                        for time = (second (nth i ,result-times))
                        for description = (car (nth i ,result-times))
                        for factor = (if (< i (1- length))
                                         (format "%.2f" (/ (second (nth (1+ i) ,result-times))
                                                           (second (nth i ,result-times))))
                                       "slowest")
                        collect (append (list description factor)
                                        (cdr (nth i ,result-times))))))))

(bench-multi
  :forms (("org-map-entries" (sort (org-map-entries (lambda ()
                                                      (nth 4 (org-heading-components)))
                                                    "/+MAYBE" 'agenda)
                                   #'string<))
          ("regexp" (sort (-flatten
                           (-non-nil
                            (mapcar (lambda (file)
                                      (let ((case-fold-search t))
                                        (with-current-buffer (find-buffer-visiting file)
                                          (org-with-wide-buffer
                                           (goto-char (point-min))
                                           (cl-loop with regexp = (format org-heading-keyword-regexp-format "MAYBE")
                                                    while (re-search-forward regexp nil t)
                                                    collect (nth 4 (org-heading-components)))))))
                                    (org-agenda-files))))
                          #'string<))))

(bench-multi
  :ensure-equal t
  :forms (("org-map-entries" (sort (org-map-entries (lambda ()
                                                      (nth 4 (org-heading-components)))
                                                    "/+MAYBE" 'agenda)
                                   #'string<))
          ("regexp" (sort (-flatten
                           (-non-nil
                            (mapcar (lambda (file)
                                      (let ((case-fold-search t))
                                        (with-current-buffer (find-buffer-visiting file)
                                          (org-with-wide-buffer
                                           (goto-char (point-min))
                                           (cl-loop with regexp = (format org-heading-keyword-regexp-format "MAYBE")
                                                    while (re-search-forward regexp nil t)
                                                    collect (nth 4 (org-heading-components)))))))
                                    (org-agenda-files))))
                          #'string<))))

(bench-multi
  :ensure-equal t
  :forms (("org-map-entries" (sort (org-map-entries (lambda ()
                                                      (nth 4 (org-heading-components)))
                                                    "/+MAYBE" 'agenda)
                                   #'string<))
          ("regexp" (sort (-flatten
                           (-non-nil
                            (mapcar (lambda (file)
                                      (let ((case-fold-search nil))
                                        (with-current-buffer (find-buffer-visiting file)
                                          (org-with-wide-buffer
                                           (goto-char (point-min))
                                           (cl-loop with regexp = (format org-heading-keyword-regexp-format "MAYBE")
                                                    while (re-search-forward regexp nil t)
                                                    collect (nth 4 (org-heading-components)))))))
                                    (org-agenda-files))))
                          #'string<))))

(defmacro elp-profile (times prefixes &rest body)
  (declare (indent defun))
  `(let (output)
     (dolist (prefix ,prefixes)
       (elp-instrument-package (symbol-name prefix)))
     (dotimes (x ,times)
       ,@body)
     (elp-results)
     (elp-restore-all)
     (point-min)
     (forward-line 20)
     (delete-region (point) (point-max))
     (setq output (buffer-substring-no-properties (point-min) (point-max)))
     (kill-buffer)
     (delete-window)
     (let ((rows (s-lines output)))
       (append (list (list "Function" "Times called" "Total time" "Average time")
                     'hline)
               (cl-loop for row in rows
                        collect (s-split (rx (1+ space)) row 'omit-nulls))))))

;; Use like this:
(elp-profile 10 '(map search goto-char car append)
  (goto-char (point-min))
  (search-forward "something"))

(define-arx url-rx
  '((http (seq bos (group "http") "://") )
    (https (seq bos (group "https") "://") )
    (https? (seq bos (group "http" (optional "s")) "://") )
    (protocol (seq bos (group (1+ (not (any ":")))) "://"))
    (host (group (1+ (not (any "/")))))
    (path (group "/" (1+ (not (any "?")))))
    (query (seq "?" (group (1+ (not (any "#"))))))
    (fragment (seq "#" (group (1+ anything))))))

;; Accept HTTP or HTTPS
(let ((url "http://server/path?query#fragment"))
  (when (string-match (url-rx https? host path (optional query) (optional fragment)) url)
    (list (match-string 0 url)
          (match-string 1 url)
          (match-string 2 url)
          (match-string 3 url)
          (match-string 4 url)
          (match-string 5 url)))) ;=> ("http://server/path?query#fragment" "http" "server" "/path" "query" "fragment")

;; Only accept HTTPS, not plain HTTP
(let ((url "http://server/path?query#fragment"))
  (when (string-match (url-rx https host path (optional query) (optional fragment)) url)
    (list (match-string 0 url)))) ;=> nil

;; Accept any protocol, not just HTTP
(let ((url "ftp://server/path"))
  (when (string-match (url-rx protocol host path (optional query) (optional fragment)) url)
    (list (match-string 0 url)
          (match-string 1 url)
          (match-string 2 url)
          (match-string 3 url)
          (match-string 4 url)
          (match-string 5 url)))) ;=> ("ftp://server/path" "ftp" "server" "/path" nil nil)

(define-arx cond-assignment-rx
  '((alpha_ (regexp "[[:alpha:]_]"))
    (alnum_ (regexp "[[:alnum:]_]"))
    (ws (* blank))
    (sym (:func (lambda (_form &rest args)
                  `(seq symbol-start (or ,@args) symbol-end))))
    (cond-keyword (sym "if" "elif" "while"))
    (id (sym (+ alpha_) (* alnum_))))) ;; -> cond-assignment-rx

(cond-assignment-rx cond-keyword ws id ":" id ws "=" ws id) ;; -> "\\_<\\(?:elif\\|if\\|while\\)\\_>[[:blank:]]*\\_<\\(?:[[:alpha:]_]+\\|[[:alnum:]_]*\\)\\_>:\\_<\\(?:[[:alpha:]_]+\\|[[:alnum:]_]*\\)\\_>[[:blank:]]*=[[:blank:]]*\\_<\\(?:[[:alpha:]_]+\\|[[:alnum:]_]*\\)\\_>"

(format$ "Amount: ${amount% .02f} $name %s" date)

(format "Amount: % .02f %s %s" amount name date)

;; Traditionally people pick one of the following options when faced
;; with the task of extracting data from XML in Emacs Lisp:
;;
;; - Using regular expressions on the unparsed document
;; - Manual tree traversal with `assoc', `car' and `cdr'
;;
;; Browsers faced a similar problem until jQuery happened, shortly
;; afterwards they started providing the `node.querySelector' and
;; `node.querySelectorAll' API for retrieving one or all nodes
;; matching a given CSS selector. This code implements the same API
;; with the `esxml-query' and `esxml-query-all' functions. The
;; following table summarizes the currently supported modifiers and
;; combinators:
;;
;; | Name                               | Supported? | Syntax      | 
;; |------------------------------------+------------+-------------|
;; | Namespaces                         | No         | foo|bar     | 
;; | Commas                             | Yes        | foo, bar    | 
;; | Descendant combinator              | Yes        | foo bar     | 
;; | Child combinator                   | Yes        | foo>bar     | 
;; | Adjacent sibling combinator        | No         | foo+bar     | 
;; | General sibling combinator         | No         | foo~bar     | 
;; | Universal selector                 | Yes        | *           | 
;; | Type selector                      | Yes        | tag         | 
;; | ID selector                        | Yes        | #foo        | 
;; | Class selector                     | Yes        | .foo        | 
;; | Attribute selector                 | Yes        | [foo]       | 
;; | Exact match attribute selector     | Yes        | [foo=bar]   | 
;; | Prefix match attribute selector    | Yes        | [foo^=bar]  | 
;; | Suffix match attribute selector    | Yes        | [foo$=bar]  | 
;; | Substring match attribute selector | Yes        | [foo*=bar]  | 
;; | Include match attribute selector   | Yes        | [foo~=bar]  | 
;; | Dash match attribute selector      | Yes        | [foo|=bar]  | 
;; | Attribute selector modifiers       | No         | [foo=bar i] | 
;; | Pseudo elements                    | No         | ::foo       | 
;; | Pseudo classes                     | No         | :foo        |

(defun org-books--amazon (url)
  "Return plist of data for book at Amazon URL."
  (cl-flet ((field (target-field list)
                   (cl-loop for li in list
                            for (field value) = (ignore-errors
                                                  (-let (((_ _ (_ _ field) value) li))
                                                    (list field value)))
                            when (equal field target-field)
                            return (s-trim value))))
    (let* ((html (org-web-tools--get-url url))
           (tree (with-temp-buffer
                   (insert html)
                   (libxml-parse-html-region (point-min) (point-max))))
           (author (esxml-query "span.author a.contributorNameID *" tree))
           (title (esxml-query "div#booksTitle h1#title > span *" tree))
           (details (esxml-query-all "table#productDetailsTable ul li" tree))
           (date (if-let ((printed (third (esxml-query-all "div#booksTitle h1#title span *" tree))))
                     ;; Printed book
                     (s-replace "– " "" printed)
                   ;; Kindle book
                   (field "Publication Date:" details)))
           (asin (field "ASIN:" details))
           (publisher (-some->> (field "Publisher:" details)
                                (replace-regexp-in-string (rx " (" (1+ anything) ")") "")))
           (isbn-10 (field "ISBN-10:" details))
           (isbn-13 (field "ISBN-13:" details)))
      (list :author author :title title :publisher publisher :date date
            :asin asin :isbn-10 isbn-10 :isbn-13 isbn-13))))

<html style="height: 100vh">
  <head class="kek"><title class="kek" data-bar="foo">Complex HTML Page</title></head>
  <body class="kek bur" style="height: 100%">
    <h1 id="bar" class="kek wow">Wow this is an example</h1>
    <input id="quux" class="kek foo"/>
    <iframe id="baz" sandbox="allow-same-origin allow-scripts allow-popups allow-forms"
            width="100%" height="100%" src="example.org">
    </iframe>
  </body>
</html>

(let ((html (elq-read-file "~/kek.html")))
  (elq-el (car (elq-$ ".kek#quux" html))) ; => "input"
  (mapcar 'elq-el (elq-$ ".kek" html)) ; => ("input" "h1" "body" "title" "head")
  (mapcar (lambda (el) (elq-el (elq-parent el)))
          (elq-$ ".kek" html)) ; => ("body" "body" "html" "head" "html")
  (mapcar (lambda (el) (mapcar 'elq-el (elq-siblings el)))
          (elq-$ ".kek" html)) ; => (("h1" "input" "iframe") ("h1" "input" "iframe") ("head" "body") ("title") ("head" "body"))
  (elq-$ ".kek" html) ; => Hope you didn't like your messages buffer
  (elq-write html nil)) ; => "<html style=\"height: 100vh\"> ... </html>"

;; Grab the top-level paragraph content from XHTML.
(xml-query-all '(html body p *) xhtml)

;; Extract all the links from an Atom feed.
(xml-query-all '(feed entry link [rel "alternate"] :href) xml)

(require 'enlive)

(enlive-text
 (enlive-query (enlive-fetch "http://gnu.org/") [title])) ; => "The GNU Operating System and the Free Software Movement"

;; Utility functions for xml parse trees.
;; - `xml+-query-all' and `xml+-query-first' are query functions that search
;; descendants in node lists. They don't work with namespace-aware parsing yet
;;
;; - `xml+-node-text' gets node text