summaryrefslogtreecommitdiffstatshomepage
path: root/gemini-mode.el
blob: afb5b4b7dd6bb19da58e670a478ca354a116b40e (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
;;; gemini-mode.el --- A simple highlighting package for text/gemini -*- lexical-binding: t; -*-

;; Copyright (C) 2020  Jason McBrayer

;; Author: Jason McBrayer <jmcbray@carcosa.net>, tastytea <tastytea@tastytea.de>
;; Created: 20 May 2020
;; Version: 0.5.2
;; Keywords: languages
;; Homepage: https://git.carcosa.net/jmcbray/gemini.el
;; Package-Requires: ((emacs "24.3"))

;;; Commentary:

;; This package provides a major mode for editing text/gemini files.
;; Currently, it only provides syntax-highlighting support.

;; This file is not part of GNU Emacs.

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero 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 Affero General Public License for more details.

;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Code:
(require 'cl-lib)

(defface gemini-heading-face-1
  '((t :inherit bold :height 1.8))
  "Face for Gemini headings level 1"
  :group 'gemini-mode)
(defface gemini-heading-face-2
  '((t :inherit bold :height 1.4))
  "Face for Gemini headings level 2"
  :group 'gemini-mode)
(defface gemini-heading-face-3
  '((t :inherit bold :height 1.2))
  "Face for Gemini headings level 3"
  :group 'gemini-mode)
(defface gemini-heading-face-rest
  '((t :inherit bold))
  "Face for Gemini headings below level 3"
  :group 'gemini-mode)

(defvar gemini-highlights
  (let* ((gemini-heading-3-regexp "^###\s.*$")
         (gemini-heading-2-regexp "^##\s.*$")
         (gemini-heading-1-regexp "^#\s.*$")
         (gemini-heading-rest-regexp "^###+\s.*$")
         (gemini-link-regexp "^=>.*$")
         (gemini-ulist-regexp "^\\*")
         (gemini-preformatted-regexp "^```"))
    `((,gemini-heading-rest-regexp . 'gemini-heading-face-rest)
      (,gemini-heading-3-regexp . 'gemini-heading-face-3)
      (,gemini-heading-2-regexp . 'gemini-heading-face-2)
      (,gemini-heading-1-regexp . 'gemini-heading-face-1)
      (,gemini-link-regexp . 'link)
      (,gemini-ulist-regexp . 'font-lock-keyword-face)
      (,gemini-preformatted-regexp . 'font-lock-builtin-face)))
  "Font lock keywords for `gemini-mode'.")

(defvar gemini-mode-map
  (let ((map (make-keymap)))
    (define-key map (kbd "C-c C-l") #'gemini-insert-link)
    (define-key map (kbd "C-c RET") #'gemini-insert-list-item)
    map)
  "Keymap for `gemini-mode'.")

;; See RFC 3986 (URI).
(defconst gemini-regex-uri
  "\\([a-zA-z0-9+-.]+:[^]\t\n\r<>,;() ]+\\)"
  "Regular expression for matching URIs.")

(defun gemini-get-used-uris ()
  "Return a list of all used URIs in the buffer."
  (save-excursion
    (goto-char (point-min))
    (let (uris)
      (while (re-search-forward gemini-regex-uri nil t)
        (push (match-string 1) uris))
      uris)))

(defun gemini-insert-link ()
  "Insert new link, with interactive prompts.
If there is an active region, use the text as the default URL, if
it seems to be a URL, or link text value otherwise."
  (interactive)
  (cl-multiple-value-bind (begin end text uri)
      (if (use-region-p)
          ;; Use region as either link text or URL as appropriate.
          (let ((region (buffer-substring-no-properties
                         (region-beginning) (region-end))))
            (if (string-match gemini-regex-uri region)
                ;; Region contains a URL; use it as such.
                (list (region-beginning) (region-end)
                      nil (match-string 1 region))
              ;; Region doesn't contain a URL, so use it as text.
              (list (region-beginning) (region-end)
                    region nil))))
    (let* ((used-uris (gemini-get-used-uris))
           (uri (completing-read "URL: "
                                 used-uris nil nil uri))
           (text (completing-read "Link text (blank for plain URL): "
                                  nil nil nil text)))
      (when (and begin end)
        (delete-region begin end))
      (insert "=> " uri)
      (unless (string= text "")
        (insert " " text)))))

(defun gemini-insert-list-item ()
  "Insert a new list item.
If at the beginning of a line, just insert it. Otherwise
go to the end of the current line, insert a newline, and
insert a list item."
  (interactive)
  (if (equal (line-beginning-position) (point))
      (insert "* ")
    (end-of-line)
    (newline)
    (insert "* ")))

;;;###autoload
(define-derived-mode gemini-mode text-mode "gemini"
  "Major mode for editing text/gemini 'geminimap' documents"
  (setq font-lock-defaults '(gemini-highlights))
  (if (fboundp #'visual-fill-column-mode)
      (progn
        (visual-line-mode 1)
        (visual-fill-column-mode 1))
    (visual-line-mode 1)))

;;;###autoload
(progn
  (add-to-list 'auto-mode-alist '("\\.gmi\\'" . gemini-mode))
  (add-to-list 'auto-mode-alist '("\\.gemini\\'" . gemini-mode))
  (add-to-list 'auto-mode-alist '("\\.geminimap\\'" . gemini-mode)))

(provide 'gemini-mode)

;;; gemini-mode.el ends here