diff options
Diffstat (limited to 'lisp/seam.el')
| -rw-r--r-- | lisp/seam.el | 211 |
1 files changed, 144 insertions, 67 deletions
diff --git a/lisp/seam.el b/lisp/seam.el index 589e947..eb3037e 100644 --- a/lisp/seam.el +++ b/lisp/seam.el @@ -33,6 +33,7 @@ ;;; Code: (require 'seam-export) +(require 'org) (require 'cl-lib) (require 'grep) @@ -52,13 +53,33 @@ :type 'string) (defcustom seam-note-types '("private" "public") - "Seam note types." + "List of valid Seam note types. Each element can either be a +string (the name of the type), or an alist. If using an alist, +the car should be the type name, and the cdr should be a plist +containing any number of these properties: + + `:create-as-draft' + + When this is non-nil, new Seam notes of this type will be + created as drafts. If this is missing, falls back to + `seam-create-as-draft'." + :group 'seam + :type '(repeat + (choice string + (alist :key-type string :value-type plist)))) + +(defcustom seam-create-as-draft nil + "When non-nil, new Seam notes will be created as drafts." :group 'seam - :type '(repeat string)) + :type 'boolean) -(defun seam-format-title-default (title type) - "Default Seam title formatter. Formats like this: \"TITLE (TYPE)\"." - (format "%s %s" title (propertize (format "(%s)" type) 'face 'font-lock-comment-face))) +(defun seam-format-title-default (title type draft-p) + "Default Seam title formatter. Formats like this: \"TITLE (TYPE[ draft])\"." + (format "%s %s" + title + (propertize + (format "(%s%s)" type (if draft-p " draft" "")) + 'face 'font-lock-comment-face))) (defcustom seam-title-formatter #'seam-format-title-default @@ -71,13 +92,20 @@ naming. Must be a function taking two arguments: TITLE and TYPE." (mapcar #'car seam-export-alist)) (defun seam-slugify (title) - (downcase (string-join (string-split title "\\W+" t) "-"))) + (setq title (string-replace "'" "" title)) + (setq title (string-split title "\\W+" t)) + (setq title (string-join title "-")) + (downcase title)) (defun seam-lookup-slug (slug) - (cl-dolist (type seam-note-types) - (let ((file (file-name-concat seam-note-directory type (concat slug ".org")))) - (when (file-exists-p file) - (cl-return (expand-file-name file)))))) + (cl-dolist (type (seam-get-all-note-type-names)) + (let ((file (file-name-concat seam-note-directory type (concat slug ".org"))) + (draft-file (file-name-concat seam-note-directory type (concat "-" slug ".org")))) + (cond + ((file-exists-p file) + (cl-return (expand-file-name file))) + ((file-exists-p draft-file) + (cl-return (expand-file-name draft-file))))))) (defun seam--check-conflict (slug) (when (seam-lookup-slug slug) @@ -87,7 +115,7 @@ naming. Must be a function taking two arguments: TITLE and TYPE." (org-mark-ring-push) (if-let ((file (seam-lookup-slug path))) (find-file file) - (seam-make-note path nil t)) + (seam-create-note path nil t (seam-draft-p path))) (seam-set-buffer-name)) (defvar seam-note-file-regexp "\\`[^.].+\\.org\\'") @@ -105,7 +133,7 @@ naming. Must be a function taking two arguments: TITLE and TYPE." (defun seam-ensure-note-subdirectories-exist () (unless seam-note-directory (error "Please set `seam-note-directory'")) - (cl-dolist (type seam-note-types) + (cl-dolist (type (seam-get-all-note-type-names)) (let ((dir (file-name-concat seam-note-directory type))) (seam-ensure-directory-exists dir)))) @@ -115,6 +143,9 @@ naming. Must be a function taking two arguments: TITLE and TYPE." :type '(choice (const :tag "Sort by title" title) (const :tag "Sort by modification date" modified))) +(defun seam-get-all-note-type-names () + (mapcar (lambda (x) (car (ensure-list x))) seam-note-types)) + (cl-defgeneric seam-get-all-notes (sort-by)) (cl-defmethod seam-get-all-notes ((sort-by (eql 't))) @@ -156,8 +187,7 @@ naming. Must be a function taking two arguments: TITLE and TYPE." (save-restriction (widen) (goto-char 1) - (ignore-errors - (re-search-forward (org-headline-re 1)) + (when (re-search-forward "^\\* " nil t) (let ((start (point))) (end-of-line) (let ((title (string-trim (buffer-substring-no-properties start (point))))) @@ -169,33 +199,43 @@ naming. Must be a function taking two arguments: TITLE and TYPE." (insert-file-contents file) (seam-get-title-from-buffer))) +(defun seam-get-slug-from-file-name (file) + (string-remove-prefix "-" (file-name-base file))) + (cl-defun seam-get-slug-from-buffer (&optional (buffer (current-buffer))) (or (with-current-buffer buffer (save-mark-and-excursion (save-restriction (widen) (goto-char 1) - (ignore-errors - (re-search-forward (org-headline-re 1)) + (when (re-search-forward "^\\* " nil t) (org-element-property :SEAM_SLUG (org-element-at-point)))))) (seam-slugify (seam-get-title-from-buffer buffer)))) -(defun seam-format-title (title type) - (funcall seam-title-formatter title type)) +(defun seam-format-title (title type draft-p) + (funcall seam-title-formatter title type draft-p)) (defun seam-validate-note-type (type) - (unless (member type seam-note-types) + (unless (member type (seam-get-all-note-type-names)) (error "`%s' is not a valid Seam note type" type))) -(defun seam-make-note (title &optional type select) +(cl-defun seam-create-note (title &optional type select (draft-p nil draft-supplied-p)) (unless type (setq type seam-default-note-type)) (seam-validate-note-type type) (seam-ensure-note-subdirectories-exist) (let* ((slug (seam-slugify title)) + (draft-p + (if draft-supplied-p + draft-p + (cl-getf (cdr (assoc type (mapcar #'ensure-list seam-note-types))) + :create-as-draft + seam-create-as-draft))) (file (file-name-concat seam-note-directory type - (concat slug ".org")))) + (concat (when draft-p "-") slug ".org")))) + (when (string= "" slug) + (error "Cannot create a note with an empty slug")) (seam--check-conflict slug) (let ((buffer (funcall (if select #'find-file #'find-file-noselect) file))) (with-current-buffer buffer @@ -213,18 +253,27 @@ naming. Must be a function taking two arguments: TITLE and TYPE." :test #'equal) (and self (list self))))) (let ((files (cl-loop for (title . file) in notes - collect (cons (seam-format-title title (seam-get-note-type file)) file)))) - (let ((completion (string-trim (funcall seam-completing-read-function prompt files)))) + collect (cons (seam-format-title + title + (seam-get-note-type file) + (seam-draft-p file)) + file)))) + (let ((completion (string-trim (funcall seam-completing-read-function prompt (mapcar #'car files))))) (or (assoc completion files) (cons completion nil))))))) (defun seam--read-type (prompt arg &optional choices) (when arg (if (listp arg) - (let ((type (funcall seam-completing-read-function prompt (or choices seam-note-types) nil t))) + (let ((type (funcall seam-completing-read-function + prompt + (or choices (seam-get-all-note-type-names)) + nil + t))) (seam-validate-note-type type) type) - (nth (1- arg) seam-note-types)))) + (nth (1- arg) + (seam-get-all-note-type-names))))) ;;;###autoload (defun seam-find-note (arg) @@ -238,7 +287,7 @@ completion prompt is given to choose the type." (interactive "P") (let* ((type (seam--read-type "Type: " arg)) (seam--subset - (if type (list type) seam-note-types))) + (if type (list type) (seam-get-all-note-type-names)))) (cl-destructuring-bind (completion . file) (seam-read-title "Open note: ") (if file @@ -247,26 +296,31 @@ completion prompt is given to choose the type." ;; formatter function) (NOTE: Redundant if buffer wasn't ;; already open, as `seam-setup-buffer' does this too.) (seam-set-buffer-name)) - (seam-make-note (string-trim completion) (or type seam-default-note-type) t))))) + (seam-create-note (string-trim completion) (or type seam-default-note-type) t))))) (cl-defun seam-get-note-type (file &optional no-error) (when (and file (equal "org" (file-name-extension file))) (let ((type (cadr (nreverse (file-name-split file))))) - (when (member type seam-note-types) + (when (member type (seam-get-all-note-type-names)) (cl-return-from seam-get-note-type type)))) (unless no-error (error "%s is not a Seam note" file))) -(defun seam-make-file-name (slug type) +(defun seam-make-file-name (slug type &optional draft) (expand-file-name (file-name-concat seam-note-directory type - (concat slug ".org")))) + (concat (when draft "-") slug ".org")))) -(defun seam-get-links-to-file (file) +(defun seam-get-links-to-file (file &optional include-drafts) "Return filename of each note which links to FILE." - (remove (expand-file-name file) - (seam-note-files-containing-string (format "[[seam:%s]" (file-name-base file))))) + (cl-loop for file in (remove (expand-file-name file) + (seam-note-files-containing-string + (format "[[seam:%s]" (file-name-base file)))) + when (or include-drafts + seam-export--include-drafts + (not (seam-draft-p file))) + collect file)) (cl-defun seam-get-links-from-buffer (&optional (buffer (current-buffer))) "Return filename of each existing note which is linked to from BUFFER." @@ -291,18 +345,24 @@ completion prompt is given to choose the type." (seam-get-links-from-buffer))) (defun seam-delete-html-files-for-note (note-file) - (dolist (dir (seam-html-directories)) - (let ((html (file-name-concat dir (concat (file-name-base note-file) ".html")))) - (when (file-exists-p html) - (delete-file html) - (message "Deleted %s" html))))) + (let ((html-nd (concat (seam-get-slug-from-file-name note-file) ".html"))) + (dolist (dir (seam-html-directories)) + (let ((html (file-name-concat dir html-nd))) + (when (file-exists-p html) + (delete-file html) + (message "Deleted %s" html)))))) + +(defun seam--rename-file (old new interactive) + (rename-file old new) + (when interactive + (set-visited-file-name new nil t) + (seam-set-buffer-name)) + (seam-post-save-or-rename old new)) (defun seam-post-save-or-rename (old new &optional previous-links-from-file slug-or-title-changed) (unless (string= old new) - (seam-update-links old new) - (seam-delete-html-files-for-note old) - (dolist (dir (seam-html-directories)) - (delete-file (file-name-concat dir (concat (file-name-base old) ".html"))))) + (seam-update-links old new)) + (seam-delete-html-files-for-note old) (seam-export-note new) (let* ((current-links (seam-get-links-from-file new)) (added-links (cl-set-difference current-links @@ -332,14 +392,18 @@ completion prompt is given to choose the type." (when type-changed (seam-get-links-to-file new)))))))) +(defun seam-draft-p (file) + (string-prefix-p "-" (file-name-base file))) + (defun seam-save-buffer () (let* ((old (buffer-file-name)) - (type (seam-get-note-type old t))) + (type (seam-get-note-type old t)) + (draft-p (seam-draft-p old))) (when type (unless (seam-get-title-from-buffer) (error "Note must have a title")) (let* ((slug (seam-get-slug-from-buffer)) - (new (seam-make-file-name slug type)) + (new (seam-make-file-name slug type draft-p)) (newly-created-p (not (file-exists-p old))) (slug-changed-p (not (string= slug (file-name-base old)))) (title-changed-p (unless newly-created-p @@ -347,7 +411,7 @@ completion prompt is given to choose the type." (seam-get-title-from-file old)))))) (unless (string= old new) ;This is valid because ;`seam-save-buffer' cannot - ;change type. + ;change type or draft status. (seam--check-conflict slug) (rename-file old new) (set-visited-file-name new nil t)) @@ -365,13 +429,12 @@ completion prompt is given to choose the type." (seam-set-buffer-name) t))))) -(defun seam--set-note-type (file new-type) +(defun seam--set-note-type (file new-type interactive) (let ((old-type (seam-get-note-type file)) (new-file (seam-make-file-name (file-name-base file) new-type))) (if (string= new-type old-type) file - (rename-file file new-file) - (seam-post-save-or-rename file new-file) + (seam--rename-file file new-file interactive) new-file))) ;;;###autoload @@ -388,28 +451,38 @@ from 1). Otherwise a completion prompt is given for the desired type." (or (seam--read-type "New type: " ;; HACK: Treat nil prefix as C-u. (or current-prefix-arg '(4)) - (remove old-type seam-note-types)) + (remove old-type (seam-get-all-note-type-names))) old-type) t))) - (let ((new-file (seam--set-note-type file new-type))) - (when interactive - (set-visited-file-name new-file nil t) - (seam-set-buffer-name)))) + (seam--set-note-type file new-type interactive)) + +;;;###autoload +(defun seam-toggle-draft (file &optional interactive) + "Toggle the draft status of Seam note FILE." + (interactive (list (buffer-file-name) t)) + (seam-get-note-type file) ;Error if file isn't a Seam note. + (let* ((base (file-name-nondirectory file)) + (new-file (file-name-concat + (file-name-directory file) + (if (string-prefix-p "-" base) + (string-remove-prefix "-" base) + (concat "-" base))))) + (seam--rename-file file new-file interactive))) (defun seam-update-links (old new) - (let ((old-slug (file-name-base old)) - (new-slug (file-name-base new))) - (unless (string= old-slug new-slug) + (let* ((old-link (file-name-base old)) + (new-link (file-name-base new))) + (unless (string= old-link new-link) (let ((count (seam-replace-string-in-all-notes - (format "[[seam:%s]" old-slug) - (format "[[seam:%s]" new-slug) + (format "[[seam:%s]" old-link) + (format "[[seam:%s]" new-link) t))) (unless (zerop count) (message "Updated links in %d file%s" count (if (= count 1) "" "s"))))))) (defun seam--active-subset () - (or seam--subset seam-note-types)) + (or seam--subset (seam-get-all-note-type-names))) (defun seam-note-subdirectories () (cl-loop for type in (seam--active-subset) @@ -449,7 +522,7 @@ Otherwise, it's nil." find-program (string-join (mapcar (lambda (type) (shell-quote-argument (concat type "/"))) - seam-note-types) + (seam-get-all-note-type-names)) " ") (shell-quote-argument "*.org") (shell-quote-argument ".*") @@ -503,10 +576,13 @@ Otherwise, it's nil." update-count))) (cl-defun seam-set-buffer-name (&optional (buffer (current-buffer))) - (with-current-buffer buffer - (rename-buffer - (seam-format-title (seam-get-title-from-buffer) - (seam-get-note-type (buffer-file-name buffer)))))) + (when-let ((title (seam-get-title-from-buffer))) + (let ((file (buffer-file-name buffer))) + (with-current-buffer buffer + (rename-buffer + (seam-format-title title + (seam-get-note-type file) + (seam-draft-p file))))))) (defun seam-setup-buffer () "Setup hooks when loading a Seam file." @@ -544,7 +620,7 @@ buffer is killed after deletion." (let ((file (buffer-file-name))) (seam-get-note-type file) ;Error if file isn't a Seam note. (list - (let ((incoming (length (seam-get-links-to-file file)))) + (let ((incoming (length (seam-get-links-to-file file t)))) (and (yes-or-no-p (format "Really %s `%s' and kill buffer%s?" (if delete-by-moving-to-trash @@ -572,7 +648,7 @@ link will replace it." (cl-destructuring-bind (completion . file) (seam-read-title "Insert note link: ") (let* ((new-buffer (unless file - (seam-make-note completion seam-default-note-type nil))) + (seam-create-note completion seam-default-note-type nil))) (selection (when (use-region-p) (buffer-substring (region-beginning) @@ -595,7 +671,8 @@ link will replace it." "k" #'seam-delete-note "l" #'seam-insert-link "s" #'seam-search - "t" #'seam-set-note-type) + "t" #'seam-set-note-type + "d" #'seam-toggle-draft) (org-link-set-parameters "seam" :follow #'seam-link-open) |