From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.devel Subject: Re: new package: sketch-mode Date: Mon, 30 Aug 2021 18:45:38 -0400 Message-ID: References: Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="33177"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) Cc: emacs-devel@gnu.org, larsi@gnus.org To: dalanicolai Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Tue Aug 31 00:46:50 2021 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1mKq3G-0008P8-3Q for ged-emacs-devel@m.gmane-mx.org; Tue, 31 Aug 2021 00:46:50 +0200 Original-Received: from localhost ([::1]:59190 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mKq3D-0003kC-UJ for ged-emacs-devel@m.gmane-mx.org; Mon, 30 Aug 2021 18:46:47 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:40386) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mKq2F-00030N-Is for emacs-devel@gnu.org; Mon, 30 Aug 2021 18:45:47 -0400 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:12585) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mKq2C-0003Bg-7E for emacs-devel@gnu.org; Mon, 30 Aug 2021 18:45:46 -0400 Original-Received: from pmg2.iro.umontreal.ca (localhost.localdomain [127.0.0.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id C0F0780695; Mon, 30 Aug 2021 18:45:41 -0400 (EDT) Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id 7FA9B80272; Mon, 30 Aug 2021 18:45:39 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1630363539; bh=rqO4b3xpJ4YuTgV9w6JLHjx1FdLHqrb3+wzyrfaLFwA=; h=From:To:Cc:Subject:References:Date:In-Reply-To:From; b=m39g30qQzQ/Z1i3iiTPDXuj2XjLTloPHItEPDVV59YTwRgLAz78ujqskkdqkS72vm /R8YHZm9UaPIRtoWwOahQxQg0YnCmdoiqk+Cl2RpTTP8buAyQcthA+UMItTOroirqu 4XlIpIOOKbaYCvILMN1Zw1ii06l03xMwEJOfVxcAWlp920zmLpiNStSuBI+EIXHi9O QfY7YNCmjd0pZxCFlYBP/5Q1TWtlmTqWNVtJR+l45TuRqaUZYfyEftTO4ystrD5g0B Li8lN9VH4NIBqhCUWTRWcSj2O1YRcsMxwSJpFbXa0B4S2mJfBYcsD9CmPAXe3e/DfT BIvymeByy/3pQ== Original-Received: from alfajor (unknown [104.247.244.135]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id 3BFA8120177; Mon, 30 Aug 2021 18:45:39 -0400 (EDT) In-Reply-To: (dalanicolai@gmail.com's message of "Fri, 27 Aug 2021 12:06:09 +0200") Received-SPF: pass client-ip=132.204.25.50; envelope-from=monnier@iro.umontreal.ca; helo=mailscanner.iro.umontreal.ca X-Spam_score_int: -42 X-Spam_score: -4.3 X-Spam_bar: ---- X-Spam_report: (-4.3 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, RCVD_IN_DNSWL_MED=-2.3, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:273559 Archived-At: > Cool! Thanks. Yeah, for sure I am happy with that. So I will fill in the > paperform request. Let me know when it's done. > It might still take some work/time to prepare the package for ELPA though. In the mean time, here's a patch which addresses some of the warnings emitted by the byte-compiler. I strongly recommend to byte-compile your code on a regular basis and pay attention to the warnings. Stefan diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000000..aa3ed33912 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*.elc +/sketch-mode-autoloads.el +/sketch-mode-pkg.el diff --git a/sketch-mode.el b/sketch-mode.el index bedd344eaa..d59672f63f 100644 --- a/sketch-mode.el +++ b/sketch-mode.el @@ -1,10 +1,10 @@ ;;; sketch-mode.el --- Quickly create svg sketches using keyboard and mouse -*- lexical-binding: t; -*- -;; Copyright (C) 2021 Daniel Nicolai - +;; Copyright (C) 2021 Free Software Foundation, Inc. ;; Author: D.L. Nicolai ;; Created: 17 Jul 2021 +;; Version: 0 ;; Keywords: multimedia ;; URL: https://github.com/dalanicolai/sketch-mode @@ -79,7 +79,7 @@ "Default size for sketch canvas. Cons cell with car and cdr both integers, respectively representing the image width and image height -(default: '(800 . 600))." +default: (800 . 600)." :type '(cons integer integer)) (defcustom sketch-show-grid t @@ -134,7 +134,7 @@ STOPS is a list of percentage/color pairs." (svg--def svg (apply - 'dom-node + #'dom-node 'marker `((id . ,id) (viewBox . "0 0 10 10") @@ -174,8 +174,8 @@ transient." (expt (- (cdr end-coords) (cdr start-coords)) 2)))) (defun sketch--rectangle-coords (start-coords end-coords) - (let ((base-coords (cons (apply 'min (list (car start-coords) (car end-coords))) - (apply 'min (list (cdr start-coords) (cdr end-coords)))))) + (let ((base-coords (cons (apply #'min (list (car start-coords) (car end-coords))) + (apply #'min (list (cdr start-coords) (cdr end-coords)))))) (list (car base-coords) (cdr base-coords) (abs (- (car end-coords) (car start-coords))) @@ -187,12 +187,13 @@ transient." (abs (/ (- (car end-coords) (car start-coords)) 2)) (abs (/ (- (cdr end-coords) (cdr start-coords)) 2)))) +(defvar svg) ;FIXME: Use a longer name with `sketch-' prefix for dynbound vars! +(defvar svg-canvas) +(defvar svg-grid) +(defvar svg-sketch) + (defun sketch--create-canvas (width height &optional grid-param) "Create canvas for drawing svg using the mouse." - (defvar svg) - (defvar svg-canvas) - (defvar svg-grid) - (defvar svg-sketch) (insert-image (let ((width width) (height height)) @@ -240,6 +241,8 @@ values" (let ((width (if arg (car sketch-default-image-size) (read-number "Enter width: ") )) (height (if arg 600 (read-number "Enter height: ")))) (switch-to-buffer (get-buffer-create "*sketch*")) + ;; FIXME: `defvar' can't be meaningfully inside a function like that. + ;; FIXME: Use a `sketch-' prefix for all dynbound vars. (defvar-local sketch-elements nil) (defvar-local grid-param 25) (setq grid-param (if arg 25 (read-number "Enter grid parameter (enter 0 for no grid): "))) @@ -304,7 +307,7 @@ values" ((fallback :initarg :fallback :initform nil) (default :initarg :default :initform nil))) -(cl-defmethod transient-infix-read ((obj sketch-variable:colors)) +(cl-defmethod transient-infix-read ((_obj sketch-variable:colors)) (read-color "Select color: ")) (cl-defmethod transient-infix-value ((obj sketch-variable:colors)) @@ -314,19 +317,24 @@ values" (when default (concat (oref obj argument) (substring-no-properties default)))))) +;; We always call the autoloaded `color-name-to-rgb' before calling this +;; function, so we know it's available even tho the compiler doesn't. +(declare-function color-rgb-to-hex "color" + (red green blue &optional digits-per-component)) + (cl-defmethod transient-format-value ((obj sketch-variable:colors)) (let ((value (oref obj value)) (default (oref obj default))) (if value (format "%s (%s)" (propertize value 'face (cons 'foreground-color value)) - (propertize (apply 'color-rgb-to-hex (color-name-to-rgb value)) + (propertize (apply #'color-rgb-to-hex (color-name-to-rgb value)) 'face 'transient-inactive-argument)) (if (string= default "none") (propertize "none" 'face 'transient-inactive-argument) (format "%s (%s)" (propertize default 'face (cons 'foreground-color default)) - (propertize (apply 'color-rgb-to-hex (color-name-to-rgb default)) + (propertize (apply #'color-rgb-to-hex (color-name-to-rgb default)) 'face 'transient-inactive-argument)))))) ;; (let* ((args (when transient-current-prefix (transient-args 'sketch-transient))) @@ -474,7 +482,7 @@ values" (defun sketch-create-label () (interactive) (let* ((alphabet "abcdefghijklmnopqrstuvwxyz") - (labels-list (mapcar 'string (concat alphabet (upcase alphabet)))) + (labels-list (mapcar #'string (concat alphabet (upcase alphabet)))) (labels (sketch-labels-list))) (while (member (car labels-list) labels) (setq labels-list (cdr labels-list))) @@ -489,7 +497,8 @@ values" (dolist (coord args node) (cl-decf (alist-get coord (cadr node)) amount))) -(defun svg-translate (dx dy) +;; FIXME: Use a `sketch-' prefix for all definitions. +(defun sketch--svg-translate (dx dy) (interactive) (mapcar (lambda (node) (pcase (car node) @@ -607,7 +616,7 @@ values" (transient-quit-one) (switch-to-buffer-other-window buffer) (erase-buffer) - (pp svg-sketch (current-buffer))) + (pp sketch (current-buffer))) (emacs-lisp-mode)) (transient-define-suffix sketch-copy-definition () @@ -621,9 +630,10 @@ values" (interactive) (setq svg-sketch (read (buffer-string)))) +(defvar sketch-undo-redo nil) + (transient-define-suffix sketch-undo () (interactive) - (defvar sketch-undo-redo nil) (let ((sketch-reverse (nreverse svg-sketch))) (push (pop sketch-reverse) sketch-undo-redo) (setq svg-sketch (nreverse sketch-reverse))) @@ -660,7 +670,7 @@ values" ;; (if sketch-include-end-marker ;; "url(#arrow)" ;; "none")))) - (apply 'svg-text svg-sketch text :x (car coords) :y (cdr coords) object-props)) + (apply #'svg-text svg-sketch text :x (car coords) :y (cdr coords) object-props)) (sketch-redraw)) (transient-define-infix sketch-select-font () @@ -702,7 +712,7 @@ values" (setq svg-canvas (svg-create new-width new-height :stroke "gray")) (svg-marker svg-canvas "arrow" 8 8 "black" t) (svg-rectangle svg-canvas 0 0 new-width new-height :fill "white") - (setf (cddr svg-sketch) (svg-translate (car start-coords) (cdr start-coords))) + (setf (cddr svg-sketch) (sketch--svg-translate (car start-coords) (cdr start-coords))) (sketch-redraw))) (transient-define-suffix sketch-save () @@ -710,4 +720,4 @@ values" (image-save)) (provide 'sketch-mode) -;;; filename ends here +;;; sketch-mode.el ends here diff --git a/sketch-scratch.el b/sketch-scratch.el index c9f60b21ad..6bf62552a7 100644 --- a/sketch-scratch.el +++ b/sketch-scratch.el @@ -1,3 +1,7 @@ +;;; sketch-scratch.el --- -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + ;; (setq svg-scratch (svg-create 100 100)) ;; (svg-rectangle svg-scratch 25 25 50 50 :id "a") ;; (svg-line svg-scratch 25 25 75 75 :id "b" :stroke-color "black") @@ -10,6 +14,7 @@ (dolist (coord args node) (cl-decf (alist-get coord (cadr node)) amount))) +;; FIXME: Use a `sketch-' prefix for all definitions. (defun svg-translate (dx dy) (interactive) (mapcar (lambda (node)