Skip to content

Commit

Permalink
Merge branch 'main' of github.com:lem-project/lem
Browse files Browse the repository at this point in the history
  • Loading branch information
cxxxr committed Sep 3, 2024
2 parents 0dd94df + cb2e1fe commit f509ebd
Show file tree
Hide file tree
Showing 8 changed files with 383 additions and 2 deletions.
153 changes: 153 additions & 0 deletions extensions/lem-dashboard/dashboard-items.lisp
Original file line number Diff line number Diff line change
@@ -0,0 +1,153 @@
(in-package :lem-dashboard)

;; Splash
(defclass dashboard-splash (dashboard-item)
((splash-texts :initarg :splash-texts :accessor splash-texts
:initform '("Welcome!"))
(selected-splash :initarg :selected-splash :accessor selected-splash
:initform nil))
(:documentation "Randomly displays one of SPLASH-TEXTS")
(:default-initargs
:item-attribute 'document-text-attribute))

(defmethod draw-dashboard-item ((item dashboard-splash) point)
(unless (selected-splash item)
(setf (selected-splash item)
(nth (random (length (splash-texts item))) (splash-texts item))))
(dolist (line (str:lines (selected-splash item)))
(insert-string point (create-centered-string line) :attribute (item-attribute item))
(insert-character point #\Newline)))

;; Url
(defclass dashboard-url (dashboard-item)
((url :initarg :url :accessor url)
(display-text :initarg :display-text :accessor display-text))
(:documentation "Creates link/button with DISPLAY-TEXT that opens URL externally.")
(:default-initargs
:item-attribute 'document-text-attribute))

(defmethod initialize-instance :after ((item dashboard-url) &key)
(with-slots (url action) item
(setf action (lambda () (open-external-file url)))))

(defmethod draw-dashboard-item ((item dashboard-url) point)
(button:insert-button point
(create-centered-string (display-text item))
(lambda () (open-external-file (url item)))
:attribute (item-attribute item)))

;; Working dir
(defclass dashboard-working-dir (dashboard-item)
()
(:documentation "Prints current working directory")
(:default-initargs
:item-attribute 'document-header4-attribute))

(defmethod draw-dashboard-item ((item dashboard-working-dir) point)
(let ((working-dir (format nil "> ~A" (buffer-directory))))
(insert-string point (create-centered-string working-dir) :attribute 'document-header4-attribute)
(insert-character point #\Newline)))

;; Footer
(defclass dashboard-footer-message (dashboard-item)
((messages :initarg :messages :accessor messages :initform '("Happy Coding!"))
(selected-message :initarg :selected-message :accessor selected-message
:initform nil))
(:documentation "Randomly displays one of the passed-in MESSAGES")
(:default-initargs
:item-attribute 'document-text-attribute))

(defmethod draw-dashboard-item ((item dashboard-footer-message) point)
(unless (selected-message item)
(setf (selected-message item)
(nth (random (length (messages item))) (messages item))))
(insert-string point
(create-centered-string (format nil "> ~A" (selected-message item)))
:attribute (item-attribute item)))

;; Command
(defclass dashboard-command (dashboard-item)
((display-text :initarg :display-text :accessor display-text)
(action-command :initarg :action-command :accessor action-command))
(:documentation "Creates a link/button with DISPLAY-TEXT that executes ACTION-COMMAND when clicked.")
(:default-initargs
:item-attribute 'document-text-attribute))

(defmethod initialize-instance :after ((item dashboard-command) &key)
(with-slots (action-command action) item
(setf action (lambda () (funcall action-command)))))

(defmethod draw-dashboard-item ((item dashboard-command) point)
(button:insert-button point
(create-centered-string (display-text item))
(lambda () (funcall (action-command item)))
:attribute (item-attribute item)))

;; Recent projects
(defclass dashboard-recent-projects (dashboard-item)
((project-count :initarg :project-count :accessor project-count :initform 5))
(:documentation "Displays a list of recent projects, limited to the last PROJECT-COUNT.")
(:default-initargs
:item-attribute 'document-text-attribute
:action (lambda ()
(let ((project (str:trim (line-string (current-point)))))
(when project
(uiop:with-current-directory (project)
(project:project-find-file project)))))))

(define-command dashboard-move-to-recent-projects () ()
(let ((point (buffer-point (current-buffer))))
(buffer-start point)
(search-forward-regexp point "Recent Projects")
(line-offset point 2)
(move-to-beginning-of-line)))

(defmethod draw-dashboard-item ((item dashboard-recent-projects) point)
(let* ((title (format nil "~A Recent Projects (r)" (icon-string "package")))
(title-line (create-centered-string title)))
(insert-string point title-line :attribute 'document-header1-attribute)
(insert-character point #\Newline)
(insert-character point #\Newline)
(let* ((projects (reverse (project:saved-projects)))
(display-projects (subseq projects 0 (min (project-count item) (length projects)))))
(when display-projects
(let* ((longest-project (reduce #'(lambda (a b) (if (> (length a) (length b)) a b)) display-projects))
(max-length (length longest-project))
(left-padding (floor (- (window-width (current-window)) max-length) 2)))
(loop for project in display-projects
do (insert-string point (format nil "~v@{~A~:*~}" left-padding " "))
(insert-string point (format nil "~A~%" project))))))))

;; Recent files
(defclass dashboard-recent-files (dashboard-item)
((file-count :initarg :file-count :accessor file-count :initform 5))
(:documentation "Displays a list of recent files, limited to the last FILE-COUNT.")
(:default-initargs
:item-attribute 'document-text-attribute
:action (lambda ()
(let ((file (str:trim (line-string (current-point)))))
(when file
(find-file file))))))

(define-command dashboard-move-to-recent-files () ()
(let ((point (buffer-point (current-buffer))))
(buffer-start point)
(search-forward-regexp point "Recent Files")
(line-offset point 2)
(move-to-beginning-of-line)))

(defmethod draw-dashboard-item ((item dashboard-recent-files) point)
(let* ((title (format nil "~A Recent Files (f)" (icon-string "file-text")))
(title-line (create-centered-string title))
(recent-files (reverse (history:history-data-list (file:file-history)))))
(insert-string point title-line :attribute 'document-header1-attribute)
(insert-character point #\Newline)
(insert-character point #\Newline)
(let ((display-files (subseq recent-files 0 (min (file-count item) (length recent-files)))))
(when display-files
(let* ((longest-file (reduce #'(lambda (a b) (if (> (length a) (length b)) a b)) display-files))
(max-length (length longest-file))
(left-padding (floor (- (window-width (current-window)) max-length) 2)))
(loop for file in display-files
do (insert-string point (str:fit left-padding " "))
(insert-string point (format nil "~A~%" file))))))))
86 changes: 86 additions & 0 deletions extensions/lem-dashboard/default-dashboard.lisp
Original file line number Diff line number Diff line change
@@ -0,0 +1,86 @@
(in-package :lem-dashboard)

(defvar *default-footer-messages* '("Happy Coding!"
"ほげほげ"
"In Lisp we trust, for bugs we adjust"
"Read, Evaluate, Print, Love"
"May your parentheses always be balanced"
"(setf productivity 'high)"
"<M-x> load-library <RET> tetris"
"Lem Editor Modules? Lisp EMacs? Lem's Not Emacs?"
"(cons 'fun 'programming)"))

(defvar *default-splash* '("
-----------------------
[ Welcome to Lem! ]
-----------------------
#+====-===
##+-----------=
########**==------=
########## %-------=
%#########+==-:---=====
########:::::::::::+ =
######*=++-::::::::::
#########=::::
%#######*:::::
#######+:::::::
%######=:::::::::
#######*-::::
%##*-:::::
"))

(define-command open-lem-docs () ()
(open-external-file "https://lem-project.github.io/usage/usage/"))

(define-command open-lem-github () ()
(open-external-file "https://github.com/lem-project/lem"))

(defun set-default-dashboard (&key
(project-count 5)
(file-count 5)
(splash *default-splash*)
(footer-messages *default-footer-messages*)
hide-links)
(let ((dashboard-items
(list (make-instance 'dashboard-splash
:item-attribute 'document-metadata-attribute
:splash-texts splash)
(make-instance 'dashboard-working-dir)
(make-instance 'dashboard-recent-projects
:project-count project-count
:bottom-margin 1)
(make-instance 'dashboard-recent-files
:file-count file-count
:bottom-margin 1)
(make-instance 'dashboard-command
:display-text " New Lisp Scratch Buffer (l)"
:action-command 'lem-lisp-mode:lisp-scratch
:item-attribute 'document-header2-attribute
:bottom-margin 2))))
(unless hide-links
(setf dashboard-items
(append dashboard-items
(list (make-instance 'dashboard-url
:display-text " Getting Started (s)"
:url "https://lem-project.github.io/usage/usage/"
:item-attribute 'document-header3-attribute)
(make-instance 'dashboard-url
:display-text " GitHub (g)"
:url "https://github.com/lem-project/lem"
:item-attribute 'document-header3-attribute
:bottom-margin 2)))))
(setf dashboard-items
(append dashboard-items
(list (make-instance 'dashboard-footer-message
:item-attribute 'document-blockquote-attribute
:messages footer-messages))))
(set-dashboard dashboard-items)))

(define-key *dashboard-mode-keymap* "s" 'open-lem-docs)
(define-key *dashboard-mode-keymap* "g" 'open-lem-github)
(define-key *dashboard-mode-keymap* "r" 'dashboard-move-to-recent-projects)
(define-key *dashboard-mode-keymap* "f" 'dashboard-move-to-recent-files)
(define-key *dashboard-mode-keymap* "l" 'lem-lisp-mode/internal:lisp-scratch)

(set-default-dashboard)
6 changes: 6 additions & 0 deletions extensions/lem-dashboard/lem-dashboard.asd
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
(defsystem "lem-dashboard"
:depends-on (:lem)
:serial t
:components ((:file "lem-dashboard")
(:file "dashboard-items")
(:file "default-dashboard")))
131 changes: 131 additions & 0 deletions extensions/lem-dashboard/lem-dashboard.lisp
Original file line number Diff line number Diff line change
@@ -0,0 +1,131 @@
(defpackage :lem-dashboard
(:use :cl :lem)
(:export :open-dashboard
:*dashboard-mode-keymap*
:*dashboard-enable*
:dashboard-move-to-recent-projects
:dashboard-move-to-recent-files
:set-dashboard
:set-default-dashboard
:create-centered-string)
(:local-nicknames (:button :lem/button)
(:history :lem/common/history)
(:project :lem-core/commands/project)
(:file :lem-core/commands/file)))

(in-package :lem-dashboard)

(defvar *dashboard-buffer-name* "*dashboard*")
(defvar *dashboard-enable* t)
(defvar *dashboard-mode-keymap* (make-keymap :name '*dashboard-mode-keymap* :parent *global-keymap*))
(defvar *dashboard-layout* nil
"List of dashboard-item instances; will be drawn in order.")

(defun create-centered-string (str)
"Creates a 'centered' string by padding with space to fill the screen width halfway."
(let* ((padding (max 0 (floor (- (window-width (current-window)) (length str)) 2)))
(spaces (make-string padding :initial-element #\Space)))
(concatenate 'string spaces str)))

(defclass dashboard-item ()
((item-attribute
:initarg :item-attribute
:accessor item-attribute
:initform 'document-text-attribute
:documentation "Attribute to use when drawing this item.")
(top-margin
:initarg :top-margin
:accessor top-margin
:initform 0
:documentation "The amount of vertical space (lines) to apply before the item.")
(bottom-margin
:initarg :bottom-margin
:accessor bottom-margin
:initform 1
:documentation "The amount of vertical space (lines) to apply after the item.")
(action
:initarg :action
:accessor action
:initform nil
:documentation "Function to execute when <return> is pressed over this item."))
(:documentation "Base class for all dashboard items."))

(defgeneric draw-dashboard-item (item point)
(:documentation "Called to draw the dashboard item.")
(:method :before ((item dashboard-item) point)
(dotimes (i (top-margin item))
(insert-character point #\Newline)))
(:method :after ((item dashboard-item) point)
(dotimes (i (bottom-margin item))
(insert-character point #\Newline))))

(define-command dashboard-open-selected-item () ()
"Execute action on selected dashboard item."
(let* ((point (current-point))
(item (text-property-at point :dashboard-item)))
(when (and item (action item))
(funcall (action item)))))

(defmethod draw-dashboard-item :around ((item dashboard-item) point)
"Inserts a :dashboard-item text property in between the starting and ending POINT, useful for tracking."
(let ((start (copy-point point :temporary)))
(call-next-method)
(let ((end (copy-point point :temporary)))
(put-text-property start end :dashboard-item item)
(delete-point start)
(delete-point end))))

(define-major-mode dashboard-mode ()
(:name "Dashboard"
:keymap *dashboard-mode-keymap*))

(defun create-dashboard-buffer ()
"Creates the dashboard buffer."
(or (get-buffer *dashboard-buffer-name*)
(make-buffer *dashboard-buffer-name*
:enable-undo-p nil
:read-only-p t)))

(defun redraw-dashboard ()
"Redraws the dashboard, clearing and redrawing all content while attempting to maintain point position."
(let* ((buffer (create-dashboard-buffer))
(old-line (line-number-at-point (buffer-point buffer)))
(old-column (point-column (buffer-point buffer))))
(with-buffer-read-only buffer nil
(erase-buffer buffer)
(let ((point (buffer-point buffer)))
(dolist (item *dashboard-layout*)
(draw-dashboard-item item point)))
(change-buffer-mode buffer 'dashboard-mode)
(move-to-line (buffer-point buffer) old-line)
(move-to-column (buffer-point buffer) old-column))))

(define-command open-dashboard () ()
"Opens the dashboard if it doesn't exist, or switches to it if it does."
(when *dashboard-enable*
(if (get-buffer *dashboard-buffer-name*)
(switch-to-buffer (get-buffer *dashboard-buffer-name*))
(progn
(redraw-dashboard)
(switch-to-buffer (get-buffer *dashboard-buffer-name*))))))

(defun set-dashboard (dashboard-items)
"Sets the new dashboard layout to DASHBOARD-ITEMS list and applies new keymap."
(when dashboard-items
(setf *dashboard-layout* dashboard-items)
(when (get-buffer *dashboard-buffer-name*)
(redraw-dashboard))))

(defun handle-resize (window)
"Handle resizing; in this case, redraw the dashboard to keep it centered."
(when (string= (buffer-name (window-buffer window)) *dashboard-buffer-name*)
(redraw-dashboard)))

(define-key *dashboard-mode-keymap* "n" 'next-line)
(define-key *dashboard-mode-keymap* "p" 'previous-line)
(define-key *dashboard-mode-keymap* "j" 'next-line)
(define-key *dashboard-mode-keymap* "k" 'previous-line)
(define-key *dashboard-mode-keymap* "Return" 'dashboard-open-selected-item)

(setf lem:*splash-function* #'open-dashboard)
(add-hook *window-size-change-functions* 'handle-resize)
1 change: 1 addition & 0 deletions extensions/lisp-mode/internal-package.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,7 @@
:with-remote-eval
:lisp-eval-from-string
:lisp-eval
:lisp-scratch
:lisp-eval-async
:eval-with-transcript
:re-eval-defvar
Expand Down
3 changes: 2 additions & 1 deletion lem.asd
Original file line number Diff line number Diff line change
Expand Up @@ -260,7 +260,8 @@
"lem-color-preview"
"lem-lua-mode"
"lem-terminal"
"lem-legit"))
"lem-legit"
"lem-dashboard"))

(defsystem "lem/executable"
:build-operation program-op
Expand Down
Loading

0 comments on commit f509ebd

Please sign in to comment.