Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | feat(settings): 支持后台配置自定义快捷菜单 (Shortcuts) |
|---|---|
| Downloads: | Tarball | ZIP archive |
| Timelines: | family | ancestors | trunk |
| Files: | files | file ages | folders |
| SHA3-256: |
44edc6e616af3cf8274b703e59fd2d3c |
| User & Date: | pluto 2026-11-08 15:56:29.901 |
Context
|
2026-11-08
| ||
| 15:56 | feat(settings): 支持后台配置自定义快捷菜单 (Shortcuts) Leaf check-in: 44edc6e616 user: pluto tags: trunk | |
| 15:31 | build(docker): 添加 Dockerfile 与容器化配置文件 check-in: a179294576 user: pluto tags: trunk | |
Changes
Changes to src/logic/nemoptera_setup.lfe.
| ︙ | ︙ | |||
95 96 97 98 99 100 101 102 103 104 105 106 107 108 |
(`#(EXIT ,reason) `#(error ,(lists:flatten (io_lib:format "Administrator: ~p" (list reason)))))
(_
(put-setting "site_name" (maps:get 'site_name fields))
(put-setting "site_url" (trim-slash (maps:get 'site_url fields)))
(put-setting "site_tagline" (maps:get 'site_tagline fields ""))
(put-setting "site_description" (maps:get 'site_description fields ""))
(put-setting "loose_title" (default-text fields 'loose_title "Repositories"))
(case (file:write_file (installed-flag) #"ok")
('ok 'ok)
(`#(error ,reason) `#(error ,(lists:flatten (io_lib:format "Install flag: ~p" (list reason))))))))))
(defun put-setting (key value)
(nemoptera_db:q "INSERT OR REPLACE INTO site_settings(key,value) VALUES(?,?);"
(list key (nemoptera_text:to-str value))))
| > | 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 |
(`#(EXIT ,reason) `#(error ,(lists:flatten (io_lib:format "Administrator: ~p" (list reason)))))
(_
(put-setting "site_name" (maps:get 'site_name fields))
(put-setting "site_url" (trim-slash (maps:get 'site_url fields)))
(put-setting "site_tagline" (maps:get 'site_tagline fields ""))
(put-setting "site_description" (maps:get 'site_description fields ""))
(put-setting "loose_title" (default-text fields 'loose_title "Repositories"))
(put-setting "custom_shortcuts" (maps:get 'custom_shortcuts fields ""))
(case (file:write_file (installed-flag) #"ok")
('ok 'ok)
(`#(error ,reason) `#(error ,(lists:flatten (io_lib:format "Install flag: ~p" (list reason))))))))))
(defun put-setting (key value)
(nemoptera_db:q "INSERT OR REPLACE INTO site_settings(key,value) VALUES(?,?);"
(list key (nemoptera_text:to-str value))))
|
| ︙ | ︙ |
Changes to src/logic/nemoptera_site.lfe.
1 2 3 4 5 6 7 8 9 |
(defmodule nemoptera_site
(export all))
(defun all ()
(maps:from_list
(list (tuple 'site_name (setting "site_name" "Nemoptera"))
(tuple 'site_url (setting "site_url" (default-url)))
(tuple 'site_tagline (setting "site_tagline" "Repositories hosted with Fossil."))
(tuple 'site_description (setting "site_description" ""))
| | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
(defmodule nemoptera_site
(export all))
(defun all ()
(maps:from_list
(list (tuple 'site_name (setting "site_name" "Nemoptera"))
(tuple 'site_url (setting "site_url" (default-url)))
(tuple 'site_tagline (setting "site_tagline" "Repositories hosted with Fossil."))
(tuple 'site_description (setting "site_description" ""))
(tuple 'loose_title (setting "loose_title" "Repositories"))
(tuple 'custom_shortcuts (setting "custom_shortcuts" "")))))
(defun setting (key default)
(if (nemoptera_setup:installed?)
(case (catch (nemoptera_db:q "SELECT value FROM site_settings WHERE key=?;" (list key)))
(`((,value)) (let ((text (nemoptera_text:to-str value)))
(if (=:= "" text) default text)))
(_ default))
|
| ︙ | ︙ | |||
136 137 138 139 140 141 142 |
(maps:from_list
(list (tuple 'name (nemoptera_text:to-str name))
(tuple 'description (nemoptera_text:to-str description))
(tuple 'timeline (nemoptera_text:to-str timeline))
(tuple 'url (repo-path org-name name))))))
rows))
(_ '())))
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 |
(maps:from_list
(list (tuple 'name (nemoptera_text:to-str name))
(tuple 'description (nemoptera_text:to-str description))
(tuple 'timeline (nemoptera_text:to-str timeline))
(tuple 'url (repo-path org-name name))))))
rows))
(_ '())))
(defun custom-shortcuts ()
(parse-shortcuts (setting "custom_shortcuts" "")))
(defun parse-shortcuts (raw)
(let ((lines (string:split (nemoptera_text:to-str raw) "\n" 'all)))
(lists:filtermap #'parse-shortcut-line/1 lines)))
(defun parse-shortcut-line (line)
(let ((trimmed (string:trim line)))
(cond
((=:= "" trimmed) 'false)
((=:= 35 (hd trimmed)) 'false)
('true
(case (string:split trimmed "|" 'all)
(`(,label ,url ,target)
(make-shortcut label url (target-mode target url)))
(`(,label ,url)
(make-shortcut label url (default-target url)))
(`(,single)
(case (string:split single " " 'leading)
(`(,label ,url)
(make-shortcut label url (default-target url)))
(_ 'false)))
(_ 'false))))))
(defun make-shortcut (label url target)
(let ((l (string:trim label))
(u (string:trim url)))
(if (or (=:= "" l) (=:= "" u))
'false
`#(true ,(tuple 'custom u l target)))))
(defun default-target (url)
(let ((u (string:trim url)))
(if (or (lists:prefix "http://" u) (lists:prefix "https://" u))
'blank
'self)))
(defun target-mode (target url)
(let ((t (string:lowercase (string:trim target))))
(cond
((or (=:= t "_blank") (=:= t "blank") (=:= t "new")) 'blank)
((or (=:= t "_self") (=:= t "self")) 'self)
('true (default-target url)))))
|
Changes to src/web/nemoptera_admin.lfe.
| ︙ | ︙ | |||
190 191 192 193 194 195 196 |
((not (=:= password password2)) `#(error "The two passwords do not match."))
('true
(nemoptera_site:put-settings
(list (tuple "site_name" name)
(tuple "site_url" (nemoptera_setup:trim-slash url))
(tuple "site_tagline" (nemoptera_http:param req "site_tagline"))
(tuple "site_description" (nemoptera_http:param req "site_description"))
| | > | 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 |
((not (=:= password password2)) `#(error "The two passwords do not match."))
('true
(nemoptera_site:put-settings
(list (tuple "site_name" name)
(tuple "site_url" (nemoptera_setup:trim-slash url))
(tuple "site_tagline" (nemoptera_http:param req "site_tagline"))
(tuple "site_description" (nemoptera_http:param req "site_description"))
(tuple "loose_title" (defaulting (nemoptera_http:param req "loose_title") "Repositories"))
(tuple "custom_shortcuts" (nemoptera_http:param req "custom_shortcuts"))))
(if (nemoptera_text:blank? password)
'ok
(let ((user (nemoptera_auth:current-user req))
(now (nemoptera_text:now-iso)))
(nemoptera_db:q "UPDATE admin_user SET password_hash=?, updated_at=? WHERE username=?;"
(list (nemoptera_crypto:hash-password password) now user))
'ok))))))
|
| ︙ | ︙ | |||
349 350 351 352 353 354 355 356 357 358 359 360 361 362 |
"<form method=\"post\" action=\"/admin/settings\">"
(nemoptera_http:csrf-field req)
(text "site_name" "Site name" (maps:get 'site_name site))
(text "site_url" "Site URL" (maps:get 'site_url site))
(text "site_tagline" "Tagline" (maps:get 'site_tagline site))
(area "site_description" "Description for uncategorized repositories" (maps:get 'site_description site))
(text "loose_title" "Heading for uncategorized repositories" (maps:get 'loose_title site))
(password "password" "New administrator password")
(password "password2" "Repeat new password")
"<p class=\"actions\"><button type=\"submit\">Save</button></p></form>"))
(defun text (name label current)
(list "<label for=\"" name "\">" label "</label><input id=\"" name "\" name=\"" name
"\" type=\"text\" value=\"" (nemoptera_ui:escape current) "\">"))
| > > | 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 |
"<form method=\"post\" action=\"/admin/settings\">"
(nemoptera_http:csrf-field req)
(text "site_name" "Site name" (maps:get 'site_name site))
(text "site_url" "Site URL" (maps:get 'site_url site))
(text "site_tagline" "Tagline" (maps:get 'site_tagline site))
(area "site_description" "Description for uncategorized repositories" (maps:get 'site_description site))
(text "loose_title" "Heading for uncategorized repositories" (maps:get 'loose_title site))
(area "custom_shortcuts" "Custom shortcuts (one per line: Name | URL)" (maps:get 'custom_shortcuts site ""))
"<p class=\"note\">Format: <code>Name | URL</code> (e.g. <code>Blog | https://blog.example.com</code> or <code>Docs | /docs</code>). External links open in a new tab.</p>"
(password "password" "New administrator password")
(password "password2" "Repeat new password")
"<p class=\"actions\"><button type=\"submit\">Save</button></p></form>"))
(defun text (name label current)
(list "<label for=\"" name "\">" label "</label><input id=\"" name "\" name=\"" name
"\" type=\"text\" value=\"" (nemoptera_ui:escape current) "\">"))
|
| ︙ | ︙ |
Changes to src/web/nemoptera_ui.lfe.
| ︙ | ︙ | |||
22 23 24 25 26 27 28 |
(defun recent-label ()
(if (nemoptera_setup:installed?)
(nemoptera_site:recent-stamp)
"no changes yet"))
(defun shortcuts (current mode logged-in?)
| > > > | | > | > | > > | | > > | < | > > | | | > | | | | | > > | | 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 |
(defun recent-label ()
(if (nemoptera_setup:installed?)
(nemoptera_site:recent-stamp)
"no changes yet"))
(defun shortcuts (current mode logged-in?)
(let ((items (if (=:= mode 'admin)
(admin-links logged-in?)
(public-links logged-in?))))
(lists:map (lambda (item) (render-shortcut item current)) items)))
(defun render-shortcut (item current)
(case item
(`#(,key ,href ,label ,target)
(list "<a href=\"" (escape href) "\""
(if (=:= target 'blank) " target=\"_blank\" rel=\"noopener\"" "")
">"
(if (=:= key current) (list "<strong>" (escape label) "</strong>") (escape label))
"</a>"))
(`#(,key ,href ,label)
(list "<a href=\"" (escape href) "\">"
(if (=:= key current) (list "<strong>" (escape label) "</strong>") (escape label))
"</a>"))))
(defun public-links (logged-in?)
(lists:append
(list (tuple 'home "/" "Home")
(tuple 'repos "/#repositories" "Repositories")
(tuple 'orgs "/#organizations" "Organizations")
(tuple 'timeline "/timeline" "Timeline"))
(lists:append
(nemoptera_site:custom-shortcuts)
(if logged-in?
(list (tuple 'admin "/admin" "Admin") (tuple 'logout "/logout" "Logout"))
(list (tuple 'login "/login" "Login"))))))
(defun admin-links (_logged-in?)
(lists:append
(list (tuple 'home "/admin" "Home")
(tuple 'repos "/admin/repos" "Repositories")
(tuple 'orgs "/admin/orgs" "Organizations")
(tuple 'settings "/admin/settings" "Settings")
(tuple 'public "/" "Public site"))
(lists:append
(nemoptera_site:custom-shortcuts)
(list (tuple 'logout "/logout" "Logout")))))
(defun escape (value)
(let ((text (nemoptera_text:to-str value)))
(string:replace
(string:replace
(string:replace
(string:replace
|
| ︙ | ︙ |