branch: elpa/casual
commit 808dcf5e408bd241b2465d07339a2549174476b0
Merge: 76d4d78629 69b40156ad
Author: Charles Choi <[email protected]>
Commit: GitHub <[email protected]>
Merge pull request #151 from
kickingvegas/merge-development-to-main-20250130_125646
Merge development to main 20250130_125646
---
README.org | 20 ++-
docs/agenda.org | 1 +
docs/bookmarks.org | 1 +
docs/calc.org | 1 +
docs/calendar.org | 1 +
docs/dired.org | 1 +
docs/editkit.org | 1 +
docs/ibuffer.org | 1 +
docs/image.org | 88 ++++++++++
docs/images/casual-image-main-screenshot.png | Bin 0 -> 1652027 bytes
docs/images/casual-image-resize-screenshot.png | Bin 0 -> 130749 bytes
docs/info.org | 1 +
docs/isearch.org | 1 +
docs/re-builder.org | 1 +
lisp/Makefile | 31 ++--
lisp/Makefile-image.make | 29 ++++
lisp/casual-image-settings.el | 51 ++++++
lisp/casual-image-utils.el | 219 +++++++++++++++++++++++++
lisp/casual-image.el | 120 ++++++++++++++
lisp/casual.el | 9 +-
tests/casual-image-test-utils.el | 39 +++++
tests/test-casual-image-settings.el | 30 ++++
tests/test-casual-image-utils.el | 81 +++++++++
tests/test-casual-image.el | 129 +++++++++++++++
24 files changed, 835 insertions(+), 21 deletions(-)
diff --git a/README.org b/README.org
index f68d66fa58..a8bd6abb34 100644
--- a/README.org
+++ b/README.org
@@ -38,6 +38,7 @@ Editorially, all design decisions for Casual are ultimately
the opinion of Charl
- [[#dired-elisp-library-casual-dired][Dired (Elisp library:
~casual-dired~)]]
- [[#editkit-elisp-library-casual-editkit][EditKit (Elisp library:
~casual-editkit~)]]
- [[#ibuffer-elisp-library-casual-ibuffer][IBuffer (Elisp library:
~casual-ibuffer~)]]
+ - [[#image-elisp-library-casual-image][Image (Elisp library:
~casual-image~)]]
- [[#info-elisp-library-casual-info][Info (Elisp library: ~casual-info~)]]
- [[#i-search-elisp-library-casual-isearch][I-Search (Elisp library:
~casual-isearch~)]]
- [[#re-builder-elisp-library-casual-re-builder][Re-Builder (Elisp library:
~casual-re-builder~)]]
@@ -93,20 +94,27 @@ An interface for
[[https://www.gnu.org/software/emacs/manual/html_node/emacs/Cal
[[file:docs/info.org][file:docs/images/casual-ibuffer-screenshot.png]]
+** [[file:docs/image.org][Image]] (Elisp library: ~casual-image~)
+An interface for viewing an image file with
[[https://www.gnu.org/software/emacs/manual/html_node/emacs/Image-Mode.html#Image-Mode][image-mode]].
This interface deviates significantly with naming conventions used by
~image-mode~ to be more in alignment with conventional image editing tools.
+
+[[file:docs/image.org][file:docs/images/casual-image-main-screenshot.png]]
+If ImageMagic 6 or 7 is installed, then Casual Image can support resizing the
image via the ImageMagick ~-resize~ function.
+
+
** [[file:docs/info.org][Info]] (Elisp library: ~casual-info~)
- An interface for the Info documentation system.
+An interface for the Info documentation system.
- [[file:docs/info.org][file:docs/images/casual-info-screenshot.png]]
+[[file:docs/info.org][file:docs/images/casual-info-screenshot.png]]
** [[file:docs/isearch.org][I-Search]] (Elisp library: ~casual-isearch~)
- An interface for the many commands supported by I-Search.
+An interface for the many commands supported by I-Search.
- [[file:docs/isearch.org][file:docs/images/casual-isearch-tmenu.png]]
+[[file:docs/isearch.org][file:docs/images/casual-isearch-tmenu.png]]
** [[file:docs/re-builder.org][Re-Builder]] (Elisp library:
~casual-re-builder~)
- An interface for the Emacs regular expression tool.
+An interface for the Emacs regular expression tool.
-
[[file:docs/re-builder.org][file:docs/images/casual-re-builder-screenshot.png]]
+[[file:docs/re-builder.org][file:docs/images/casual-re-builder-screenshot.png]]
Users can choose any or all of the user interfaces made available by Casual at
their pleasure.
diff --git a/docs/agenda.org b/docs/agenda.org
index 60b1abfee5..20bf51f418 100644
--- a/docs/agenda.org
+++ b/docs/agenda.org
@@ -77,6 +77,7 @@ If you enjoy using Casual Agenda, consider making a modest
financial contributio
- [[file:dired.org][Dired]]
- [[file:editkit.org][EditKit (numerous editing commands)]]
- [[file:ibuffer.org][IBuffer]]
+- [[file:image.org][Image]]
- [[file:info.org][Info]]
- [[file:isearch.org][I-Search]]
- [[file:re-builder.org][Re-Builder]]
diff --git a/docs/bookmarks.org b/docs/bookmarks.org
index 91e7f32319..9ca553b920 100644
--- a/docs/bookmarks.org
+++ b/docs/bookmarks.org
@@ -74,6 +74,7 @@ If you enjoy using Casual Bookmarks, consider making a modest
financial contribu
- [[file:dired.org][Dired]]
- [[file:editkit.org][EditKit (numerous editing commands)]]
- [[file:ibuffer.org][IBuffer]]
+- [[file:image.org][Image]]
- [[file:info.org][Info]]
- [[file:isearch.org][I-Search]]
- [[file:re-builder.org][Re-Builder]]
diff --git a/docs/calc.org b/docs/calc.org
index d1d5b5c999..bdd7f701db 100644
--- a/docs/calc.org
+++ b/docs/calc.org
@@ -60,6 +60,7 @@ If you enjoy using Casual Calc, consider making a modest
financial contribution
- [[file:dired.org][Dired]]
- [[file:editkit.org][EditKit (numerous editing commands)]]
- [[file:ibuffer.org][IBuffer]]
+- [[file:image.org][Image]]
- [[file:info.org][Info]]
- [[file:isearch.org][I-Search]]
- [[file:re-builder.org][Re-Builder]]
diff --git a/docs/calendar.org b/docs/calendar.org
index ed585d05da..83b1d83b6f 100644
--- a/docs/calendar.org
+++ b/docs/calendar.org
@@ -89,6 +89,7 @@ If you enjoy using Casual Calendar, consider making a modest
financial contribut
- [[file:dired.org][Dired]]
- [[file:editkit.org][EditKit (numerous editing commands)]]
- [[file:ibuffer.org][IBuffer]]
+- [[file:image.org][Image]]
- [[file:info.org][Info]]
- [[file:isearch.org][I-Search]]
- [[file:re-builder.org][RE-Builder]]
diff --git a/docs/dired.org b/docs/dired.org
index 2f09088cdc..5c6116b668 100644
--- a/docs/dired.org
+++ b/docs/dired.org
@@ -155,6 +155,7 @@ If you enjoy using Casual Dired, consider making a modest
financial contribution
- [[file:calendar.org][Calendar]]
- [[file:editkit.org][EditKit (numerous editing commands)]]
- [[file:ibuffer.org][IBuffer]]
+- [[file:image.org][Image]]
- [[file:info.org][Info]]
- [[file:isearch.org][I-Search]]
- [[file:re-builder.org][Re-Builder]]
diff --git a/docs/editkit.org b/docs/editkit.org
index 675f5fad33..7de190f0dc 100644
--- a/docs/editkit.org
+++ b/docs/editkit.org
@@ -212,6 +212,7 @@ If you enjoy using Casual EditKit, consider making a modest
financial contributi
- [[file:calendar.org][Calendar]]
- [[file:dired.org][Dired]]
- [[file:ibuffer.org][IBuffer]]
+- [[file:image.org][Image]]
- [[file:info.org][Info]]
- [[file:isearch.org][I-Search]]
- [[file:re-builder.org][Re-Builder]]
diff --git a/docs/ibuffer.org b/docs/ibuffer.org
index 25b30ee708..10a881244e 100644
--- a/docs/ibuffer.org
+++ b/docs/ibuffer.org
@@ -165,6 +165,7 @@ If you enjoy using Casual IBuffer, consider making a modest
financial contributi
- [[file:calc.org][Calc]]
- [[file:calendar.org][Calendar]]
- [[file:editkit.org][EditKit (numerous editing commands)]]
+- [[file:image.org][Image]]
- [[file:info.org][Info]]
- [[file:isearch.org][I-Search]]
- [[file:re-builder.org][Re-Builder]]
diff --git a/docs/image.org b/docs/image.org
new file mode 100644
index 0000000000..5c2699f6b6
--- /dev/null
+++ b/docs/image.org
@@ -0,0 +1,88 @@
+[[../README.org][❮ Back to Casual]]
+
+* Casual Image
+An interface for viewing an image file with
[[https://www.gnu.org/software/emacs/manual/html_node/emacs/Image-Mode.html#Image-Mode][image-mode]].
Resizing an image is supported if ImageMagick 6 or 7 is installed. This
interface deviates significantly with naming conventions used by ~image-mode~
to be more in alignment with conventional image editing tools.
+[[file:images/casual-image-main-screenshot.png]]
+
+* Install
+If installed via MELPA then add these lines to your Emacs initialization file
with your binding of preference.
+
+#+begin_src elisp :lexical no
+ (require 'casual-image) ; optional if using autoloaded menu
+ (keymap-set image-mode-map "C-o" #'casual-image-tmenu)
+#+end_src
+
+
+* Usage
+
+** Command Naming
+
+Casual Image makes a number of opinionated changes to the naming of commands
provided by ~image-mode~.
+
+The table below shows the mapping between names used by Casual to commands
provided by ~image-mode~.
+
+| Casual Name | Image Mode Name | Notes
|
+|-----------------------+-----------------------------------+--------------------------------------------------------------------------------------------------|
+| Zoom In | ~image-increase-size~ | “Zoom” is more
commonly used.
|
+| Zoom Out | ~image-decrease-size~ | “Zoom” is more
commonly used.
|
+| Original Size | ~image-transform-reset-to-original~ | Using a more
concise name.
|
+| Fit to Window | ~image-transform-fit-to-window~ | Using a more
concise name.
|
+| Rotate Clockwise 90°x | ~image-transform-set-rotation~ | Rotation
command is absolute and only works in increments of 90°.
|
+| % of Original | ~image-transform-set-percent~ | Percent
command is absolute in that it computes from the original image size.
|
+| Crop | ~image-crop~ | Command
modifies image.
|
+| Fill | ~image-cut~ | Command
modifies image. This command is primarily a fill operation, so is renamed
appropriately. |
+| Set Fill Color | ~image-cut-color~ | This variable
supports a fill operation, so is renamed appropriately.
|
+| Save | ~save-buffer~ | Saves modified
image file.
|
+| Save as | ~image-save~ | Command to
save mutated image as another file via a mini-buffer prompt.
|
+| Rename | ~rename-visited-file~ | Renames the
current image file.
|
+| Revert | ~revert-buffer~ | Reverts the
current image file.
|
+| Scroll Up | ~image-previous-line~ | Rename to use
arrow key direction.
|
+| Scroll Down | ~image-next-line~ | Rename to use
arrow key direction.
|
+| Scroll Left | ~image-backward-hscroll~ | Rename to use
arrow key direction.
|
+| Scroll Right | ~image-forward-hscroll~ | Rename to use
arrow key direction.
|
+| Left Edge | ~image-bol~ | Rename to use
better descriptive term.
|
+| Right Edge | ~image-eol~ | Rename to use
better descriptive term.
|
+| Top-left | ~image-bob~ | Rename to use
better descriptive term.
|
+| Bottom-right | ~image-eob~ | Rename to use
better descriptive term.
|
+| Previous Image | ~image-previous-file~ | Visit the
preceding image in the same directory as the current file.
|
+| Next Image | ~image-next-file~ | Visit the next
image in the same directory as the current file.
|
+| Mark Image | ~image-mode-mark-file~ | Mark the
current file in the appropriate Dired buffer(s).
|
+| Unmark Image | ~image-mode-unmark-file~ | Unmark the
current file in the appropriate Dired buffer(s).
|
+| Copy filename | ~image-mode-copy-file-name-as-kill~ | Push the
currently visited file name onto the kill ring.
|
+
+
+** Resize
+
+If ImageMagick (version 6 or 7) is installed, Casual Image can resize an image
using it. The Transient ~casual-image-resize-tmenu~ is a streamlined interface
to the ImageMagick ~-resize~ function.
+
+Note that if the image file has been modified, the resize interface will be
disabled. Save the image file before resizing.
+
+[[file:images/casual-image-resize-screenshot.png]]
+
+*** Options
+- (g) Geometry - ImageMagick specifier for the resize geometry.
+- (o) Output to another file - If enabled, then the user will be prompted for
a different output file, else it will /irreversibly/ update the current image
file.
+- (t) Type - Specify if /adaptive/ or /interpolative/ resizing should be used.
If nothing is specified then /standard/ resizing is used.
+
+** Unicode Symbol Support
+
+By enabling “Use Unicode Symbols” from the Settings menu, Casual Image will
use Unicode symbols as appropriate in its menus.
+
+* Sponsorship
+If you enjoy using Casual Image, consider making a modest financial
contribution to help support its development and maintenance.
+
+[[https://www.buymeacoffee.com/kickingvegas][file:images/default-yellow.png]]
+
+* See Also
+- [[file:agenda.org][Agenda]]
+- [[file:bookmarks.org][Bookmarks]]
+- [[file:calc.org][Calc]]
+- [[file:calendar.org][Calendar]]
+- [[file:dired.org][Dired]]
+- [[file:editkit.org][EditKit (numerous editing commands)]]
+- [[file:ibuffer.org][IBuffer]]
+- [[file:info.org][Info]]
+- [[file:isearch.org][I-Search]]
+- [[file:re-builder.org][Re-Builder]]
+
+
diff --git a/docs/images/casual-image-main-screenshot.png
b/docs/images/casual-image-main-screenshot.png
new file mode 100644
index 0000000000..d3866e281b
Binary files /dev/null and b/docs/images/casual-image-main-screenshot.png differ
diff --git a/docs/images/casual-image-resize-screenshot.png
b/docs/images/casual-image-resize-screenshot.png
new file mode 100644
index 0000000000..b79ecd7144
Binary files /dev/null and b/docs/images/casual-image-resize-screenshot.png
differ
diff --git a/docs/info.org b/docs/info.org
index 6c3032c7d1..9fb5848745 100644
--- a/docs/info.org
+++ b/docs/info.org
@@ -59,5 +59,6 @@ If you enjoy using Casual Info, consider making a modest
financial contribution
- [[file:dired.org][Dired]]
- [[file:editkit.org][EditKit (numerous editing commands)]]
- [[file:ibuffer.org][IBuffer]]
+- [[file:image.org][Image]]
- [[file:isearch.org][I-Search]]
- [[file:re-builder.org][Re-Builder]]
diff --git a/docs/isearch.org b/docs/isearch.org
index 2294ddfd8a..7eca14192f 100644
--- a/docs/isearch.org
+++ b/docs/isearch.org
@@ -68,5 +68,6 @@ If you enjoy using Casual I-Search, consider making a modest
financial contribut
- [[file:dired.org][Dired]]
- [[file:editkit.org][EditKit (numerous editing commands)]]
- [[file:ibuffer.org][IBuffer]]
+- [[file:image.org][Image]]
- [[file:info.org][Info]]
- [[file:re-builder.org][Re-Builder]]
diff --git a/docs/re-builder.org b/docs/re-builder.org
index d94762a001..441b618a3b 100644
--- a/docs/re-builder.org
+++ b/docs/re-builder.org
@@ -66,5 +66,6 @@ If you enjoy using Casual RE-Builder, consider making a
modest financial contrib
- [[file:dired.org][Dired]]
- [[file:editkit.org][EditKit (numerous editing commands)]]
- [[file:ibuffer.org][IBuffer]]
+- [[file:image.org][Image]]
- [[file:info.org][Info]]
- [[file:isearch.org][I-Search]]
diff --git a/lisp/Makefile b/lisp/Makefile
index c4c8b3832e..70436c76be 100644
--- a/lisp/Makefile
+++ b/lisp/Makefile
@@ -15,22 +15,9 @@
# along with this program. If not, see <https://www.gnu.org/licenses/>.
TIMESTAMP := $(shell /bin/date "+%Y%m%d_%H%M%S")
-
-.PHONY: tests \
-lib-tests \
-agenda-tests \
-bookmarks-tests \
-calc-tests \
-calendar-tests \
-dired-tests \
-editkit-tests \
-ibuffer-tests \
-info-tests \
-isearch-tests \
-re-builder-tests
-
SRC_DIR=.
+.PHONY: tests
tests: lib-tests \
agenda-tests \
bookmarks-tests \
@@ -43,35 +30,51 @@ info-tests \
isearch-tests \
re-builder-tests
+
+.PHONY: lib-tests
lib-tests:
$(MAKE) -C $(SRC_DIR) -f Makefile-lib.make tests
+.PHONY: agenda-tests
agenda-tests:
$(MAKE) -C $(SRC_DIR) -f Makefile-agenda.make tests
+.PHONY: bookmarks-tests
bookmarks-tests:
$(MAKE) -C $(SRC_DIR) -f Makefile-bookmarks.make tests
+.PHONY: calc-tests
calc-tests:
$(MAKE) -C $(SRC_DIR) -f Makefile-calc.make tests
+.PHONY: calendar-tests
calendar-tests:
$(MAKE) -C $(SRC_DIR) -f Makefile-calendar.make tests
+.PHONY: dired-tests
dired-tests:
$(MAKE) -C $(SRC_DIR) -f Makefile-dired.make tests
+.PHONY: editkit-tests
editkit-tests:
$(MAKE) -C $(SRC_DIR) -f Makefile-editkit.make tests
+.PHONY: image-tests
+image-tests:
+ $(MAKE) -C $(SRC_DIR) -f Makefile-image.make tests
+
+.PHONY: ibuffer-tests
ibuffer-tests:
$(MAKE) -C $(SRC_DIR) -f Makefile-ibuffer.make tests
+.PHONY: info-tests
info-tests:
$(MAKE) -C $(SRC_DIR) -f Makefile-info.make tests
+.PHONY: isearch-tests
isearch-tests:
$(MAKE) -C $(SRC_DIR) -f Makefile-isearch.make tests
+.PHONY: re-builder-tests
re-builder-tests:
$(MAKE) -C $(SRC_DIR) -f Makefile-re-builder.make tests
diff --git a/lisp/Makefile-image.make b/lisp/Makefile-image.make
new file mode 100644
index 0000000000..7cb0c1f018
--- /dev/null
+++ b/lisp/Makefile-image.make
@@ -0,0 +1,29 @@
+##
+# Copyright (C) 2025 Charles Y. Choi
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+include Makefile--defines.make
+
+PACKAGE_NAME=casual-image
+ELISP_INCLUDES=casual-image-utils.el casual-image-settings.el
+ELISP_PACKAGES=
+ELISP_TEST_INCLUDES=casual-image-test-utils.el
+PACKAGE_PATHS= \
+-L $(EMACS_ELPA_DIR)/compat-current \
+-L $(EMACS_ELPA_DIR)/seq-current \
+-L $(EMACS_ELPA_DIR)/transient-current \
+-L $(CASUAL_LIB_LISP_DIR)
+
+include Makefile--rules.make
diff --git a/lisp/casual-image-settings.el b/lisp/casual-image-settings.el
new file mode 100644
index 0000000000..1dec8f1752
--- /dev/null
+++ b/lisp/casual-image-settings.el
@@ -0,0 +1,51 @@
+;;; casual-image-settings.el --- Casual Image Settings -*- lexical-binding:
t; -*-
+
+;; Copyright (C) 2025 Charles Choi
+
+;; Author: Charles Choi <[email protected]>
+;; Keywords: tools
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'image-mode)
+(require 'cus-edit)
+(require 'casual-lib)
+
+(transient-define-prefix casual-image-settings-tmenu ()
+ ["Casual Image Settings"
+ ["Customize"
+ ("G" "Image Group" casual-image--customize-group)]
+
+ ["Casual"
+ (casual-lib-customize-unicode)
+ (casual-lib-customize-hide-navigation)]]
+
+ [:class transient-row
+ (casual-lib-quit-one)
+ ;; ("a" "About" casual-info-about :transient nil)
+ (casual-lib-quit-all)])
+
+(defun casual-image--customize-group ()
+ "Customize Image group."
+ (interactive)
+ (customize-group "image"))
+
+(provide 'casual-image-settings)
+;;; casual-image-settings.el ends here
diff --git a/lisp/casual-image-utils.el b/lisp/casual-image-utils.el
new file mode 100644
index 0000000000..e31e721a2a
--- /dev/null
+++ b/lisp/casual-image-utils.el
@@ -0,0 +1,219 @@
+;;; casual-image-utils.el --- Casual Image Utils -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2025 Charles Choi
+
+;; Author: Charles Choi <[email protected]>
+;; Keywords: tools
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'image)
+(require 'casual-lib)
+
+(defconst casual-image-unicode-db
+ '((:rotate . '("Rotate ⟳90°𝑥…" "Rotate Clockwise 90°x…"))
+ (:scroll-up . '("↑" "Up"))
+ (:scroll-down . '("↓" "Down"))
+ (:scroll-left . '("←" "Left"))
+ (:scroll-right . '("→" "Right"))
+ (:edge-left . '("⇤" "Left"))
+ (:edge-right . '("⇥" "Right"))
+ (:top-left . '("⇱" "Top-left"))
+ (:bottom-right . '("⇲" "Bottom-right"))
+ (:previous-image . '("↑🌇" "Previous Image"))
+ (:next-image . '("↓🌇" "Next Image"))
+ (:dired . '("🗄️" "Dired"))
+ (:mark-image . '("Mark 🌇" "Mark Image"))
+ (:unmark-image . '("Unmark 🌇" "Unmark Image")))
+ "Unicode symbol DB to use for Image Transient menus.")
+
+(defun casual-image-unicode-get (key)
+ "Lookup Unicode symbol for KEY in DB.
+
+- KEY symbol used to lookup Unicode symbol in DB.
+
+If the value of customizable variable `casual-lib-use-unicode' is
+non-nil, then the Unicode symbol is returned, otherwise a plain
+ASCII-range string."
+ (casual-lib-unicode-db-get key casual-image-unicode-db))
+
+(defun casual-image--resize ()
+ "Resize image to specified geometry.
+
+This function resizes an image to a specified geometry.
+ImageMagick (man page `magick') is used to implement the resizing
+of an image.
+
+This function is intended to only be used as part of a Transient suffix.
+
+Transient infix arguments supported by this function include:
+
+ --geometry=<value> ImageMagick geometry specifier
+ --as If enabled, output to another file
+ --type=<value> Resize type (legal values: nil, adaptive, interpolative)
+
+Refer to the
+URL `https://imagemagick.org/script/command-line-processing.php#geometry'
+for details on ImageMagick geometry specification.
+
+If the argument ‘--as’ is enabled, the user will be prompted to
+specify a file to store the resized output. Otherwise, the
+original file itself will be *irreversibly* modified with the
+resized version. Please take note.
+
+If ‘--type=’ is not defined, then the basic resize feature of
+ImageMagick will be invoked. Two other options are to use
+‘adaptive’ or ‘interpolative’ resizing. Refer to the ImageMagick
+documentation for more details on
+
+References
+• URL `https://imagemagick.org/script/command-line-options.php#resize'
+• URL `https://imagemagick.org/script/command-line-options.php#adaptive-resize'
+• URL
`https://imagemagick.org/script/command-line-options.php#interpolative-resize'"
+ (interactive)
+ (let* ((current-command (transient-args transient-current-command))
+ (geometry (transient-arg-value "--geometry=" current-command))
+ (resize-type (if (transient-arg-value "--type=" current-command)
+ (transient-arg-value "--type=" current-command)
+ "resize"))
+ (as (if (transient-arg-value "--as" current-command) t nil))
+ (target (if as
+ (format
+ "'%s'"
+ (file-truename
+ (read-file-name
+ "Target File: " nil nil nil
+ (casual-image--resized-filename
+ (buffer-file-name) resize-type geometry))))
+ (format "'%s'" (buffer-file-name))))
+ (source (if as
+ (format "'%s'" (buffer-file-name))
+ nil))
+ (cmd-list (list)))
+
+ ;; 6: convert source -resize geometry target
+ ;; 7: magick source -resize geometry target
+ ;; 6: mogrify -resize geometry target
+ ;; 7: magick mogrify -resize geometry target
+
+ (if (executable-find "magick")
+ (push "magick" cmd-list)
+ (if as
+ (push "convert" cmd-list)))
+
+ (if as
+ (push source cmd-list)
+ (push "mogrify" cmd-list))
+
+ (cond
+ ((string= resize-type "adaptive") (push "-adaptive-resize" cmd-list))
+ ((string= resize-type "interpolative") (push "-interpolative-resize"
cmd-list))
+ (t (push "-resize" cmd-list)))
+
+ (push geometry cmd-list)
+ (push target cmd-list)
+
+ (let ((cmd (string-join (reverse cmd-list) " ")))
+ (async-shell-command cmd)
+ (message "%s" cmd))))
+
+
+(defun casual-image--reset-point ()
+ "Reset point to point to image.
+
+Use this command for the condition where an `image-mode' command
+fails to work on an image due to improper point focus. This occurs when
+the message “No recognizable image under point” is raised."
+ (interactive)
+ (goto-char (point-min)))
+
+(defun casual-image--indentify-verbose ()
+ "Identify image verbosely.
+
+Invokes ImageMagick command ‘identify -verbose’ to show details
+of current image."
+ (interactive)
+ (let* ((cmd-list (list)))
+ ;;(push "magick" cmd-list)
+ (push "identify" cmd-list)
+ (push "-verbose" cmd-list)
+ (push (format "'%s'" (buffer-file-name)) cmd-list)
+
+ (let ((cmd (string-join (reverse cmd-list) " ")))
+ (async-shell-command cmd)
+ (message "%s" cmd))))
+
+(defun casual-image--resized-filename (filename resize-type modifier)
+ "Generate target FILENAME with RESIZE-TYPE and MODIFIER."
+ ;; TODO: sanitize geometry specifier
+ (let* ((base (file-name-base filename))
+ (extension (file-name-extension filename))
+ (modifier (string-replace "%" "pct" modifier)))
+ (concat base "_" resize-type "_" modifier "." extension)))
+
+(defun casual-image--customize-image-cut-color ()
+ "Customize variable `image-cut-color'.
+
+This variable is poorly named as it applies to a fill operation."
+ (interactive)
+ (customize-variable 'image-cut-color))
+
+(defun casual-image--identify-label ()
+ "Generate label string with ImageMagick identify information."
+ (let ((cmd-list (list)))
+ (push "identify" cmd-list)
+ (push "-format" cmd-list)
+ ;; %W×%H%X%Y
+ (push "'[%f] %m %w×%h %BB %[bit-depth]-bit %[colorspace]'" cmd-list)
+ (push (format "'%s'" (buffer-file-name)) cmd-list)
+
+ (shell-command-to-string (string-join (reverse cmd-list) " "))))
+
+;; Transients
+(transient-define-prefix casual-image-resize-tmenu ()
+ "Casual Image Resize Menu.
+
+Menu resizing an image."
+ :value '("--geometry=100%" "--as")
+ ["Resize"
+ :description (lambda () (format "Resize: %s"
(casual-image--identify-label)))
+
+ ["Options"
+ ("g" "Geometry" "--geometry="
+ :always-read t
+ :allow-empty nil
+ :summary "ImageMagick geometry specifier."
+ :prompt "Geometry: ")
+ ("o" "Output to another file" "--as"
+ :summary "If enabled, then specify output file.")
+
+ ("t" "Type" "--type="
+ :summary "Select resize type. If not set, uses standard resize."
+ :choices ("adaptive" "interpolative"))]]
+
+ ["Command"
+ ("r" "Resize" casual-image--resize :transient t)]
+
+ [:class transient-row
+ (casual-lib-quit-one)
+ (casual-lib-quit-all)])
+
+(provide 'casual-image-utils)
+;;; casual-image-utils.el ends here
diff --git a/lisp/casual-image.el b/lisp/casual-image.el
new file mode 100644
index 0000000000..15dec07799
--- /dev/null
+++ b/lisp/casual-image.el
@@ -0,0 +1,120 @@
+;;; casual-image.el --- Casual Image -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2025 Charles Choi
+
+;; Author: Charles Choi <[email protected]>
+;; Keywords: tools
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+(require 'dired)
+(require 'casual-image-utils)
+(require 'casual-image-settings)
+
+(transient-define-prefix casual-image-tmenu ()
+ "Casual Image Main Menu."
+ :refresh-suffixes t
+ ["Casual Image"
+ :description (lambda () (format "Casual Image: %s"
(casual-image--identify-label)))
+ ["View"
+ ("+" "Zoom In" image-increase-size :transient t)
+ ("-" "Zoom Out" image-decrease-size :transient t)
+ ("o" "Original Size" image-transform-reset-to-original :transient t)
+ ("=" "Fit to Window" image-transform-fit-to-window :transient t)
+ ("R" "Rotate ⟳90°𝑥…" image-transform-set-rotation
+ :description (lambda () (casual-image-unicode-get :rotate))
+ :transient t)
+ ("%" "% of Original…" image-transform-set-percent :transient t)
+ ("." "Reset Point" casual-image--reset-point :transient t)]
+
+ ["Edit"
+ :pad-keys t
+ :inapt-if (lambda () (if buffer-read-only t nil))
+ ("c" "Crop…" image-crop)
+ ("f" "Fill…" image-cut)
+ ("F" "Set Fill Color…" casual-image--customize-image-cut-color
+ :description (lambda () (format "Fill Color (%s)…" image-cut-color)))
+ ("r" "Resize›" casual-image-resize-tmenu
+ :inapt-if buffer-modified-p)
+ ("s" "Save" save-buffer :transient t
+ :inapt-if-not buffer-modified-p)
+ ("C-s" "Save as…" image-save :transient t)
+ ("M-r" "Rename…" rename-visited-file :transient t)
+ ("g" "Revert…" revert-buffer :transient t)]
+
+ ["Scroll"
+ :pad-keys t
+ ("<up>" "Up" image-previous-line
+ :description (lambda () (casual-image-unicode-get :scroll-up))
+ :transient t)
+ ("<down>" "Down" image-next-line
+ :description (lambda () (casual-image-unicode-get :scroll-down))
+ :transient t)
+ ("<left>" "Left" image-backward-hscroll
+ :description (lambda () (casual-image-unicode-get :scroll-left))
+ :transient t)
+ ("<right>" "Right" image-forward-hscroll
+ :description (lambda () (casual-image-unicode-get :scroll-right))
+ :transient t)]
+
+ ["Edge"
+ ("a" "Left ⇤" image-bol
+ :description (lambda () (casual-image-unicode-get :edge-left))
+ :transient t)
+ ("e" "Right ⇥" image-eol
+ :description (lambda () (casual-image-unicode-get :edge-right))
+ :transient t)
+ ("<" "Top-left ⇱" image-bob
+ :description (lambda () (casual-image-unicode-get :top-left))
+ :transient t)
+ (">" "Bottom-right ⇲" image-eob
+ :description (lambda () (casual-image-unicode-get :bottom-right))
+ :transient t)]]
+
+ [["Traverse"
+ ("p" "Previous Image" image-previous-file
+ :description (lambda () (casual-image-unicode-get :previous-image))
+ :transient t)
+ ("n" "Next Image" image-next-file
+ :description (lambda () (casual-image-unicode-get :next-image))
+ :transient t)
+ ("d" "Dired" dired-jump-other-window
+ :description (lambda () (casual-image-unicode-get :dired)))]
+
+ ["Mark"
+ ("m" "Mark Image" image-mode-mark-file
+ :description (lambda () (casual-image-unicode-get :mark-image))
+ :transient t)
+ ("u" "Unmark Image" image-mode-unmark-file
+ :description (lambda () (casual-image-unicode-get :unmark-image))
+ :transient t)]
+
+ ["Misc"
+ ("w" "Copy filename" image-mode-copy-file-name-as-kill :transient t)]]
+
+ [:class transient-row
+ (casual-lib-quit-one)
+ ("I" "Identify" casual-image--indentify-verbose)
+ ("," "Settings›" casual-image-settings-tmenu)
+ (casual-lib-quit-all)
+ ("q" "Quit View" quit-window)])
+
+
+(provide 'casual-image)
+;;; casual-image.el ends here
diff --git a/lisp/casual.el b/lisp/casual.el
index ee559c0279..867a93b368 100644
--- a/lisp/casual.el
+++ b/lisp/casual.el
@@ -5,7 +5,7 @@
;; Author: Charles Choi <[email protected]>
;; URL: https://github.com/kickingvegas/casual
;; Keywords: tools, wp
-;; Version: 2.2.9
+;; Version: 2.2.10-rc.1
;; Package-Requires: ((emacs "29.1") (transient "0.6.0"))
;; This program is free software; you can redistribute it and/or modify
@@ -59,6 +59,13 @@
;; commands.
;; URL `https://github.com/kickingvegas/casual/blob/main/docs/editkit.org'
+;; - Image (Elisp library: `casual-image')
+;; An interface for viewing an image file with `image-mode'.
+;; Resizing an image is supported if ImageMagick 6 or 7 is installed. This
+;; interface deviates significantly with naming conventions used by
+;; `image-mode' to be more in alignment with conventional image editing
tools.
+;; URL `https://github.com/kickingvegas/casual/blob/main/docs/image.org'
+
;; - Info (Elisp library: `casual-info')
;; An interface for the Info documentation system.
;; URL: `https://github.com/kickingvegas/casual/blob/main/docs/info.org'
diff --git a/tests/casual-image-test-utils.el b/tests/casual-image-test-utils.el
new file mode 100644
index 0000000000..a56b974bad
--- /dev/null
+++ b/tests/casual-image-test-utils.el
@@ -0,0 +1,39 @@
+;;; casual-image-test-utils.el --- Casual Test Utils -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2025 Charles Y. Choi
+
+;; Author: Charles Choi <[email protected]>
+;; Keywords: tools
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+(require 'ert)
+(require 'transient)
+(require 'kmacro)
+
+(defun casualt-image-setup ()
+ "Casual menu test setup function."
+ )
+
+(defun casualt-image-breakdown (&optional clear)
+ "Casual menu test breakdown function, if CLEAR is non-nil then clear state."
+ )
+
+(provide 'casual-image-test-utils)
+;;; casual-image-test-utils.el ends here
diff --git a/tests/test-casual-image-settings.el
b/tests/test-casual-image-settings.el
new file mode 100644
index 0000000000..19960dac57
--- /dev/null
+++ b/tests/test-casual-image-settings.el
@@ -0,0 +1,30 @@
+;;; test-casual-image-settings.el --- Casual Image Settings Tests -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2025 Charles Choi
+
+;; Author: Charles Choi <[email protected]>
+;; Keywords: tools
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+
+
+(provide 'test-casual-image-settings)
+;;; test-casual-image-settings.el ends here
diff --git a/tests/test-casual-image-utils.el b/tests/test-casual-image-utils.el
new file mode 100644
index 0000000000..62dd3c7f71
--- /dev/null
+++ b/tests/test-casual-image-utils.el
@@ -0,0 +1,81 @@
+;;; test-casual-image-utils.el --- Casual Image Utils Tests -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2025 Charles Choi
+
+;; Author: Charles Choi <[email protected]>
+;; Keywords: tools
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'casual-image-test-utils)
+(require 'casual-image-utils)
+
+(ert-deftest test-casual-image-unicode-get ()
+ (let ((casual-lib-use-unicode nil))
+ (should (string-equal (casual-image-unicode-get :rotate) "Rotate Clockwise
90°x…"))
+ (should (string-equal (casual-image-unicode-get :scroll-up) "Up"))
+ (should (string-equal (casual-image-unicode-get :scroll-down) "Down"))
+ (should (string-equal (casual-image-unicode-get :scroll-left) "Left"))
+ (should (string-equal (casual-image-unicode-get :scroll-right) "Right"))
+ (should (string-equal (casual-image-unicode-get :edge-left) "Left"))
+ (should (string-equal (casual-image-unicode-get :edge-right) "Right"))
+ (should (string-equal (casual-image-unicode-get :top-left) "Top-left"))
+ (should (string-equal (casual-image-unicode-get :bottom-right)
"Bottom-right"))
+ (should (string-equal (casual-image-unicode-get :previous-image) "Previous
Image"))
+ (should (string-equal (casual-image-unicode-get :next-image) "Next Image"))
+ (should (string-equal (casual-image-unicode-get :dired) "Dired"))
+ (should (string-equal (casual-image-unicode-get :mark-image) "Mark Image"))
+ (should (string-equal (casual-image-unicode-get :unmark-image) "Unmark
Image")))
+
+
+ (let ((casual-lib-use-unicode t))
+ (should (string-equal (casual-image-unicode-get :rotate) "Rotate ⟳90°𝑥…"))
+ (should (string-equal (casual-image-unicode-get :scroll-up) "↑"))
+ (should (string-equal (casual-image-unicode-get :scroll-down) "↓"))
+ (should (string-equal (casual-image-unicode-get :scroll-left) "←"))
+ (should (string-equal (casual-image-unicode-get :scroll-right) "→"))
+ (should (string-equal (casual-image-unicode-get :edge-left) "⇤"))
+ (should (string-equal (casual-image-unicode-get :edge-right) "⇥"))
+ (should (string-equal (casual-image-unicode-get :top-left) "⇱"))
+ (should (string-equal (casual-image-unicode-get :bottom-right) "⇲"))
+ (should (string-equal (casual-image-unicode-get :previous-image) "↑🌇"))
+ (should (string-equal (casual-image-unicode-get :next-image) "↓🌇"))
+ (should (string-equal (casual-image-unicode-get :dired) "🗄️"))
+ (should (string-equal (casual-image-unicode-get :mark-image) "Mark 🌇"))
+ (should (string-equal (casual-image-unicode-get :unmark-image) "Unmark
🌇"))))
+
+
+(ert-deftest test-casual-image-resize-tmenu ()
+ (let ((tmpfile "casual-image-resize-tmenu.txt"))
+ (casualt-image-setup)
+ (cl-letf (((symbol-function #'casual-image--identify-label) (lambda ()
"some image info"))
+ (casualt-mock #'casual-image--resize))
+
+ (let ((test-vectors
+ '((:binding "r" :command casual-image--resize))))
+
+ (casualt-suffix-testcase-runner test-vectors
+ #'casual-image-resize-tmenu
+ '(lambda () (random 5000)))))
+ (casualt-image-breakdown)))
+
+(provide 'test-casual-image-utils)
+;;; test-casual-image-utils.el ends here
diff --git a/tests/test-casual-image.el b/tests/test-casual-image.el
new file mode 100644
index 0000000000..5614b603c6
--- /dev/null
+++ b/tests/test-casual-image.el
@@ -0,0 +1,129 @@
+;;; test-casual-image.el --- Casual Image Tests -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2025 Charles Choi
+
+;; Author: Charles Choi <[email protected]>
+;; Keywords: tools
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'casual-image-test-utils)
+(require 'casual-lib-test-utils)
+(require 'casual-image)
+
+(ert-deftest test-casual-image-tmenu ()
+ (let ((tmpfile "casual-image-tmenu.txt"))
+ (casualt-image-setup)
+ (cl-letf (((symbol-function #'casual-image--identify-label) (lambda ()
"some image info"))
+ (casualt-mock #'image-increase-size)
+ (casualt-mock #'image-decrease-size)
+ (casualt-mock #'image-transform-reset-to-original)
+ (casualt-mock #'image-transform-fit-to-window)
+ (casualt-mock #'image-transform-set-rotation)
+ (casualt-mock #'image-transform-set-percent)
+ (casualt-mock #'casual-image--reset-point)
+
+ (casualt-mock #'image-crop)
+ (casualt-mock #'image-cut)
+ (casualt-mock #'save-buffer)
+ (casualt-mock #'image-save)
+ (casualt-mock #'rename-visited-file)
+ (casualt-mock #'revert-buffer)
+
+ (casualt-mock #'image-previous-line)
+ (casualt-mock #'image-next-line)
+ (casualt-mock #'image-backward-hscroll)
+ (casualt-mock #'image-forward-hscroll)
+
+ (casualt-mock #'image-bol)
+ (casualt-mock #'image-eol)
+ (casualt-mock #'image-bob)
+ (casualt-mock #'image-eob)
+
+ (casualt-mock #'image-previous-file)
+ (casualt-mock #'image-next-file)
+ (casualt-mock #'dired-jump-other-window)
+
+ (casualt-mock #'image-mode-mark-file)
+ (casualt-mock #'image-mode-unmark-file)
+ (casualt-mock #'image-mode-copy-file-name-as-kill))
+
+ (let ((test-vectors
+ '((:binding "+" :command image-increase-size)
+ (:binding "-" :command image-decrease-size)
+ (:binding "o" :command image-transform-reset-to-original)
+ (:binding "=" :command image-transform-fit-to-window)
+ (:binding "R0" :command image-transform-set-rotation)
+ (:binding "%50" :command image-transform-set-percent)
+ (:binding "." :command casual-image--reset-point)
+
+ (:binding "c" :command image-crop)
+ (:binding "f" :command image-cut)
+ (:binding "F" :command casual-image--customize-image-cut-color)
+ (:binding "r" :command casual-image-resize-tmenu)
+ ;; (:binding "s" :command save-buffer) ; TODO: handle
buffer-modified-p
+ (:binding "C-s" :command image-save)
+ (:binding "M-r" :command rename-visited-file)
+ (:binding "g" :command revert-buffer)
+
+
+ (:binding "<up>" :command image-previous-line)
+ (:binding "<down>" :command image-next-line)
+ (:binding "<left>" :command image-backward-hscroll)
+ (:binding "<right>" :command image-forward-hscroll)
+
+ (:binding "a" :command image-bol)
+ (:binding "e" :command image-eol)
+ (:binding "<" :command image-bob)
+ (:binding ">" :command image-eob)
+
+ (:binding "p" :command image-previous-file)
+ (:binding "n" :command image-next-file)
+ (:binding "d" :command dired-jump-other-window)
+
+ (:binding "m" :command image-mode-mark-file)
+ (:binding "u" :command image-mode-unmark-file)
+
+ (:binding "w" :command image-mode-copy-file-name-as-kill)
+
+ (:binding "I" :command casual-image--indentify-verbose)
+ (:binding "," :command casual-image-settings-tmenu))))
+
+ (casualt-suffix-testcase-runner test-vectors
+ #'casual-image-tmenu
+ '(lambda () (random 5000)))))
+
+ (cl-letf (((symbol-function #'casual-image--identify-label) (lambda ()
"some image info"))
+ ((symbol-function #'buffer-modified-p) (lambda () t))
+ (casualt-mock #'save-buffer))
+
+ (let ((test-vectors
+ '((:binding "s" :command save-buffer))))
+
+ (casualt-suffix-testcase-runner test-vectors
+ #'casual-image-tmenu
+ '(lambda () (random 5000)))))
+ (casualt-image-breakdown)))
+
+
+
+(provide 'test-casual-image)
+;;; test-casual-image.el ends here