diff --git a/moc.el b/moc.el index 23d684a..a14c67f 100644 --- a/moc.el +++ b/moc.el @@ -1,11 +1,11 @@ -;;; moc.el --- Master of Ceremonies -*- lexical-binding: t; -*- +;;; moc.el --- Master of Ceremonies -*- lexical-binding: t; -*- ;; Copyright (C) 2024 Positron Solutions ;; Author: Positron Solutions ;; Keywords: convenience, outline ;; Version: 0.6.3 -;; Package-Requires: ((emacs "29.4") (hide-mode-line "1.0.3") (transient "0.7.2")) +;; Package-Requires: ((emacs "29.4") (hide-mode-line "1.0.3") (transient "0.7.2")) <- "hide-mode-line" is not a known package? ;; Homepage: http://github.com/positron-solutions/moc ;;; Copying: @@ -58,8 +58,8 @@ When using a transient cursor effect, the duration of cursor visibility is the product of this and `moc-subtle-cursor-interval'. -\\[info] elisp::Cursor Parameters." - :type 'integer) +See the Info node `(elisp) Cursor Parameters'." + :type 'natnum) (defcustom moc-subtle-cursor-interval 0.2 "Length of cursor blink interval in seconds. @@ -69,7 +69,7 @@ Values smaller than 0.013 will be treated as 0.013." (defcustom moc-focus-max-height-factor 0.75 "Focused text maximum height fraction. This is never exceeded." - :type 'float) + :type 'float) ;what are the legal values? (defcustom moc-focus-max-width-factor 0.75 "Focused text maximum width fraction. @@ -92,7 +92,7 @@ When focusing extremely small regions, this value prevents the text from being scaled comically large. If you just want to render single symbols or extremely short expressions, this setting can be used to control excessively large results." - :type 'float) + :type 'float) ;are fixnums really not acceptable? (defcustom moc-focus-default-remaps '(org-block-no-background) "A list of remap presets to apply to focused text. @@ -105,7 +105,7 @@ The defaults will just be turned on to save time in the usual cases." ;; buffers are focus buffers. Either scan, track, or don't bother. Multiple ;; focus buffers are impossible without names. -(defcustom moc-screenshot-dir #'temporary-file-directory +(defcustom moc-screenshot-dir #'temporary-file-directory ;what about `xdg-cache-home'? "Directory path or function that returns a directory path. Directory path is a string." :type '(choice string function)) @@ -115,10 +115,20 @@ Directory path is a string." Options are same as supported by the backend, `x-export-frames' for now, either pdf (default), png, postscript, or svg. Supported types are determined by the compile-time configuration of cairo." - :type '(choice (const :tag "PNG" png) - (const :tag "Scalable Vector Graphics" svg) - (const :tag "PDF" pdf) - (const :tag "Postscript" postscript))) + :type + (eval-when-compile + (let ((choices '())) + (dolist (choice '((png . "PNG") + (svg . "Scalable Vector Graphics") + (pdf . "PDF") + (postscript . "Postscript"))) + (when (condition-case nil + (always (x-export-frames nil (car choice))) + (error nil)) + (push `(const :tag ,(cdr choice) ,(car choice)) + choices))) + ;; FIXME: What if (null choices)? + `(choice ,@choices)))) (defcustom moc-fixed-frame-sizes '((youtube-short . (1080 . 1920)) @@ -136,10 +146,10 @@ Form is one of: NAME is a symbol, WIDTH and HEIGHT are integers, and FULLSCREEN is valid value for the `fullscreen' frame parameter. -\\[info] elisp::Frame Parameters" - :type '(cons symbol - (choice (cons number number) - symbol))) +See the Info node `(elisp) Frame Parameters'." + :type '(repeat (cons symbol ;or `alist' + (choice (cons number number) + symbol)))) (defcustom moc-face-remap-presets '((bold . ((default :weight bold))) @@ -152,7 +162,7 @@ element of PRESET is a cons of FACE SPECS where SPECS is one of the forms understood by `face-remap-add-relative'. \\[info] elisp::Face Remapping" - :type 'alist) + :type 'alist) ;you can further specialise this type with :key-type and :value-type (defcustom moc-frame-text-scale-step 1.05 "The factor of increase or decrease. @@ -260,7 +270,7 @@ KEEP-EXISTING" (or (moc--read-remap remap) (user-error "Remapping not found")) remap))) - (mapc (lambda (r) + (mapc (lambda (r) ;dolist is cheaper (let ((face (car r)) (specs (cdr r))) (push (face-remap-add-relative face specs) @@ -273,7 +283,7 @@ KEEP-EXISTING" (define-minor-mode moc-hide-cursor-mode "Make cursor completely hidden." - :group 'moc + :global nil (cond (moc-hide-cursor-mode (if (minibufferp) @@ -294,20 +304,20 @@ scale and deactivating it resets their original scale. This mode is not aware of other mechanisms of tracking the frame's text scale and conflicting modes will clobber each other." - :group 'moc :global t (cond (moc-frame-text-scale-mode (cl-loop for f in (frame-list) - do (when-let ((step (frame-parameter f 'moc--frame-text-scale))) - (let* ((orig (or (frame-parameter f 'moc--frame-text-scale-orig) - (face-attribute 'default :height f)))) - (set-face-attribute - 'default f :height - (round (* orig (expt moc-frame-text-scale-step step)))))))) + do (when-let* ((step (frame-parameter f 'moc--frame-text-scale)) + (orig (or (frame-parameter f 'moc--frame-text-scale-orig) + (face-attribute 'default :height f)))) + (set-face-attribute + 'default f :height + ;; I infer that `orig' cannot be nil, as you are multiplying it here? + (round (* orig (expt moc-frame-text-scale-step step))))))) (t - (cl-loop + (cl-loop ;this seems like it would also be simpler with a dolist. for f in (frame-list) do (when-let ((orig (frame-parameter f 'moc--frame-text-scale-orig))) (set-face-attribute 'default f :height orig)))))) @@ -315,11 +325,11 @@ scale and conflicting modes will clobber each other." (defun moc--frame-text-scale-cleanup-when-done () "Self-explanatory. If no frames have a non-zero step value, turn off the mode." - (unless (cl-loop - for f in (frame-list) - when (when-let ((step (frame-parameter f 'moc--frame-text-scale))) - (not (= 0 step))) - return f) + (unless (catch 'found ;just a suggestion if you want to get rid of cl-lib + (dolist (frame (frame-list)) + (when-let* ((step (frame-parameter f 'moc--frame-text-scale)) + ((/= 0 step))) + (throw 'found frame)))) (moc-frame-text-scale-mode -1))) (defun moc-frame-text-scale-increase () @@ -392,8 +402,8 @@ PROMPT will be used as a prompt. INITIAL is an initial value. Shocking." (let ((str (read-from-minibuffer prompt - (when initial (number-to-string initial)) nil nil nil))) - (if (string-match-p "^-?[0-9]*$" str) + (and initial (number-to-string initial)) nil nil nil))) + (if (string-match-p "^-?[0-9]+$" str) ;or is the empty string a valid number? (string-to-number str) (user-error "Could not read number: %s" str)))) @@ -428,11 +438,11 @@ blink if appropriate." (internal-show-cursor nil (not (internal-show-cursor-p)))) ;; Suspend counting blinks when the w32 menu-bar menu is displayed, ;; since otherwise menu tooltips will behave erratically. - (or (and (fboundp 'w32--menu-bar-in-use) - (w32--menu-bar-in-use)) - ;; XXX guarding this expression upsets the blink count and I don't know - ;; how it's supposed to work. - (setq moc-subtle-cursor-blinks-done (1+ moc-subtle-cursor-blinks-done))) + (unless (and (fboundp 'w32--menu-bar-in-use) + (w32--menu-bar-in-use)) + ;; XXX guarding this expression upsets the blink count and I don't know + ;; how it's supposed to work. + (setq moc-subtle-cursor-blinks-done (1+ moc-subtle-cursor-blinks-done))) ;; Each blink is two calls to this function. (when (and (> moc-subtle-cursor-blinks 0) (>= moc-subtle-cursor-blinks-done (* 2 moc-subtle-cursor-blinks))) @@ -454,8 +464,8 @@ Returns whether we have any focused non-TTY frame." (while frame-list (let ((frame (pop frame-list))) (when (and (display-graphic-p frame) (frame-focus-state frame)) - (setf any-graphical-focused t) - (setf frame-list nil)))) + (setq any-graphical-focused t) ;you use `setq' everywhere else + (setq frame-list nil)))) any-graphical-focused))) (defun moc-subtle-cursor-check () @@ -489,6 +499,8 @@ found active. (blink-cursor-mode -1)) (when moc-hide-cursor-mode (moc-hide-cursor-mode -1)) + ;; Can you explain why you are advising the function behind the + ;; symbol instead of setting the function? (add-function :after after-focus-change-function #'moc-subtle-cursor-check) (add-hook 'after-delete-frame-functions #'moc-subtle-cursor-check) @@ -522,8 +534,7 @@ found active. (define-minor-mode moc-quiet-mode "Inhibit messages in the echo area. ⚠️ Inhibiting messages is a bit dangerous. If anything fails, because messages -are disabled, there may be no obvious user feedback ☠️" - :group 'moc +are disabled, there may be no obvious user feedback ☠️" ;I think it would be better to avoid emojis, as not everyone has the fonts installed. :global t (cond (moc-quiet-mode @@ -543,7 +554,7 @@ are disabled, there may be no obvious user feedback ☠️" "Clean up hook if not guarding any more frames." (let ((frames (frame-list)) guarded) - (while (and frames (not guarded)) + (while (and frames (not guarded)) ;I'd use `dolist'+`catch' here again (when (frame-parameter (pop frames) 'moc--fixed-frame-notify) (setq guarded t))) (unless guarded @@ -630,7 +641,7 @@ parameter for `fullscreen'." (if (consp size) (unless (and (= (car size) (frame-pixel-width frame)) (= (cdr size) (frame-pixel-height frame))) - (let ((frame-resize-pixelwise t)) + (let ((frame-resize-pixelwise t)) ;what happens in TUI Emacs? (set-frame-parameter nil 'fullscreen nil) (set-frame-size nil (car size) (cdr size) t) (message "set size: %sw %sh" @@ -667,12 +678,10 @@ these behaviors may become more consistent." (new (cond (revert (frame-parameter (selected-frame) 'moc--fixed-frame-revert)) - ((stringp frame-size) - (cdr (assoc-string frame-size moc-fixed-frame-sizes))) - ((symbolp frame-size) - (cdr (assq frame-size moc-fixed-frame-sizes))) + ((or (symbolp frame-size) (stringp frame-size)) + (cdr (assoc frame-size moc-fixed-frame-sizes))) ((consp frame-size) frame-size) - (t (error "Unrecognized size: %s" frame-size)))) + ((error "Unrecognized size: %s" frame-size)))) (current (if-let* ((fullscreen (frame-parameter nil 'fullscreen))) fullscreen (cons (frame-pixel-width) @@ -718,10 +727,10 @@ Used in suffix command." (defun moc--dispatch-cursor-mode () "Return cursor state for use in info class." (if-let* ((cursor (if (consp cursor-type) - (car cursor-type) - (if (eq cursor-type t) - (frame-parameter nil 'cursor-type) - cursor-type)))) + (car cursor-type) + (if (eq cursor-type t) + (frame-parameter nil 'cursor-type) + cursor-type)))) (if moc-subtle-cursor-mode (propertize (format "subtle %-4s" cursor) 'face 'transient-value) @@ -741,7 +750,7 @@ Use in suffix command." (defun moc--dispatch-frame-text-scale () "Return current frame text scale for info class." - (if-let ((step (frame-parameter (selected-frame) 'moc--frame-text-scale))) + (if-let* ((step (frame-parameter (selected-frame) 'moc--frame-text-scale))) (propertize (format "frame scale: %s" step) 'face 'transient-value) (propertize "off" 'face 'shadow))) @@ -749,7 +758,7 @@ Use in suffix command." (defun moc--dispatch-frame-text-scale-p () "Return if current frame has a non-zero text scale." (when-let ((step (frame-parameter (selected-frame) 'moc--frame-text-scale))) - (not (eq 0 step)))) + (not (eq 0 step)))) ;why `eq'? (defun moc--dispatch-text-scale () "Return current text scale for info class." @@ -761,9 +770,9 @@ Use in suffix command." (defun moc--dispatch-quiet-mode () "Return description and quiet mode state for suffix." (format - "quiet %s" + "quiet %-3s" (if moc-quiet-mode - (propertize "on " 'face 'success) + (propertize "on" 'face 'success) (propertize "off" 'face 'shadow)))) ;;;###autoload (autoload 'moc-dispatch "moc" nil t) @@ -828,7 +837,7 @@ This just provides minor conveniences like pre-configured save path with (let* ((timestamp (format-time-string "%F-%T" (current-time))) (filename (format "screenshot-%s.svg" timestamp)) (dir (moc--screenshot-save-dir)) - (path (concat dir filename)) + (path (file-name-concat dir filename)) (data (x-export-frames nil moc-screenshot-type))) (unless (file-exists-p dir) (make-directory dir t)) @@ -906,14 +915,14 @@ into Emacs text flow logic in the first place. checking the final text size before adjusting the horizontal and vertical offset in `moc-focus-replay'." (cond - ((member 'truncate-lines continuation) + ((memq 'truncate-lines continuation) (set-window-margins window (max 0 (- (window-width) (ceiling (* fill-column scale))))) (toggle-truncate-lines 1) (prog1 (window-text-pixel-size window) (set-window-margins window nil))) - ((member 'visual-line-mode continuation) + ((memq 'visual-line-mode continuation) (visual-line-mode 1) (set-window-margins window (max 0 (- (window-width) @@ -939,7 +948,7 @@ another window will likely leave something to be desired." (kill-buffer old)) (let* ((base (current-buffer)) (buffer (get-buffer-create "*MoC Focus*")) - (text (plist-get args :text)) + (text (plist-get args :text)) ;perhaps you'd like `map-let'? (overlay-specs (plist-get args :overlays)) (invisibility-spec (plist-get args :invisibility-spec)) (continuation (plist-get args :continuation)) @@ -1105,10 +1114,8 @@ Preserves total ordering of highlighted spans." (while-let ((h (pop highlights))) ;; If BEG and END include either or both ends of a highlight, we have to ;; modify spans. - (let ((h-beg-interior (and (>= (car h) beg) - (<= (car h) end))) - (h-end-interior (and (>= (cdr h) beg) - (<= (cdr h) end))) + (let ((h-beg-interior (not (< beg (car h) end))) + (h-end-interior (not (< beg (cdr h) end))) (h-beg-before (< (car h) beg)) (h-end-after (> (cdr h) end))) (cond @@ -1228,7 +1235,7 @@ OCCLUDES is a list of conses of BEG END to be occluded." "Raise user error if commands are called in wrong mode." (if-let* ((buffer (get-buffer "*MoC Focus*"))) (set-buffer buffer) - (user-error "No MoC buffer found"))) + (user-error "No MoC buffer found"))) ;this is really the mistake of the user? (defun moc-focus-highlight-clear () "Delete all highlights and occludes." @@ -1272,7 +1279,7 @@ to make occluded regions visible again." (moc--focus-assert-mode) (moc--focus-occlude beg end) ;; unnecessary to deactivate the mark when called any other way - (when (called-interactively-p 't) + (when (called-interactively-p t) (deactivate-mark)) (moc--focus-apply-occludes moc--focus-occludes)) @@ -1286,7 +1293,7 @@ The shadow face will be added to the region between BEG and END." (moc--focus-un-highlight beg end) (moc--focus-un-occlude beg end) ;; unnecessary to deactivate the mark when called any other way - (when (called-interactively-p 't) + (when (called-interactively-p t) (deactivate-mark)) (moc--focus-apply-highlights moc--focus-highlights) (moc--focus-apply-occludes moc--focus-occludes)) @@ -1297,8 +1304,7 @@ This enables independent demonstration of the effect of source overlays." (interactive nil moc-focus-mode) (moc--focus-assert-mode) (if moc--focus-overlays - (progn (mapc #'delete-overlay - moc--focus-overlays) + (progn (mapc #'delete-overlay moc--focus-overlays) (setq moc--focus-overlays nil)) (moc--focus-apply-overlays ;; whenever toggling overlays, a space exists at the 1 position, so we need @@ -1362,7 +1368,7 @@ It is assumed that BUFFER was offset by BEG." (let ((old (current-buffer))) (set-buffer buffer) (goto-char 1) - (insert (make-string padding 32)) ; 32 is space + (insert (make-string padding ?\s)) (set-buffer old))) (defun moc--focus-trim-rect (buffer _rect _offset) @@ -1384,9 +1390,10 @@ extract the rectangle and then trim each line down to it's span." "Move forward through all whitespace. Do not exceed LIMIT. Optional MULTILINE will also move forward through newlines." - (if multiline - (re-search-forward "[^[:space:]\t\n\r]" limit t) - (re-search-forward "[^ \t]" limit t)) + (re-search-forward (if multiline + "[^[:space:]\t\n\r]" + "[^ \t]") + limit t) (goto-char (match-beginning 0))) (defun moc--focus-backward-whitespace (limit &optional multiline) @@ -1396,7 +1403,7 @@ newlines." (while (and (> (point) limit) (not (bobp)) (looking-back (if multiline - "[[:space:]]+" + "[[:space:]\n]+" ;i assume? "[ \t]+") limit t)) (goto-char (match-beginning 0)))) @@ -1503,8 +1510,7 @@ PROPS is a list returned from `overlay-properties'." ;; TODO customization (defun moc--focus-filter-overlay (o) - (unless (eq (overlay-get o 'face) 'region) - o)) + (and (not(eq (overlay-get o 'face) 'region)) o)) (defun moc--focus-extract-overlays (buffer) "Grab and serialize overlays from BUFFER." @@ -1580,14 +1586,14 @@ ARGS contains the following keys: " *MoC Processing*") :warning)) (let* ((buffer (get-buffer-create " *MoC Processing*")) - (rect (when rectangle-mark-mode - (extract-rectangle-bounds (region-beginning) - (region-end)))) + (rect (and rectangle-mark-mode + (extract-rectangle-bounds (region-beginning) + (region-end)))) (beg (region-beginning)) (end (region-end)) before) (when (string= (buffer-name) " *MoC Processing*") - (user-error "Cannot process the processing buffer: %S" + (user-error "Cannot process the processing buffer: %S" ;here the same as above: is this the mistake of a user who is never interested in a backtrace? (buffer-name))) (goto-char beg) (beginning-of-line) @@ -1728,9 +1734,9 @@ Used in suffix." "Modal controls for focus windows." :interactive nil) -(provide 'moc) -;;; moc.el ends here - ;; Local Variables: ;; outline-regexp: ";; \\(*+\\)" ;; End: + +(provide 'moc) +;;; moc.el ends here