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: Thu, 01 Aug 2024 04:12:12 +0200 Message-ID: <87mslxhtz7.fsf@dataswamp.org> References: <8734nvgv5o.fsf@dataswamp.org> <87bk2fcz52.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="30918"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) To: emacs-devel@gnu.org Cancel-Lock: sha1:IMN6gTqGyPwCDvHBxEAhvpCZt2A= Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Thu Aug 01 06:52:03 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 1sZNnG-0007hs-Tq for ged-emacs-devel@m.gmane-mx.org; Thu, 01 Aug 2024 06:52:03 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1sZNme-0003O6-BR; Thu, 01 Aug 2024 00:51:24 -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 1sZLIn-0005LW-4d for emacs-devel@gnu.org; Wed, 31 Jul 2024 22:12:25 -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 1sZLIk-0007OT-Sg for emacs-devel@gnu.org; Wed, 31 Jul 2024 22:12:24 -0400 Original-Received: from list by ciao.gmane.io with local (Exim 4.92) (envelope-from ) id 1sZLIi-0001Wz-2b for emacs-devel@gnu.org; Thu, 01 Aug 2024 04:12:20 +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: Thu, 01 Aug 2024 00:51:21 -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:322242 Archived-At: >> 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 [...] Now variables are included (with `boundp'), also everything in the obarray can be included (with `always'). The new functions are `fun-names-all', `fun-names-all-short', `fun-names-vars', `fun-names-vars-short'. So a lot of fun names there are :) ;;; 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.14 ;; ;;; Commentary: ;; ;; __________________________________________________________ ;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`- ;; ;; fun-names.el -- duplicate hunter ;; ;; __________________________________________________________ ;; `-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`-`- ;; ;; 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. ;; ;; 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, so it can be less disruptive. ;; ;; Also see: `fun-names-all', `fun-names-all-short' ;; `fun-names-vars', `fun-names-vars-short' ;; ;; ---------------------------------------------------------- ;; ;; 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 ;; ;; ---------------------------------------------------------- ;; ;;; 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 pred) "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 PRED is the function to sort the obarray, it is by default `functionp'. 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)) (unless pred (setq pred #'functionp)) (let ((similar) (estr) (ratio) (bonus)) (mapatoms (lambda (e) (when (funcall pred 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 fun-names nil) (declare-function funa--interface nil)) (defun fun-names-all (fun &optional limit report _pred) (interactive (funa--interface)) (fun-names fun limit report #'always)) (defun fun-names-all-short (fun &optional limit report _pred) (interactive (funa--interface)) (fun-names-short fun limit report #'always)) (defun fun-names-vars (fun &optional limit report _pred) (interactive (funa--interface)) (fun-names fun limit report #'boundp)) (defun fun-names-vars-short (fun &optional limit report _pred) (interactive (funa--interface)) (fun-names-short fun limit report #'boundp)) (defun fun-names-short (fun &optional _limit _report pred) "Echo what function has a name the closest to FUN. See `fun-names'." (interactive (funa--interface)) (let ((rec (car (fun-names fun nil 0 pred)))) (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 ;; as 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