Re: fun-names.el --- avoid function duplication

[Emanuel Berg <incal@dataswamp.org>]

>> 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 <incal@dataswamp.org>
;; 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