From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Emanuel Berg Newsgroups: gmane.emacs.devel Subject: Re: fun-names.el --- avoid function duplication Date: Tue, 30 Jul 2024 05:55:05 +0200 Message-ID: <87bk2fcz52.fsf@dataswamp.org> References: <8734nvgv5o.fsf@dataswamp.org> Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="35101"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) To: emacs-devel@gnu.org Cancel-Lock: sha1:A6GiUd0uOGIchmY2/zqsA88Wh14= Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Tue Jul 30 13:00:48 2024 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 1sYkb2-0008wX-Ih for ged-emacs-devel@m.gmane-mx.org; Tue, 30 Jul 2024 13:00:48 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1sYkak-0005ZJ-Ev; Tue, 30 Jul 2024 07:00:30 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1sYe1y-0008T4-BZ for emacs-devel@gnu.org; Tue, 30 Jul 2024 00:00:10 -0400 Original-Received: from ciao.gmane.io ([116.202.254.214]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1sYe1v-0007fg-MH for emacs-devel@gnu.org; Tue, 30 Jul 2024 00:00:10 -0400 Original-Received: from list by ciao.gmane.io with local (Exim 4.92) (envelope-from ) id 1sYe1q-0003Ep-UZ for emacs-devel@gnu.org; Tue, 30 Jul 2024 06:00:03 +0200 X-Injected-Via-Gmane: http://gmane.org/ Mail-Followup-To: emacs-devel@gnu.org Mail-Copies-To: never Received-SPF: pass client-ip=116.202.254.214; envelope-from=ged-emacs-devel@m.gmane-mx.org; helo=ciao.gmane.io X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, HEADER_FROM_DIFFERENT_DOMAINS=0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Mailman-Approved-At: Tue, 30 Jul 2024 07:00:26 -0400 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 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-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.devel:322208 Archived-At: Richard Stallman wrote: > It is an interestng feature, but the name led me to think it > was just for amusement ;-{. > > I suggest considering variables as well as functions, and > renaming the command to "related-names" or something > like that. Variables are planned for ... here is the most recent version: ;;; fun-names.el --- duplicate hunter -*- lexical-binding: t -*- ;; ;; Author: Emanuel Berg ;; Created: 2024-07-27 ;; Git: git clone https://dataswamp.org/~incal/fun-names.git ;; Keywords: matching ;; License: GPL3+ ;; URL: https://dataswamp.org/~incal/elpa/fun-names.el ;; Version: 6.0.3 ;; ;;; Commentary: ;; ;; __________________________________________________________ ;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`- ;; ;; fun-names.el -- duplicate hunter incal 2024 ;; ;; __________________________________________________________ ;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`- ;; ;; Use `fun-names' with a function symbol, a function name or ;; just an arbitrary sequence of words. It will then show you ;; a table of other functions that are currently defined that ;; have the same words in their names. The table have data to ;; quantify to what degree the names are similar. ;; ;; Here is how the table will look for all varieties of "gnus ;; group mark buffer", #'gnus-group-mark-buffer, and so on: ;; ;; 1. gnus-group-mark-group 0.88 3 +9 ;; 2. gnus-group-mark-regexp 0.75 3 +9 ;; 3. gnus-group-mark-region 0.75 3 +9 ;; 4. gnus-group-mark-update 0.75 3 +9 ;; 5. gnus-group-setup-buffer 0.75 3 +8 ;; 6. gnus-uu-mark-buffer 0.75 3 +7 ;; 7. gnus-group-remove-mark 0.75 2 +7 ;; 8. gnus-group-set-mark 0.75 2 +7 ;; 9. gnus-group-mark-line-p 0.67 3 +9 ;; 10. gnus-group-mark-article-read 0.67 3 +9 ;; ;; One use case can be for you to find such functions and put ;; them to use instead of writing new ones that are the same, ;; often. ;; ;; Also available is `fun-names-short' - it is faster, output ;; is shown in the echo area, there is no report compiled nor ;; is there a change of buffer (less disruptive). In practice ;; `fun-names-short' is often enough. ;; ;; ---------------------------------------------------------- ;; ;; Basic interactive use: ;; ;; M-x fun-names RET split string buffer RET ;; M-x fun-names-short RET kill-current-buffer RET ;; ;; Special interactive use: ;; ;; M-x fun-names RET RET ; input `symbol-at-point' ;; C-u M-x fun-names RET RET ; change default settings ;; ;; ---------------------------------------------------------- ;; ;; Let's compare `fun-names-short' to `apropos-function' used ;; with the same indata. First `apropos-function' then: ;; ;; M-x apropos-function RET use-package-ensure-elpa RET ;; "No apropos matches for use-package-ensure-elpa" ;; ;; And now we do `fun-names-short': ;; ;; M-x fun-names-short RET use-package-ensure-elpa RET ;; "use-package-normalize/:ensure 0.75 2 +7" ;; ;; ---------------------------------------------------------- ;; ;; We can also compare the above result table with the result ;; from `apropos-function'. The search string for `fun-names' ;; was then "gnus group mark buffer", and for that the number ;; one hit was `gnus-group-mark-group', a 88% match. ;; ;; We do the same with `apropos-function' ;; ;; M-x apropos-function RET gnus group mark buffer RET ;; ;; and we get 704 results. Sorted in ABC order from the first ;; Buffer-menu--unmark to the final w3m-bookmark-save-buffer. ;; ;; ---------------------------------------------------------- ;; ;;; Code: (require 'cl-lib) (require 'pcase) (require 'subr-x) (require 'thingatpt) (let ((fun-last #'fun-names-short) (limit-def 0.5) (report-def 10)) (defun funa--interface () (when current-prefix-arg (setq limit-def (read-number "limit: " limit-def)) (setq report-def (read-number "lines: " report-def))) (let* ((def (or (symbol-at-point) fun-last)) (ps (format "fun words%s: " (if def (format " [%s]" def) ""))) (fun (read-string ps nil nil def))) (when fun (setq fun-last fun)) (list fun limit-def report-def))) (defun fun-names (fun &optional limit report) "Examine if the words in FUN appear in any function names. If the proximity is higher than LIMIT (which defaults to 0.5), then function function is included in the computation. If REPORT is 0 - no report, only return data 8 - make a report, 8 lines long nil - make a report, default size t - make a report, the full one To set default options do: \\[universal-argument] \\[execute-extended-command] fun-names RET Also try: `fun-names-short' Proximity is based on the same words appearing in the same order." (interactive (funa--interface)) (when (symbolp fun) (setq fun (symbol-name fun))) (unless limit (setq limit limit-def)) (unless report (setq report report-def)) (let ((similar) (estr) (ratio) (bonus)) (mapatoms (lambda (e) (when (functionp e) (setq estr (symbol-name e)) (setq ratio (funa--words-same fun estr)) (when (and (<= limit ratio) (< ratio 1)) (setq bonus (funa--words-same-pos fun estr)) (push `(,e ,ratio ,@bonus) similar))))) (let* ((sorted (cl-sort similar #'funa--words>))) (if (and (numberp report) (zerop report)) sorted (funa--report sorted fun report))))) (declare-function funa--interface nil) (declare-function fun-names nil)) (defun fun-names-short (fun &optional _limit _report) "Echo what function has a name the closest to FUN. See `fun-names'." (interactive (funa--interface)) (let ((rec (car (fun-names fun nil 0)))) (if rec (pcase-let ((`(,n ,r ,b ,p) rec)) (message (funa--data-string 0 n r b p))) (message "unique")))) (defun funa--data-string (i n r b p &optional pad) (unless pad (setq pad 0)) (unless (stringp n) (setq n (symbol-name n)) ) (let ((bp (if (< 0 b) (format " %d %+d" b p) "")) (npad (string-pad n pad))) (if (zerop i) (format "%s %.2f%s" n r bp) (format "%2d. %s %.2f%s\n" i npad r bp)))) (defun funa--report (data strs &optional lines) (when data (when (numberp lines) (setq data (take lines data))) (let ((buf (get-buffer-create "*fun-names*")) (pad (1+ (apply #'max (mapcar (lambda (e) (length (symbol-name (car e)))) data))))) (with-current-buffer buf (erase-buffer) (insert (format "search: %s\n\n" strs)) (cl-loop for i from 1 for (n r b p) in data do (insert (funa--data-string i n r b p pad))) (goto-char (point-min))) (pop-to-buffer buf)))) ;; __________________________________________________________ ;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`- ;; ;; NEW WORD ORDER ;; ;; String proximity by words, a non-strict total order. ;; __________________________________________________________ ;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`- (defun funa--words-from-string (s) (split-string (downcase s) "[^[:alnum:]]+" t)) (defun funa--words (s1 s2) (unless (listp s1) (setq s1 (funa--words-from-string s1))) (unless (listp s2) (setq s2 (funa--words-from-string s2))) `(,(funa--words-same s1 s2) ,@(funa--words-same-pos s1 s2))) (defun funa--words-same (s1 s2) (unless (listp s1) (setq s1 (funa--words-from-string s1))) (unless (listp s2) (setq s2 (funa--words-from-string s2))) (if (and s1 s2) (let* ((num (+ (length s1) (length s2))) (com (- num (length (cl-set-exclusive-or s1 s2 :test #'string=))))) (/ com num 1.0)) 0.0)) (defun funa--words-same-pos (s1 s2) (unless (listp s1) (setq s1 (funa--words-from-string s1))) (unless (listp s2) (setq s2 (funa--words-from-string s2))) (cl-loop with short = (min (length s1) (length s2)) with hits = 0 with pnts = 0 for i downfrom short for a in s1 for b in s2 do (when (string= a b) (cl-incf hits) (cl-incf pnts i)) finally return (list hits pnts))) (defun funa--words< (p1 p2) (pcase-let ((`(,r1 ,b1 ,e1) (last p1 3)) (`(,r2 ,b2 ,e2) (last p2 3))) (or (< r1 r2) (and (= r1 r2) (< b1 b2)) (and (= r1 r2) (= b1 b2) (< e1 e2))))) (defun funa--words<= (p1 p2) (funa--words< p2 p1)) (defun funa--words= (p1 p2) (or (funa--words< p1 p2) (funa--words< p2 p1))) (defun funa--words>= (p1 p2) (funa--words< p2 p1)) (defun funa--words> (p1 p2) (funa--words< p2 p1)) (provide 'fun-names) ;;; fun-names.el ends here -- underground experts united https://dataswamp.org/~incal