Slug — Create friendly slugs for your URLs and filenames (Emacs package)

(slug-to-ud-09az "The best すし & さしみ 42 € can buy™ [updated: 2042]")
=> "the-best-sushi-and-sashimi-42-eur-can-buy-tm-updated-2042"

(use-package slug
  :demand t
  :custom  ; for example:
  (slug-a-hex-digits 12))

(require 'slug)

;;; slug.el --- Create friendly slugs for your URLs and filenames  -*- lexical-binding: t -*-
;;; Commentary:
;;;; For all the details, please do see the README
;;; Acknowledgments:
;;; Code:
;;;; Libraries
;;;; Symbols from other packages
;;;; Package metadata
;;;; Customizable variables
;;;; Functions
;;;;; Description macro
;;;;; Replacement functions
;;;;;; Sequential replacements
;;;;;;; Call sequentially
;;;;;;; Create lowercase slugs of alphanumerics and dashes
;;;;;; Unidecode: transliteration functions
;;;;;;; Your pick
;;;;;;; Do it all in Emacs Lisp
;;;;;;; Do it by calling Python
;;;;;; Replacement of diacritics
;;;;;; Assortment of small replacement functions
;;;;;;; Pre-alnum functions
;;;;;;; Alphanumeric restriction functions
;;;;;;; Post-alnum functions
;;;;; Generation of unique identifiers
;;;;;; Random hex digits
;;;;;; Dates
;;;;;; Timestamps
;;;; Commands
;;;;; See README
;;;; Wrapping up
;;; slug.el ends here

;;; slug.el --- Create friendly slugs for your URLs and filenames  -*- lexical-binding: t -*-

;; SPDX-FileCopyrightText: © flandrew <https://flandrew.srht.site/listful>

;;---------------------------------------------------------------------------
;; Author:    flandrew
;; Created:   2022-01-22
;; Updated:   2025-03-31
;; Keywords:  extensions, lisp
;; Homepage:  <https://flandrew.srht.site/listful/software.html>
;;---------------------------------------------------------------------------
;; Package-Version:  0.2.0
;; Package-Requires: ((emacs "25.1"))
;;---------------------------------------------------------------------------

;; SPDX-License-Identifier: GPL-3.0-or-later

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

;;; Commentary:
;;
;; With this package you can create slugs.
;;
;; Slugs are user-friendly strings that identify resources.
;; They can be used, for example:
;; - for naming files
;; - for creating clean URLs
;; - for anchors in html pages
;;
;; This package provides "string cleaning" functions.
;; There's an assortment of small ones plus a few that combine them.
;;
;; You can then, for example, transform this title:
;;   The best すし & さしみ 42 € can buy™ [updated: 2042]
;;
;; into this slug:
;;   the-best-sushi-and-sashimi-42-eur-can-buy-tm-updated-2042
;;
;;;; For all the details, please do see the README
;;
;; Open it easily with:
;;   (find-file-read-only "README.org")   <--- C-x C-e here¹
;;
;; or from any buffer:
;;   M-x slug-see-readme
;;
;; or read it online:
;;   <https://flandrew.srht.site/listful/sw-emacs-slug.html>
;;
;; ¹ or the key that ‘eval-last-sexp’ is bound to, if not C-x C-e.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Acknowledgments:
;;
;; The replacement function ‘slug-to-nd-alnum’ evolved from a function found
;; in Karl Voit's dot-emacs, which in turn was an adaptation of ox-hugo's
;; ‘org-hugo-slug’.
;;
;; ox-hugo
;;   SPDX-FileCopyrightText:  © Kaushal Modi
;;   SPDX-License-Identifier: GPL-3.0-or-later
;;   Author:                  Kaushal Modi
;;   Homepage:                <https://ox-hugo.scripter.co>
;;
;; dot-emacs
;;   SPDX-FileCopyrightText:  © Karl Voit
;;   SPDX-License-Identifier: GPL-3.0-or-later
;;   Author:                  Karl Voit
;;   Homepage:                <https://github.com/novoid/dot-emacs>
;;
;; ------------------------------------------------------------------------
;;
;; The variable ‘slug-url-rx’ borrows from ffap.el's ‘ffap-url-regexp’.
;;
;; ffap
;;   SPDX-FileCopyrightText:  © Free Software Foundation, Inc.
;;   SPDX-License-Identifier: GPL-3.0-or-later
;;   Author:                  Michelangelo Grigni
;;
;; ------------------------------------------------------------------------
;;
;; The function ‘slug--s-replace-all’ adapts s.el's ‘s-replace-all’.
;;
;; s.el
;;   SPDX-FileCopyrightText:  © Magnar Sveen
;;   SPDX-License-Identifier: GPL-3.0-or-later
;;   Author:                  Magnar Sveen
;;   Homepage:                <https://github.com/magnars/s.el>
;;
;; ------------------------------------------------------------------------
;;
;; The function ‘slug--a-make-hex-n’ is based on org-macs.el's ‘org-id-uuid’.
;;
;; org-macs
;;   SPDX-FileCopyrightText:  © Free Software Foundation, Inc.
;;   SPDX-License-Identifier: GPL-3.0-or-later
;;   Author:                  Carsten Dominik
;;   Homepage:                <https://orgmode.org>
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; Code:
;;;; Libraries

(require 'rx)
(require 'lisp-mnt)      ; ‘lm-summary’ ‘lm-homepage’ ‘lm-version’ ‘lm-header’
(require 'regexp-opt)    ; ‘regexp-opt’
(require 'ucs-normalize) ; ‘ucs-normalize-NFC-string’


;;;; Symbols from other packages

;; Silence "not known to be defined" compiler warnings
(declare-function unidecode          "ext:unidecode" (string))
(declare-function unidecode-sanitize "ext:unidecode" (string))


;;;; Package metadata

(defvar slug--name "Slug")

(defvar slug--dot-el
  (format "%s.el" (file-name-sans-extension (eval-and-compile
                                              (or load-file-name
                                                  buffer-file-name)))))
(defvar slug--readme-org
  (expand-file-name "README.org" (file-name-directory slug--dot-el)))

(defvar slug--summary  (lm-summary   slug--dot-el))
(defvar slug--homepage (lm-homepage  slug--dot-el))
(defvar slug--version  (lm-with-file slug--dot-el
                         (or (lm-header "package-version")
                             (lm-version))))


;;;; Customizable variables

(defgroup slug nil
  (format "%s." slug--summary)
  :group 'extensions
  :group 'lisp
  :link  '(emacs-library-link :tag "Lisp file" "slug.el")
  :link  `(file-link :tag "README.org" ,slug--readme-org)
  :link  `(url-link  :tag "Homepage"   ,slug--homepage))

(defcustom slug-r-ud-default-function #'slug-r-ud-unidecode
  "Default function to transliterate Unicode characters.

The choices:
- ‘slug-r-ud-unidecode’ uses only elisp, and depends on package
  unidecode.el. This is the default.
- ‘slug-r-ud-python-unidecode’ uses Python, and depends on your
  having the package python3-unidecode on your system.

This variable will only have an effect when you use a slug function that
does unidecoding.

If you try to use a unidecoding function but the corresponding elisp or
python3 package isn't available, an error message will be shown."
  :package-version '(slug "0.2.0")
  :type '(choice (function-item slug-r-ud-unidecode)
                 (function-item slug-r-ud-python-unidecode)))

(defcustom slug-a-hex-hash-algo 'sha512
  "Algorithm to generate random hex strings."
  :package-version '(slug "0.2.0")
  :type '(choice (const :tag "sha512" sha512)
                 (const :tag "sha256" sha256)
                 (const :tag "sha1"   sha1)
                 (const :tag "md5"    md5)))

(defcustom slug-a-hex-digits 8
  "Number of digits to use in random hex strings."
  :package-version '(slug "0.2.0")
  :type 'natnum)

(defcustom slug-a-hex-digits-min 8
  "Minimal number of digits to match when looking for hex strings.
This variable is used by ‘slug-a-append-hex-maybe’, which checks whether
a string already ends in a sequence of hex digits."
  :package-version '(slug "0.2.0")
  :type 'natnum)

(defcustom slug-a-date-format "%F"
  "Date format used by ‘slug-a-prepend-date’.
The default value is %F, which is the same as %+4Y-%m-%d, a full date.
This is compatible with ‘slug-a-date-rx’'s default."
  :package-version '(slug "0.2.0")
  :type 'string)

(defcustom slug-a-date-rx (rx (: (= 4 digit) "-" (= 2 digit) "-" (= 2 digit)))
  "Regular expression to match when looking for dates.
The default value is compatible with ‘slug-a-date-format’'s default.
This variable is used by ‘slug-a-prepend-date-maybe’, which checks
whether a string starts with a date."
  :package-version '(slug "0.2.0")
  :type 'string)

(defcustom slug-a-ts-format "%Y%m%d-%H%M%S"
  "Timestamp format used by ‘slug-a-append-ts’.
The default value is compatible with ‘slug-a-ts-rx’'s default."
  :package-version '(slug "0.2.0")
  :type 'string)

(defcustom slug-a-ts-rx (rx (: (= 8 digit) "-" (= 6 digit)))
  "Regular expression to match when looking for timestamps.
The default value is compatible with ‘slug-a-ts-format’'s default.
This variable is used by ‘slug-a-append-ts-maybe’, which checks whether
a string already ends in a timestamp."
  :package-version '(slug "0.2.0")
  :type 'string)


;;;; Functions
;;;;; Description macro

(defmacro slug--describe (str)
  "Describe with string STR the contents under this heading.
Think of it as a docstring for the headings of your elisp files.
For the full docstring, look for ‘orgreadme-fy-describe’ in the
package ‘orgreadme-fy’."
  (declare (indent 0))
  (unless (stringp str)
    (user-error "‘slug--describe’ must receive a string")))


;;;;; Replacement functions

(slug--describe
  "These are functions to make replacements in strings.")

;;;;;; Sequential replacements

(slug--describe
  "These are compositions of smaller, simpler functions.")

;;;;;;; Call sequentially

(defun slug-call (funs s)
  "Sequentially call each function from FUNS on string S.
FUNS is a list of functions.

You can use ‘slug-call’ to compose your own slug-generating functions."
  (while funs
    (setq s (funcall (pop funs) s)))
  s)


;;;;;;; Create lowercase slugs of alphanumerics and dashes

(slug--describe
  "These functions simplify a string to only alphanumeric characters and
dashes.

There are a few variations on how to do this, in particular regarding
how to deal with alphanumeric characters in non-Latin scripts.

Here is a summary, with an example of applying them to this string:
=Ął|άε:--~(ióñ)すし,™4௨=

| Function           | NLA    | NLNA   | Example               |
|--------------------+--------+--------+-----------------------|
| ‘slug-to-ud-09az’  | decode | decode | al-ae-ion-sushi-42-tm |
| ‘slug-to-nd-alnum’ | leave  | remove | al-αε-ion-すし-4௨    |
| ‘slug-to-nd-09az’  | remove | remove | al-ion-4              |

where columns are:
| NLA  | non-Latin alphanumeric characters     | すし, Здрасти, ௪௨ |
| NLNA | non-Latin non-alphanumeric characters | € ™ © ®            |

and actions on the characters are:
| decode Unicode   | すし → sushi, € → EUR, ™ → (tm)  |
| remove character | すし → <nothing>, øł → <nothing> |
| leave unmodified | すし → すし, øł → øł              |

Diacritics are removed by them all.")

(defun slug-to-ud-09az (s)
  "Unidecode S, then simplify it to 0-9a-z and single dashes.
It transliterates Unicode: symbols and alphanumeric characters from
other alphabets are decoded.

Remaining non-alphanumeric characters are removed."
  (slug-call (list #'slug-r--pre-alnum
                   #'slug-r-ud-default
                   #'slug-r-09Az-parens-or-space
                   #'slug-r--post-alnum)
             s))

(defun slug-to-nd-alnum (s)
  "Simplify string S to lowercase alphanumeric and single dashes.
It does not transliterate Unicode.

Diacritics are removed: “nd” stands for “no diacritics”.

Alphanumeric characters from other alphabets are left intact;
non-alphanumeric characters are removed."
  (slug-call (list #'slug-r--pre-alnum
                   #'slug-r-diacritics
                   #'slug-r-alnum-parens-or-space
                   #'slug-r--post-alnum)
             s))

(defun slug-to-nd-09az (s)
  "Simplify string S to 0-9a-z and single dashes.
It does not transliterate Unicode.

Diacritics are removed: “nd” stands for “no diacritics”.

Symbols, alphanumeric characters from other alphabets, and
non-alphanumeric characters are removed."
  (slug-call (list #'slug-r--pre-alnum
                   #'slug-r-diacritics
                   #'slug-r-09Az-parens-or-space
                   #'slug-r--post-alnum)
             s))

(defun slug-r--pre-alnum (s)
  "Helper function to process S before alphanumerics."
  (slug-call (list #'slug-r-org-stats-cookie
                   #'slug-r-html-tags
                   #'slug-r-urls-org
                   #'slug-r-urls-md
                   #'slug-r-and
                   #'slug-r-dot
                   #'slug-r-plus)
             s))

(defun slug-r--post-alnum (s)
  "Helper function to process S after alphanumerics."
  (slug-call (list #'slug-r-trim
                   #'slug-r-one-space
                   #'slug-r-parens-to-dashes
                   #'slug-r-parens
                   #'slug-r-space-to-dash
                   #'slug-r-trim-dash
                   #'slug-r-one-dash
                   #'downcase)
             s))


;;;;;; Unidecode: transliteration functions

(slug--describe
  "These are functions to transliterate Unicode characters into ASCII.
- Those in pure Emacs Lisp depend on the elisp package unidecode.
- Prefer to call Python instead? It depends on python3-unidecode.")

;;;;;;; Your pick

(defun slug-r-ud-default (s)
  "Transliterate Unicode string S into ASCII.
Use the function that ‘slug-r-ud-default-function’ points to."
  (funcall slug-r-ud-default-function s))


;;;;;;; Do it all in Emacs Lisp

(defun slug-r-ud-unidecode (s)
  "Transliterate Unicode string S into ASCII.
Do so by calling ‘unidecode’ on string S.

You'd need to have the unidecode elisp package."
  (unless (require 'unidecode nil 'noerror)
    (error "Package unidecode is needed but couldn't be required"))
  (unidecode s))


;;;;;;; Do it by calling Python

(defun slug-r-ud-python-unidecode (s)
  "Transliterate Unicode string S into ASCII.
Do so by calling python3-unidecode on string S.

That package would need to be installed on your system."
  (let* ((cmd (concat "import re, sys, unidecode; "
                      "print (unidecode.unidecode(sys.argv[1]))"))
         (res (with-temp-buffer
                (list :exit-status
                      (call-process "python3" nil t nil "-c" cmd s)
                      :output
                      (slug--chomp (buffer-string))))))
    (pcase (plist-get res :exit-status)
      (0   (plist-get res :output))
      (_   (error "Call to python3-unidecode failed")))))

(defun slug--chomp (s)
  "Remove a trailing newline from string S."
  (replace-regexp-in-string "\\(\r\n\\|\r\\|\n\\)\\'" "" s))


;;;;;; Replacement of diacritics

(slug--describe
  "These functions remove or expand diacritics from strings.")

(defun slug-r-expand-german (s)
  "Expand Eszett and umlauted characters in string S."
  (slug-call (list #'slug-r-expand-eszett
                   #'slug-r-expand-umlauted)
             s))

(defun slug-r-diacritics (s)
  "Remove diacritics from string S.
Note that this is unlikely to preserve the phonology of the original
language in which S is written.

For example, in German it'd do this: schön → schon, but “schoen” would
be the better and more standard diacritics-free conversion. If you need
that, you may want to filter S first through ‘slug-r-expand-german’.

For languages using non–Latin-based scripts, try ‘slug-r-ud-default’,
which may be able to transliterate S into ASCII reasonably enough."
  (slug-call (list #'slug-r-diacritics-undecomposable
                   #'slug-r-diacritics-decomposable)
             s))

(defun slug-r-diacritics-decomposable (s)
  "Remove diacritics from decomposable characters in string S."
  (let ((s (ucs-normalize-NFC-string s))
        cur dec res)
    (dotimes (idx (length s))
      (setq cur (aref s idx))
      (if (< cur ?z)
          (push cur res)
        (setq dec (get-char-code-property cur 'decomposition))
        (unless (symbolp (car dec))  ; e.g. ?™ -> (super 84 77)
          (push (car dec) res))))
    (concat (nreverse res))))

(defun slug-r-diacritics-undecomposable (s)
  "Remove diacritics from undecomposable characters in string S.
Deal with a few non-ASCII characters that aren't Unicode compositions
but could nevertheless be stripped into ASCII ones:
- đ ħ ł ø æ œ ß  →  d h l o ae oe ss
- Đ Ħ Ł Ø Æ Œ ẞ  →  D H L O Ae Oe SS

The first four are letters with a stroke.
The next two are ligatures.
The last is a German Eszett.

All these are present in a few languages, and are common enough to be
relevant for our sluggifying purposes."
  (slug-call (list #'slug-r-strokes
                   #'slug-r-expand-ligatures
                   #'slug-r-expand-eszett)
             s))

(defun slug-r-strokes (s)
  "Remove strokes from undecomposable characters in string S.
These are present in a few languages, and are common enough to be
relevant for our sluggifying purposes:
- đ ħ ł ø  →  d h l o
- Đ Ħ Ł Ø  →  D H L O."
  (slug--s-replace-all '(("đ" . "d")  ("Đ" . "D")
                         ("ħ" . "h")  ("Ħ" . "H")
                         ("ł" . "l")  ("Ł" . "L")
                         ("ø" . "o")  ("Ø" . "O"))
                       s))

(defun slug-r-expand-ligatures (s)
  "Expand ligatures of undecomposable characters in string S.
These are present in a few languages, and are common enough to be
relevant for our sluggifying purposes:
- æ œ  → ae oe
- Æ Œ  → Ae Oe."
  (slug--s-replace-all '(("æ" . "ae") ("Æ" . "Ae")
                         ("œ" . "oe") ("Œ" . "Oe"))
                       s))

(defun slug-r-expand-eszett (s)
  "Expand Eszett in string S.
- ß  →  ss
- ẞ  →  SS."
  (slug--s-replace-all '(("ß" . "ss") ("ẞ" . "SS")) s))

(defun slug-r-expand-umlauted (s)
  "Expand umlauted characters in string S.
- ä ö ü  →  ae oe ue
- Ä Ö Ü  →  Ae Oe Ue."
  (slug--s-replace-all '(("ä" . "ae") ("Ä" . "Ae")
                         ("ö" . "oe") ("Ö" . "Oe")
                         ("ü" . "ue") ("Ü" . "Ue"))
                       s))

(defun slug--s-replace-all (alist s)
  "In string S, replace each KEY from ALIST with its VALUE.
  Adapted from s.el's ‘s-replace-all’."
  (let ((case-fold-search nil))
    (replace-regexp-in-string
     (regexp-opt (mapcar #'car alist))
     (lambda (key) (cdr (assoc-string key alist)))
     s t t)))


;;;;;; Assortment of small replacement functions

(slug--describe
  "These are small replacement functions.
You can easily combine any number of them using ‘slug-call’.")

;;;;;;; Pre-alnum functions

(slug--describe
  "These would be typically used to clean a string before restricting it to
alphanumeric characters.")

(defun slug-r-org-stats-cookie (s)
  "Remove Org completion stats cookies from string S.
For example: [10/42]."
  ;; Regexp taken from ‘org-update-statistics-cookies’
  (let ((cookie-rx "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)"))
    (replace-regexp-in-string cookie-rx "" s)))

(defun slug-r-html-tags (s)
  "Remove <FOO>..</FOO> HTML tags from string S."
  (replace-regexp-in-string "<\\(?1:[a-z]+\\)[^>]*>.*</\\1>" "" s))

(defvar slug-url-rx
  (concat
   "\\("
   "news\\(post\\)?:\\|mailto:\\|file:"
   "\\|"
   "\\(ftp\\|https?\\|telnet\\|gopher\\|gemini\\|www\\|wais\\)://"
   "\\)")
  "Regexp matching the beginning of a URI.
Borrowed from ‘ffap-url-regexp’.")

(defun slug-r-urls-org (s)
  "Remove Org URLs from string S.
: [[URL][Description]]
is how they look like."
  (let ((org-url (concat "\\[\\[" slug-url-rx "[^]]+\\]\\[")))
    (replace-regexp-in-string org-url "[[" s)))

(defun slug-r-urls-md (s)
  "Remove Markdown URLs from string S.
: [Description](URL)
is how they look like."
  (let ((md-url (concat "\\](" slug-url-rx "[^)]+)")))
    (replace-regexp-in-string md-url "]" s)))

(defun slug-r-and (s)
  "Replace \"&\" with \" and \" in string S."
  (replace-regexp-in-string "&"   " and "  s))

(defun slug-r-dot (s)
  "Replace \".\" with \" dot \" in string S."
  (replace-regexp-in-string "\\." " dot "  s))

(defun slug-r-plus (s)
  "Replace \"+\" with \" plus \" in string S."
  (replace-regexp-in-string "\\+" " plus " s))

(defun slug-r-up-to-colon (s)
  "If string S has a colon, remove it and everything after."
  (replace-regexp-in-string ":.*" "" s))


;;;;;;; Alphanumeric restriction functions

(slug--describe
  "These restrict a string to only alphanumeric-ish characters.")

(defun slug-r-09Az-or-space (s)
  "Replace with a space all except 0-9A-Za-z in S."
  (replace-regexp-in-string "[^0-9A-Za-z]" " " s))

(defun slug-r-09Az-parens-or-space (s)
  "Replace with a space all except 0-9A-Za-z() in S."
  (replace-regexp-in-string "[^0-9A-Za-z()]" " " s))

(defun slug-r-alnum-or-space (s)
  "Replace with a space all except [:alnum:] in S.
  Note that [:alnum:] is not restricted to ASCII: alphanumeric characters
  in non-Latin scripts will be preserved."
  (replace-regexp-in-string "[^[:alnum:]]" " " s))

(defun slug-r-alnum-parens-or-space (s)
  "Replace with a space all except [:alnum:]() in S.
Note that [:alnum:] is not restricted to ASCII: alphanumeric characters
in non-Latin scripts will be preserved."
  (replace-regexp-in-string "[^[:alnum:]()]" " " s))


;;;;;;; Post-alnum functions

(slug--describe
  "These would be typically used to clean a string after restricting it to
alphanumeric characters.")

(defun slug-r-trim (s)
  "Remove leading and trailing whitespace from string S."
  (replace-regexp-in-string "\\(^[[:space:]]*\\|[[:space:]]*$\\)" "" s))

(defun slug-r-one-space (s)
  "Replace two or more spaces with a single space in S."
  (replace-regexp-in-string "[[:space:]]\\{2,\\}" " " s))

(defun slug-r-parens-to-dashes (s)
  "Replace parentheses with dashes in parenthesized substrings of S."
  (replace-regexp-in-string "\\s-*([[:space:]]*\\([^)]+?\\)[[:space:]]*)\\s-*"
                            " -\\1- " s))

(defun slug-r-parens (s)
  "Remove parentheses characters from string S."
  (replace-regexp-in-string "[()]" "" s))

(defun slug-r-space-to-dash (s)
  "Replace spaces with dashes in string S."
  (replace-regexp-in-string " " "-" s))

(defun slug-r-trim-dash (s)
  "Remove leading and trailing dashes from string S."
  (replace-regexp-in-string "\\(^[-]*\\|[-]*$\\)" "" s))

(defun slug-r-one-dash (s)
  "Replace sequences of dashes in string S with a single one."
  (replace-regexp-in-string "-+" "-" s))


;;;;; Generation of unique identifiers

(slug--describe
  "These functions generate unique strings, which are useful to prepend or
append to slugs when there's a risk of duplicates.")


;;;;;; Random hex digits

(slug--describe
  "Make your slugs unique by appending a random hex string.")

(defun slug-a-append-hex-maybe (s)
  "Append random hex to string S if one is not yet present."
  (let* ((hex-rx (format "[0-9a-f]\\{%s\\}" slug-a-hex-digits-min))
         (post-hex-rx (concat "-" hex-rx "\\'")))
    (if (string-match post-hex-rx s) s (slug-a-append-hex s))))

(defun slug-a-append-hex (s)
  "Append hex string to string S.
To avoid appending more than once, use ‘slug-a-append-hex-maybe’."
  (format "%s-%s" s (slug--a-make-hex)))

(defun slug--a-make-hex ()
  "Create a random string of ‘slug-a-hex-digits’ hex digits."
  (slug--a-make-hex-n slug-a-hex-digits))

(defun slug--a-make-hex-n (n)
  "Create a random string of N hex digits.
If ‘slug-a-hex-hash-algo’ is \\='sha512 (the default), then
N can be between 0 and 128."
  ;; Modified and simplified from ‘org-id-uuid’.
  (let* ((rnd (format "%s%s%s%s%s%s%s"
                      (random)
                      (decode-time)
                      (user-uid)
                      (emacs-pid)
                      (user-full-name)
                      user-mail-address
                      (recent-keys)))
         (hsh (secure-hash slug-a-hex-hash-algo rnd)))
    (substring hsh 0 n)))


;;;;;; Dates

(slug--describe
  "Make your slugs unique by prepending a date.")

(defun slug-a-prepend-date-maybe (s)
  "Prepend date to string S if one is not yet present."
  (let ((pre-date-rx (concat "\\`" slug-a-date-rx "-")))
    (if (string-match pre-date-rx s) s (slug-a-prepend-date s))))

(defun slug-a-prepend-date (s)
  "Prepend date to string S.
To avoid prepending more than once, use ‘slug-a-prepend-date-maybe’."
  (format "%s-%s" (slug--a-make-today) s))

(defun slug--a-make-today ()
  "Create a string of today's date."
  (format-time-string slug-a-date-format))


;;;;;; Timestamps

(slug--describe
  "Make your slugs unique by appending a timestamp.")

(defun slug-a-append-ts-maybe (s)
  "Append timestamp to string S if one is not yet present."
  (let ((post-ts-rx (concat "-" slug-a-ts-rx "\\'")))
    (if (string-match post-ts-rx s) s (slug-a-append-ts s))))

(defun slug-a-append-ts (s)
  "Append timestamp to string S.
To avoid appending more than once, use ‘slug-a-append-ts-maybe’."
  (format "%s-%s" s (slug--a-make-now)))

(defun slug--a-make-now ()
  "Create a timestamp string of now."
  (format-time-string slug-a-ts-format))


;;;; Commands
;;;;; See README

(slug--describe
  "Commands to open slug's README.org. Optionally, find things in it.")

;;;###autoload
(defun slug-see-readme (&optional heading narrow)
  "Open slug's README.org file.
Search for the file in slug.el's directory.

If found, open it read-only.

If optional argument HEADING is passed, try to navigate to the
heading after opening it. HEADING should be a string.

If optional argument NARROW is non-nil, narrow to that heading.
This argument has no effect if HEADING is nil or not found."
  (interactive)
  (let ((readme slug--readme-org))
    (if (file-exists-p readme)
        (let ((pr (make-progress-reporter
                   (format "Opening %s ... "
                           (abbreviate-file-name readme)))))
          (find-file-read-only readme)
          (when heading
            (slug--goto-org-heading heading narrow))
          (progress-reporter-done pr))
      (message "Couldn't find %s's README.org" slug--name))))

;;;###autoload
(defun slug-see-news ()
  "See the News in slug's README.org file."
  (interactive)
  (slug-see-readme "News" 'narrow)
  (slug--display-org-subtree))

(defun slug--display-org-subtree ()
  "Selectively display org subtree."
  (let ((cmds '(outline-hide-subtree
                outline-show-children
                outline-next-heading
                outline-show-branches)))
    (and (fboundp (nth 0 cmds))
         (fboundp (nth 1 cmds))
         (fboundp (nth 2 cmds))
         (fboundp (nth 3 cmds))
         (mapc #'funcall cmds))))

(defun slug--goto-org-heading (heading &optional narrow)
  "Navigate to org HEADING and optionally NARROW to it."
  (let* ((hrx (format "^[*]+ %s" heading))
         (pos (save-match-data
                (save-excursion
                  (save-restriction
                    (widen)
                    (goto-char (point-max))
                    (re-search-backward hrx nil t 1))))))
    (when pos
      (widen)
      (goto-char pos)
      (if (and narrow (fboundp 'org-narrow-to-subtree))
          (org-narrow-to-subtree)
        (recenter-top-bottom 1))
      (when (fboundp 'outline-show-subtree)
        (outline-show-subtree))
      (when (fboundp 'org-flag-drawer)
        (save-excursion
          (forward-line 1)
          (org-flag-drawer t))))))


;;;; Wrapping up

(provide 'slug)

;; Local Variables:
;; coding:                     utf-8
;; indent-tabs-mode:           nil
;; sentence-end-double-space:  nil
;; outline-regexp:             ";;;;* "
;; End:

;;; slug.el ends here