sfos/harbour-sextant
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

WIP Backup

Browse source
This commit is contained in:
Renaud Casenave-Péré 2025-10-09 09:25:45 +02:00
parent 864b3cdb3b
commit e6b27769fa
29 changed files with 434 additions and 101 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lisp/bundle-info.sexp
View file

@ -1,4 +1,4 @@
(:CREATION-TIME "2025-08-26T20:29:46Z" :REQUESTED-SYSTEMS ("alexandria" "uiop")
(:CREATION-TIME "2025-09-07T21:02:42Z" :REQUESTED-SYSTEMS ("alexandria" "uiop")
:LISP-INFO
(:MACHINE-INSTANCE "lpt-pf3r3138-ln" :MACHINE-TYPE "x86_64" :MACHINE-VERSION
NIL :LISP-IMPLEMENTATION-TYPE "ECL" :LISP-IMPLEMENTATION-VERSION "24.5.10")

5
lisp/local-projects/cockpit/cockpit.asd
View file

@ -5,5 +5,8 @@
:around-compile (lambda (thunk)
(proclaim '(optimize (debug 3) (safety 3) (speed 0)))
(funcall thunk))
:depends-on ("sextant")
:depends-on ("sextant"
"cockpit/options/all")
:components ((:file "cockpit")))
(register-system-packages "cockpit/options/all" '(:options))

67
lisp/local-projects/cockpit/cockpit.lisp
View file

@ -1,40 +1,53 @@
(uiop:define-package :cockpit
(:use :cl :eql :sextant :config))
(:use :cl :eql :qml-lisp :sextant :config :options)
(:export
#:show-welcome-screen-p
#:data-path))
(in-package :cockpit)
(qrequire :quick)
(defconstant +cockpit-version+ 0)
(defun initialize ()
(load-config-file "harbour-sextant" "config.lisp"))
(defun finalize ()
(save-config-file "harbour-sextant" "config.lisp"))
(defun start ()
(initialize)
(ext:catch-signal ext:+SIGTERM+ :catch)
(ext:set-signal-handler ext:+SIGTERM+ #'terminate)
(qconnect qml:*quick-view* "statusChanged(QQuickView::Status)"
(lambda (status)
(case status
(#.|QQuickView.Ready| (qml-reloaded)))))
(qconnect qml:*quick-view* "closing(QQuickCloseEvent*)"
(lambda (close)
(declare (ignore close))
(finalize))))
(load-config-file "harbour-sextant" "config.lisp")
(when (and (not (slynkp)) (get-slynk-at-startup-p))
(start-slynk))
;; (when (< (get-last-seen-version) +cockpit-version+)
;; (qjs |showWelcomeScreen| "filesPage"
;; (qlet ((root-url "QUrl(QString)" qml:*root*))
;; (|path| root-url))
;; "welcome.org"))
)
(defun finalize ()
(save-config-file "harbour-sextant" "config.lisp")
(when (slynkp)
(stop-slynk)))
;; (defun start ()
;; (qconnect qml:*quick-view* "statusChanged(QQuickView::Status)"
;; (lambda (status)
;; (case status
;; (#.|QQuickView.Ready| (qml-reloaded)))))
;; (qconnect qml:*quick-view* "closing(QQuickCloseEvent*)"
;; (lambda (close)
;; (declare (ignore close))
;; (finalize))))
(defun terminate ()
(finalize)
(qrun #'qquit))
(defun reload-qml (&optional (url "http://localhost:8000/"))
(defun reload-qml (&optional url)
"Reload QML file from an url, directly on the device."
(qrun*
(let ((src (|toString| (|source| qml:*quick-view*))))
(if (x:starts-with qml:*root* src)
(|setSource| qml:*quick-view* (qnew "QUrl(QString)" (x:string-substitute url qml:*root* src)))
(qml:reload))
(|toString| (|source| qml:*quick-view*)))))
(if url
(|setSource| qml:*quick-view* (qnew "QUrl(QString)" url))
(qml:reload))
(|toString| (|source| qml:*quick-view*))))
(defun set-qml (url)
(|setSource| qml:*quick-view* (qnew "QUrl(QString)" url))
@ -42,4 +55,12 @@
(defun qml-reloaded ())
(qlater #'start)
(defun show-welcome-screen-p () (< (get-last-seen-version) +cockpit-version+))
(defun data-path ()
(qlet ((root-url "QUrl(QString)" qml:*root*))
(|path| root-url)))
(initialize)
;; (qlater #'start)

54
lisp/local-projects/cockpit/models/filelist.lisp Normal file
View file

@ -0,0 +1,54 @@
(uiop:define-package :cockpit/models/files-list
(:use :cl :eql))
(in-package :cockpit/models/files-list)
(define-roles #.|Qt.UserRole|
+filename-role+
+directory-role+
+section-role+)
(defvar *recent-files-list* nil)
(defvar *files-list* nil)
(defvar *files-list-model nil)
(defvar *empty-model-index* (qnew "QModelIndex"))
(defun refresh-files-list (agenda-files)
(setf *recent-files-list* (limit-list-size *recent-files-list* options:recent-files-size))
(setf *files-list*
(cons (cons "recentf" *recent-files-list*)
(loop for dir-or-file in agenda-files
append (if (uiop:directory-exists-p dir-or-file)
(collect-org-files dir-or-file)
(list (directory-namestring dir-or-file)
dir-or-file))))))
(defun refresh-files-list-model (agenda-files)
(unless (null *files-list-model*)
(|beginResetModel| *files-list-model*)
(refresh-files-list agenda-files)
(|endResetModel| *files-list-model*)))
(defun construct-files-list-model ()
(let ((model (qnew "QAbstractListModel")))
(qoverride model "rowCount(QModelIndex)"
(lambda (index)
(declare (ignore index))
(let ((len 0))
(mapc (lambda (list)
(incf len (legnth (cdr list))))
*files-list*))))
(qoverride model "data(QModelIndex,int)"
(lambda (index role)
(let* ((row (|row| index))
section
(item (when (> row -1)
(loop for list = *files-list* then (cdr list)
while list
do (progn
(setf section (caar list))
(if (>= row (length (cdar list))))))))))))))
(defun make-filelist-model (agenda-files &optional force)
(when (or (null *files-list-model*) force)
(construct-files-list-model))
(refresh-files-list-model agenda-files))

4
lisp/local-projects/cockpit/options/all.lisp Normal file
View file

@ -0,0 +1,4 @@
(uiop:define-package :cockpit/options/all
(:nicknames :options)
(:use-reexport
:cockpit/options/options))

8
lisp/local-projects/cockpit/options/options.lisp Normal file
View file

@ -0,0 +1,8 @@
(uiop:define-package :cockpit/options/options
(:use :cl :config))
(in-package :cockpit/options/options)
(set-config-package :cockpit/options/options)
(defconfig last-seen-version -1)
(defconfig slynk-at-startup-p nil)

4
lisp/local-projects/sextant/config/all.lisp
View file

@ -1,4 +0,0 @@
(uiop:define-package :sextant/config/all
(:nicknames :config)
(:use-reexport
:sextant/config/config))

6
lisp/local-projects/sextant/files/all.lisp Normal file
View file

@ -0,0 +1,6 @@
(uiop:define-package :sextant/files/all
(:nicknames :files)
(:use-reexport
:sextant/files/paths
:sextant/files/config
:sextant/files/files))

21
lisp/local-projects/sextant/config/config.lisp → lisp/local-projects/sextant/files/config.lisp
View file

@ -1,18 +1,14 @@
(uiop:define-package :sextant/config/config
(:use :cl)
(uiop:define-package :sextant/files/config
(:use :cl :sextant/files/paths)
(:export #:set-config-package
#:defconfig
#:load-config-file
#:save-config-file))
(in-package :sextant/config/config)
(in-package :sextant/files/config)
(defvar config-package nil)
(defvar config-probe ";;; Auto generated from here, do not edit")
(defun config-filepath (appname filename)
(merge-pathnames (concatenate 'string appname "/" filename)
(uiop:xdg-config-pathname)))
(defun set-config-package (package)
(setf config-package package))
@ -45,15 +41,15 @@
,(when doc
`(setf (documentation ,symbol 'variable) ,doc))))
(defun load-config-file (appname filename)
(defun load-config-file (filename)
"Load `filename' from standard config path."
(let ((config-pathname (config-filepath appname filename)))
(let ((config-pathname (config-filepath filename)))
(when (probe-file config-pathname)
(load config-pathname))))
(defun save-config-file (appname filename)
(defun save-config-file (filename)
"Save config values to `filename'."
(let* ((config-pathname (config-filepath appname filename))
(let* ((config-pathname (config-filepath filename))
(config-string (with-open-file (stream config-pathname :if-does-not-exist nil)
(when stream
(let ((str (make-string (file-length stream))))
@ -65,8 +61,7 @@
(let ((pos (search config-probe config-string)))
(princ (subseq config-string 0 pos) stream))
(progn
(princ ";;; Configuration file for " stream)
(print appname stream)
(princ (concatenate 'string ";;; Configuration file for Sextant") stream)
(terpri stream)
(princ ";;; You are free to edit this section" stream)
(terpri stream)

40
lisp/local-projects/sextant/files/files.lisp Normal file
View file

@ -0,0 +1,40 @@
(uiop:define-package :sextant/files/files
(:use :cl :sextant/files/paths))
(defun load-recentf (filename maxsize)
(let ((recentf-pathname (cache-filepath filename)))
(when (probe-file recentf-pathname)
(subseq (uiop:safe-read-file-form recentf-pathname :package :sextant/files/recentf) 0 maxsize))))
(defun save-recentf (filename recentf-lst)
(let ((recentf-pathname (cache-filepath filename)))
(with-open-file (stream (ensure-directories-exist recentf-pathname)
:direction :output :if-exists :supersede)
(prin1 recentf-lst stream))))
(defun push-to-recentf (recentf-lst pathname agenda-files maxsize)
(when (notany (lambda (files-lst)
(uiop:subpathp pathname (truename (parse-namestring (car files-lst)))))
agenda-files)
(subseq (remove-duplicates (push pathname recentf-lst)
:from-end t
:test #'uiop:pathname-equal)
0 maxsize)))
(defun collect-files (directory &optional (filter "*.*"))
(mapcar (lambda (dir)
(cons dir
(sort (remove-if #'uiop:hidden-pathname-p (uiop:directory-files dir filter))
#'string< :key #'pathname-name)))
(flatten (labels ((collect-dirs (dir)
(let ((subdirs (remove-if
(lambda (d)
(uiop:hidden-pathname-p
(merge-pathnames
(car (last (pathname-directory d)))
(uiop:pathname-parent-directory-pathname d))))
(uiop:subdirectories dir))))
(cons (concatenate 'string directory
(enough-namestring dir (truename directory)))
(mapcar #'collect-dirs subdirs)))))
(collect-dirs (truename directory))))))

11
lisp/local-projects/sextant/files/paths.lisp Normal file
View file

@ -0,0 +1,11 @@
(uiop:define-package :sextant/files/paths
(:use :cl)
(:export #:config-filepath
#:cache-filepath))
(in-package :sextant/files/paths)
(defun config-home () (merge-pathnames "sextant/" (uiop:xdg-config-home)))
(defun config-filepath (filename) (merge-pathnames filename (config-home)))
(defun cache-home () (merge-pathnames "sextant/" (uiop:xdg-cache-home)))
(defun cache-filepath (filename) (merge-pathnames filename (cache-home)))

4
lisp/local-projects/sextant/sextant.asd
View file

@ -7,8 +7,8 @@
(funcall thunk))
:depends-on #.(append (uiop:read-file-form (merge-pathnames #p"../../../dependencies.sexp" (or *load-pathname* *compile-file-pathname*)))
'("sextant/editor/all")
'("sextant/config/all"))
'("sextant/files/all"))
:components ((:file "sextant")))
(register-system-packages "sextant/editor/all" '(:editor))
(register-system-packages "sextant/config/all" '(:config))
(register-system-packages "sextant/files/all" '(:config))

9
lisp/local-projects/sextant/sextant.lisp
View file

@ -23,3 +23,12 @@
(setf slynkp nil)))
(defun slynkp () slynkp))
(defparameter *current-file-pathname* nil)
(defparameter *current-file-gb* nil)
(defun open-file (filepath)
(let* ((pathname (parse-namestring filepath))
(gb (make-gap-buffer (read-file-into-string pathname))))
(setf *current-file-pathname* pathname
*current-file-gb* gb)))

3
qml/components/qmldir Normal file
View file

@ -0,0 +1,3 @@
OrgDelegate 1.0 OrgDelegate.qml
OrgLine 1.0 OrgLine.qml
OrgEdit 1.0 OrgEdit.qml

3
qml/harbour-sextant.qml
View file

@ -1,10 +1,9 @@
import QtQuick 2.0
import Sailfish.Silica 1.0
import "pages/"
ApplicationWindow
{
initialPage: Component { Files { } }
initialPage: Qt.resolvedUrl("pages/Files.qml")
cover: Qt.resolvedUrl("cover/CoverPage.qml")
allowedOrientations: defaultAllowedOrientations
}

152
qml/pages-/Files.qml Normal file
View file

@ -0,0 +1,152 @@
import QtQuick 2.0
import Sailfish.Silica 1.0
import Sailfish.Pickers 1.0
import EQL5 1.0
Page {
id: files
allowedOrientations: Orientation.All
SilicaListView {
id: listView
anchors.fill: parent
header: PageHeader {
title: qsTr("Files")
}
model: agendaFilesModel
section {
property: 'section'
delegate: SectionHeader {
text: section == "recentf" ? qsTr("Recent files") : section
height: Theme.itemSizeExtraSmall
}
}
delegate: ListItem {
id: fileItem
anchors {
left: parent.left
right: parent.right
}
contentHeight: Theme.itemSizeSmall
Label {
text: section == "recentf" ? directory + filename : filename
elide: Text.ElideMiddle
width: parent.width - Theme.horizontalPageMargin * 2
font.pixelSize: Theme.fontSizeMedium
anchors {
top: parent.top
left: parent.left
leftMargin: Theme.horizontalPageMargin
rightMargin: Theme.horizontalPageMargin
centerIn: parent
}
}
onClicked: {
var filepath = directory + filename
Lisp.call("sextant:open-file", filepath)
pageStack.push(Qt.resolvedUrl("Org.qml"), {filepath: filepath, filename: filename})
}
RemorseItem { id: remorse }
menu: ContextMenu {
MenuItem {
visible: section == "recentf"
text: qsTr("Remove from list")
onClicked: {
remorse.execute(fileItem, "", function () {
var filepath = directory + filename
Lisp.call("models:remove-from-files-list", filepath)
})
}
}
MenuItem {
text: qsTr("Delete file")
onClicked: {
remorse.execute(fileItem, "", function () {
var filepath = directory + filename
Lisp.call("sextant:delete-file*", filepath)
})
}
}
}
}
ViewPlaceholder {
id: placeholder
enabled: listView.count == 0
text: qsTr("Pull down to open a file")
}
PullDownMenu {
MenuItem {
text: qsTr("Settings")
onClicked: pageStack.push(Qt.resolvedUrl("Settings.qml"))
}
MenuItem {
text: qsTr("Open file")
onClicked: pageStack.push(filePickerPage)
}
MenuItem {
text: qsTr("New file")
onClicked: {
var dialog = pageStack.push(Qt.resolvedUrl("SelectFileDialog.qml"),
{text: qsTr("Create new file"),
filename: ".org", pos0: true,
acceptDestination: Qt.resolvedUrl("Org.qml"),
acceptDestinationAction: PageStackAction.Replace})
dialog.accepted.connect(function() {
var filepath = dialog.directory + dialog.filename
Lisp.call("sextant:open-file", filepath)
dialog.acceptDestinationInstance.filepath = filepath
dialog.acceptDestinationInstance.filename = dialog.filename
})
}
}
}
PushUpMenu {
MenuItem {
text: qsTr("Scroll to top")
onClicked: scrollToTop()
}
}
Component {
id: filePickerPage
FilePickerPage {
popOnSelection: false
onSelectedContentPropertiesChanged: {
if (selectedContentProperties.filePath) {
Lisp.call("sextant:open-file", selectedContentProperties.filePath)
pageStack.replaceAbove(files, Qt.resolvedUrl("Org.qml"),
{filepath: selectedContentProperties.filePath,
filename: selectedContentProperties.fileName})
}
}
}
}
}
Component.onCompleted {
if (Lisp.call("cockpit:show-welcome-screen-p"))
console.log("show welcome screen")
}
onStatusChanged: {
if (status == PageStatus.Activating) {
Lisp.call("sextant:refresh-agenda-files")
}
}
}

0
qml/pages/FirstPage.qml → qml/pages-/FirstPage.qml
View file

0
qml/pages/Org.qml → qml/pages-/Org.qml
View file

0
qml/pages/SecondPage.qml → qml/pages-/SecondPage.qml
View file

0
qml/pages/SelectFileDialog.qml → qml/pages-/SelectFileDialog.qml
View file

0
qml/pages/Settings.qml → qml/pages-/Settings.qml
View file

1
qml/pages-/qmldir Normal file
View file

@ -0,0 +1 @@
Org 1.0 Org.qml

43
qml/pages/Editor.qml Normal file
View file

@ -0,0 +1,43 @@
import QtQuick 2.0
import Sailfish.Silica 1.0
import EQL5 1.0
Page {
id: editor
objectName: "editorPage"
allowedOrientations: Orientation.All
property string filepath
property string filename
property bool readonly: false
SilicaListView {
id: listView
anchors {
top: parent.top
left: parent.left
right: parent.right
bottom: toolbar.top
}
clip: true
header: PageHeader {
title: filename
}
}
DockedPanel {
id: toolbar
anchors {
left: parent.left
right: parent.right
bottom: parent.bottom
}
height: Theme.itemSizeMedium
dock: Dock.Bottom
open: true
}
}

67
qml/pages/Files.qml
View file

@ -1,10 +1,10 @@
import QtQuick 2.0
import Sailfish.Silica 1.0
import Sailfish.Pickers 1.0
import EQL5 1.0
Page {
id: files
objectName: "filesPage"
allowedOrientations: Orientation.All
SilicaListView {
@ -15,7 +15,7 @@ Page {
title: qsTr("Files")
}
model: agendaFilesModel
model: fileListModel
section {
property: 'section'
@ -49,13 +49,7 @@ Page {
}
}
onClicked: {
var filepath = directory + filename
Lisp.call("sextant:open-file", filepath)
pageStack.push(Qt.resolvedUrl("Org.qml"), {filepath: filepath, filename: filename})
}
RemorseItem { id: remorse }
onClicked: openEditor(directory, filename)
menu: ContextMenu {
MenuItem {
@ -63,8 +57,7 @@ Page {
text: qsTr("Remove from list")
onClicked: {
remorse.execute(fileItem, "", function () {
var filepath = directory + filename
Lisp.call("models:remove-from-files-list", filepath)
console.log("Remove file from list: " + filename)
})
}
}
@ -73,8 +66,7 @@ Page {
text: qsTr("Delete file")
onClicked: {
remorse.execute(fileItem, "", function () {
var filepath = directory + filename
Lisp.call("sextant:delete-file*", filepath)
console.log("Delete file: " + filename)
})
}
}
@ -90,58 +82,25 @@ Page {
PullDownMenu {
MenuItem {
text: qsTr("Settings")
onClicked: pageStack.push(Qt.resolvedUrl("Settings.qml"))
}
MenuItem {
text: qsTr("Open file")
onClicked: pageStack.push(filePickerPage)
}
MenuItem {
text: qsTr("New file")
onClicked: {
var dialog = pageStack.push(Qt.resolvedUrl("SelectFileDialog.qml"),
{text: qsTr("Create new file"),
filename: ".org", pos0: true,
acceptDestination: Qt.resolvedUrl("Org.qml"),
acceptDestinationAction: PageStackAction.Replace})
dialog.accepted.connect(function() {
var filepath = dialog.directory + dialog.filename
Lisp.call("sextant:open-file", filepath)
dialog.acceptDestinationInstance.filepath = filepath
dialog.acceptDestinationInstance.filename = dialog.filename
})
}
}
}
PushUpMenu {
MenuItem {
text: qsTr("Scroll to top")
onClicked: scrollToTop()
}
}
Component {
id: filePickerPage
FilePickerPage {
popOnSelection: false
onSelectedContentPropertiesChanged: {
if (selectedContentProperties.filePath) {
Lisp.call("sextant:open-file", selectedContentProperties.filePath)
pageStack.replaceAbove(files, Qt.resolvedUrl("Org.qml"),
{filepath: selectedContentProperties.filePath,
filename: selectedContentProperties.fileName})
}
}
}
}
}
onStatusChanged: {
if (status == PageStatus.Activating) {
Lisp.call("sextant:refresh-agenda-files")
}
Component.onCompleted: {
if (Lisp.call("cockpit:show-welcome-screen-p"))
openFile(Lisp.call("cockpit:data-path"), "welcome.org")
}
function openEditor(directory, filename) {
var filepath = directory + filename
pageStack.push(Qt.resolvedUrl("Editor.qml"), {filepath: filepath, filename: filename})
}
}

2
qml/pages/qmldir Normal file
View file

@ -0,0 +1,2 @@
Editor Editor.qml
Files Files.qml

10
qml/test.qml Normal file
View file

@ -0,0 +1,10 @@
import QtQuick 2.0
import Sailfish.Silica 1.0
import "pages/" as Pages
ApplicationWindow
{
initialPage: Component { Pages.Org { filename: "org.org" } }
cover: Qt.resolvedUrl("cover/CoverPage.qml")
allowedOrientations: defaultAllowedOrientations
}

7
sextant-app.pro
View file

@ -14,10 +14,14 @@ CONFIG += debug
SEXTANT_FILES = make.lisp \
dependencies.sexp \
lisp/system-index.txt \
lisp/local-projects/sextant/config/all.lisp \
lisp/local-projects/sextant/config/config.lisp \
lisp/local-projects/sextant/editor/all.lisp \
lisp/local-projects/sextant/editor/gap-buffer.lisp \
lisp/local-projects/sextant/sextant.lisp \
lisp/local-projects/sextant/sextant.asd \
lisp/local-projects/cockpit/options/all.lisp \
lisp/local-projects/cockpit/options/options.lisp \
lisp/local-projects/cockpit/cockpit.lisp \
lisp/local-projects/cockpit/cockpit.asd
@ -40,11 +44,14 @@ SOURCES += src/harbour-sextant.cc
DISTFILES += qml/harbour-sextant.qml \
qml/cover/CoverPage.qml \
qml/pages/Files.qml \
qml/pages/Editor.qml \
rpm/harbour-sextant.changes.in \
rpm/harbour-sextant.changes.run.in \
rpm/harbour-sextant.spec \
# rpm/harbour-sextant.yaml \
# translations/*.ts \
welcome.org
harbour-sextant.desktop
SAILFISHAPP_ICONS = 86x86 108x108 128x128 172x172

9
src/harbour-sextant.cc
View file

@ -37,7 +37,14 @@ int main(int argc, char *argv[])
sextant::parser::init_parser_lib();
eql.exec (init_sextant);
eql_fun ("qml:ini-sailfish", Q_ARG (QUrl, SailfishApp::pathToMainQml()),
QUrl pathToMainQml = SailfishApp::pathToMainQml();
QStringList args(QCoreApplication::arguments());
int index = args.indexOf("-qml");
if (index != -1)
pathToMainQml = args.at(index + 1);
eql_fun ("qml:ini-sailfish", Q_ARG (QUrl, pathToMainQml),
Q_ARG (QUrl, SailfishApp::pathTo ("")),
Q_ARG (QQuickView*, view.data ()), Q_ARG(bool, true));
}

3
welcome.org Normal file
View file

@ -0,0 +1,3 @@
* Sextant
** Introduction
** Changelog