From fbf64586a5edbc9c07bedd9dd30676b89b3bff73 Mon Sep 17 00:00:00 2001 From: Leah Neukirchen Date: Mon, 24 May 2021 15:16:32 +0200 Subject: initial commit --- moar.el | 215 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 215 insertions(+) create mode 100644 moar.el diff --git a/moar.el b/moar.el new file mode 100644 index 0000000..b832320 --- /dev/null +++ b/moar.el @@ -0,0 +1,215 @@ +;;; moar.el --- a very simple single-file hypertext system + +;; Author: Leah Neukirchen +;; To the extent possible under law, the creator of this work has waived +;; all copyright and related or neighboring rights to this work. +;; https://creativecommons.org/publicdomain/zero/1.0/ + +(require 'seq) +(require 'pcase) +(eval-when-compile (require 'subr-x)) + +(defface moar-title-face + '((t (:bold t :underline t))) + "Face to use for Moar titles." + :group 'font-lock-highlighting-faces) + +(defface moar-link-face + '((t)) + "Face to use for Moar links." + :group 'font-lock-highlighting-faces) + +(defface moar-page-break-face + '((t (:foreground "grey50"))) + "Face to use for Moar page breaks." + :group 'font-lock-highlighting-faces) + +(defvar-local moar-history nil) + +(defun moar-add-page (title) + (goto-char (point-max)) + (unless (= (preceding-char) ?\n) + (insert "\n")) + (insert "\C-l\n" text "\n\n")) + +(defun moar-visit-link (text) + (if (string-match "#" text) + (progn + (let ((file (substring text 0 (match-beginning 0))) + (target (substring text (match-end 0)))) + (find-file file) + (when (equal major-mode 'fundamental-mode) + (moar-mode)) + (moar-visit-link target))) + (let ((old-point (point)) + (narrowed (buffer-narrowed-p))) + (widen) + (goto-char (point-min)) + (if (re-search-forward (concat "\C-l\n[^\n]*" (regexp-quote text)) + nil t) + (move-beginning-of-line 1) + (goto-char old-point) + (when (y-or-n-p (concat "Link `" text "' not found, create?")) + (moar-add-page text))) + (when narrowed + (narrow-to-page))))) + +(defun moar-visit-today () + (interactive) + (moar-visit-link (format-time-string "%Y-%m-%d" (current-time)))) + +(defun moar-visit-yesterday () + (interactive) + (moar-visit-link (format-time-string "%Y-%m-%d" + (time-subtract (current-time) + (* 24 3600))))) + +(defun moar-go-back () + (interactive) + (if (null moar-history) + (progn + (widen) + (goto-char (point-min))) + (let ((n (pop moar-history))) + (widen) + (goto-char n)))) + +(defun moar-link-at-point () + (let (link-start + link-end) + (if (and (looking-back "\\[.*?") + (setq link-start (1+ (match-beginning 0))) + (looking-at ".*?\\]") + (setq link-end (1- (match-end 0))) + (< link-start link-end)) ; don't match empty links + (buffer-substring-no-properties link-start link-end)))) + +(defun moar-follow-link-or-newline () + (interactive) + (if-let (link (moar-link-at-point)) + (progn + (push (point) moar-history) + (if (string-prefix-p "<" link) + (moar-visit-backlink-interactive (substring link 1)) + (moar-visit-link link))) + (newline))) + +(defun moar-follow-link-from-mouse (e) + (interactive "e") + (mouse-set-point e) + (when-let (link (moar-link-at-point)) + (push (point) moar-history) + (if (string-prefix-p "<" link) + (moar-visit-backlink-interactive (substring link 1)) + (moar-visit-link link)))) + +(defun moar-all-links () + (let ((matches)) + (save-match-data + (save-excursion + (save-restriction + (widen) + (goto-char 1) + (while (search-forward-regexp "^\C-l\n.*" nil t 1) + (push (substring (match-string 0) 2) matches))))) + matches)) + +(defun moar-all-links-and-titles () + (let (matches + current-title) + (save-match-data + (save-excursion + (save-restriction + (widen) + (goto-char 1) + (while (search-forward-regexp "^\C-l\n\\(.*\\)\\|\\[\\(.+?\\)\\]" + nil t 1) + (if (match-string 1) + (setq current-title (match-string-no-properties 1)) + (push (cons current-title (match-string-no-properties 2)) matches) + ))))) + matches)) + +(defun moar-current-title () + (save-match-data + (save-excursion + (save-restriction + (widen) + (end-of-line 1) + (if (search-backward-regexp "^\C-l\n\\(.*\\)" nil t) + (match-string-no-properties 1) + nil))))) + +(defun moar-insert-link () + (interactive) + (let* ((links (moar-all-links)) + (read (if (fboundp 'ivy-read) + #'ivy-read + #'completing-read)) + (target (funcall read "Link target? " links))) + (when target + (insert "[" target "]")))) + +(defun moar-visit-link-interactive () + (interactive) + (let* ((links (moar-all-links)) + (read (if (fboundp 'ivy-read) + #'ivy-read + #'completing-read)) + (target (funcall read "Go to: " links))) + (when target + (moar-visit-link target)))) + +(defun moar-visit-backlink-interactive (&optional title) + (interactive) + (let* ((links-titles (moar-all-links-and-titles)) + (current-title (or title (moar-current-title))) + (read (if (fboundp 'ivy-read) + #'ivy-read + #'completing-read)) + (links (mapcar #'car + (seq-filter #'(lambda (x) (equal (cdr x) current-title)) + links-titles))) + (target (funcall read "Go to backlink: " links))) + (when target + (moar-visit-link target) + (when (re-search-forward (concat "\\[" (regexp-quote current-title) "\\]") + nil t) + (goto-char (1+ (match-beginning 0)))) + ))) + +(define-derived-mode moar-mode + text-mode "Moar" + "Major mode for Moar hypertext files." + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults + '((("^\\(\C-l\\)\n\\(.*\\)" + (1 'moar-page-break-face) + (2 'moar-title-face)) + ("\\[\\(.+?\\)\\]" + (1 'moar-link-face)) + ) + t nil)) + (add-to-list 'font-lock-extra-managed-props 'display) + (font-lock-add-keywords nil + '(("^\\(\C-l\\)\n" 1 '(face nil display "∇")))) + (font-lock-mode 1) + (when (fboundp 'orgalist-mode) + (orgalist-mode 1))) + +(define-key moar-mode-map (kbd "RET") 'moar-follow-link-or-newline) +(define-key moar-mode-map [mouse-2] 'moar-follow-link-from-mouse) +(define-key moar-mode-map [follow-link] 'moar-link-face) + +(define-key moar-mode-map (kbd "C-c [") 'moar-insert-link) +(define-key moar-mode-map (kbd "C-c C-v") 'moar-visit-link-interactive) +(define-key moar-mode-map (kbd "C-c C-b") 'moar-visit-backlink-interactive) +(define-key moar-mode-map (kbd "C-c C-t") 'moar-visit-today) +(define-key moar-mode-map (kbd "C-c C-y") 'moar-visit-yesterday) +(define-key moar-mode-map (kbd "C-c C-n") 'narrow-to-page) +(define-key moar-mode-map (kbd "C-c C-w") 'widen) +(define-key moar-mode-map (kbd "C-c C-o") 'moar-go-back) + +(provide 'moar) + +;;; moar.el ends here -- cgit 1.4.1