Skip to content

Commit

Permalink
Merge pull request #18 from sachac/user-files
Browse files Browse the repository at this point in the history 
Allow user files via elisp-demos-user-files, always show Demos section and include an "[Add]" button
  • Loading branch information
@xuchunyang
xuchunyang committed Jan 16, 2024
2 parents bf22edd + b6bea11 commit ecc8412
Showing 1 changed file with 96 additions and 76 deletions.
172 changes: 96 additions & 76 deletions elisp-demos.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,26 +31,35 @@
(require 'subr-x)

(defconst elisp-demos--load-dir (file-name-directory
(or load-file-name buffer-file-name)))
(or load-file-name buffer-file-name)))

(defconst elisp-demos--elisp-demos.org (expand-file-name
"elisp-demos.org"
elisp-demos--load-dir))
"elisp-demos.org"
elisp-demos--load-dir))

(defcustom elisp-demos-user-files nil
"Files to search in addition to the one from the elisp-demos package.
If set, new notes are added to the first file in this list."
:group 'help
:type '(repeat file))

(defun elisp-demos--search (symbol)
(with-temp-buffer
(insert-file-contents elisp-demos--elisp-demos.org)
(goto-char (point-min))
(when (re-search-forward
(format "^\\* %s$" (regexp-quote (symbol-name symbol)))
nil t)
(let (beg end)
(forward-line 1)
(setq beg (point))
(if (re-search-forward "^\\*" nil t)
(setq end (line-beginning-position))
(setq end (point-max)))
(string-trim (buffer-substring-no-properties beg end))))))
(let (results)
(dolist (file (append elisp-demos-user-files (list elisp-demos--elisp-demos.org)))
(when (file-exists-p file)
(with-temp-buffer
(insert-file-contents file)
(delay-mode-hooks (org-mode))
(when-let ((pos (org-find-exact-headline-in-buffer (symbol-name symbol))))
(goto-char pos)
(org-end-of-meta-data)
(push (string-trim
(buffer-substring-no-properties
(point)
(org-end-of-subtree)))
results)))))
(when results
(string-join (nreverse results) "\n\n"))))

(defun elisp-demos--syntax-highlight (orgsrc)
(with-temp-buffer
Expand All @@ -63,13 +72,15 @@
(buffer-string)))

(defun elisp-demos--symbols ()
(with-temp-buffer
(insert-file-contents elisp-demos--elisp-demos.org)
(goto-char (point-min))
(let (symbols)
(while (re-search-forward "^\\* \\(.+\\)$" nil t)
(push (intern (match-string-no-properties 1)) symbols))
(nreverse symbols))))
(let (symbols)
(dolist (file (append elisp-demos-user-files (list elisp-demos--elisp-demos.org)))
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(delay-mode-hooks (org-mode))
(while (re-search-forward "^\\* +\\(.+\\)$" nil t)
(push (org-entry-get (point) "ITEM") symbols))))
(mapcar 'intern (sort (seq-uniq symbols) #'string<))))

(declare-function org-show-entry "org" ())
(declare-function org-insert-heading "org" (&optional arg invisible-ok top))
Expand All @@ -89,20 +100,22 @@
(mapcar #'symbol-name symbols)
nil t nil nil default-val)))))
(cl-assert symbol)
(find-file elisp-demos--elisp-demos.org)
(goto-char (point-min))
(and (re-search-forward
(format "^\\* %s$" (regexp-quote (symbol-name symbol))))
(goto-char (line-beginning-position))
(org-show-entry))
(catch 'found
(dolist (file (append elisp-demos-user-files (list elisp-demos--elisp-demos.org)))
(with-current-buffer (find-file-noselect file)
(let ((pos (org-find-exact-headline-in-buffer (symbol-name symbol))))
(when pos
(goto-char pos)
(org-show-entry)
(throw 'found (point)))))))
t)

;; Borrowed from `helpful--read-symbol'
(defun elisp-demos--read-symbol (prompt predicate)
(let* ((sym-here (symbol-at-point))
(default-val
(when (funcall predicate sym-here)
(symbol-name sym-here))))
(when (funcall predicate sym-here)
(symbol-name sym-here))))
(when default-val
(setq prompt
(replace-regexp-in-string
Expand All @@ -122,29 +135,30 @@
(special-form-p sym)
(macrop sym))))))
;; Try to reuse existing window
(let* ((buffer (get-file-buffer elisp-demos--elisp-demos\.org))
(let* ((file (or (car elisp-demos-user-files) elisp-demos--elisp-demos\.org))
(buffer (get-file-buffer file))
(window (and buffer (get-buffer-window buffer))))
(if window
(select-window window)
(find-file elisp-demos--elisp-demos\.org)))
(find-file file)))
(goto-char (point-min))
(or
(catch 'found
(while (re-search-forward "^\\* \\(.+\\)$" nil t)
(cond ((string= (match-string-no-properties 1) (symbol-name symbol))
(cond ((string= (org-entry-get (point) "ITEM") (symbol-name symbol))
(goto-char (line-beginning-position))
(user-error "%s already exists" symbol))
((string< (symbol-name symbol) (match-string-no-properties 1))
((string< (symbol-name symbol) (org-entry-get (point) "ITEM"))
(goto-char (line-beginning-position))
(throw 'found t)))))
(goto-char (point-max)))
(org-insert-heading)
(insert (symbol-name symbol) "\n"
"\n"
"#+BEGIN_SRC elisp\n"
"\n"
(format " (%s )\n" (symbol-name symbol))
"#+END_SRC")
(search-backward "\n#+END_SRC"))
(search-backward ")\n#+END_SRC"))

;;; * C-h f (`describe-function')

Expand Down Expand Up @@ -194,19 +208,23 @@
(defun elisp-demos-advice-helpful-update ()
(let ((src (and (symbolp helpful--sym)
(elisp-demos--search helpful--sym))))
(when src
(save-excursion
(goto-char (point-min))
(when (re-search-forward "^References$")
(goto-char (line-beginning-position))
(let ((inhibit-read-only t))
(insert
(helpful--heading "Demos")
(propertize (elisp-demos--syntax-highlight src)
'start (point)
'symbol helpful--sym
'keymap elisp-demos-help-keymap)
"\n\n")))))))
(save-excursion
(goto-char (point-min))
(when (re-search-forward "^References$")
(goto-char (line-beginning-position))
(let ((inhibit-read-only t))
(insert
(helpful--heading "Demos")
(if (and src (not (string= src "")))
(concat
(propertize (elisp-demos--syntax-highlight src)
'start (point)
'symbol helpful--sym
'keymap elisp-demos-help-keymap)
"\n\n")
"")
(buttonize "[Add]" #'elisp-demos-add-demo helpful--sym)
"\n\n"))))))

;;;###autoload
(defun elisp-demos-for-helpful ()
Expand All @@ -221,32 +239,34 @@
(defun elisp-demos--export-json-file (json-file)
"Export all demos as json to JSON-FILE."
(require 'json)
(with-temp-buffer
(insert-file-contents elisp-demos--elisp-demos.org)
(goto-char (point-min))
(let ((output-buffer (generate-new-buffer " *elisp-demos-json*"))
title body beg end)
(while (re-search-forward "^\\* \\(.+\\)$" nil t)
(setq title (match-string-no-properties 1))
(setq beg (save-excursion
(forward-line 1)
(line-beginning-position)))
(setq end (save-excursion
(if (re-search-forward "^\\* " nil t)
(line-beginning-position)
(point-max))))
(setq body (buffer-substring-no-properties beg end))
(setq title (string-trim title))
(setq body (string-trim body))
(with-current-buffer output-buffer
(insert
(json-encode-string title) ": " (json-encode-string body) ",\n")))
(with-current-buffer output-buffer
(delete-char -2)
(goto-char (point-min)) (insert "{\n")
(goto-char (point-max)) (insert "}\n")
(write-region (point-min) (point-max) json-file))
(kill-buffer output-buffer))))
(let ((output-buffer (generate-new-buffer " *elisp-demos-json*"))
title body beg end)
(dolist (file (append elisp-demos-user-files (list elisp-demos--elisp-demos.org)))
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(delay-mode-hooks (org-mode))
(while (re-search-forward "^\\* +\\(.+\\)$" nil t)
(setq title (org-entry-get (point) "ITEM"))
(setq beg (save-excursion
(forward-line 1)
(line-beginning-position)))
(setq end (save-excursion
(if (re-search-forward "^\\* " nil t)
(line-beginning-position)
(point-max))))
(setq body (buffer-substring-no-properties beg end))
(setq title (string-trim title))
(setq body (string-trim body))
(with-current-buffer output-buffer
(insert
(json-encode-string title) ": " (json-encode-string body) ",\n")))))
(with-current-buffer output-buffer
(delete-char -2)
(goto-char (point-min)) (insert "{\n")
(goto-char (point-max)) (insert "}\n")
(write-region (point-min) (point-max) json-file))
(kill-buffer output-buffer)))

(provide 'elisp-demos)
;;; elisp-demos.el ends here

0 comments on commit ecc8412

Please sign in to comment.