;; gcc.scm

(define-public (make-libgccjit gcc)
  (package
    (inherit gcc)
    (name "libgccjit")
    (outputs (delete "lib" (package-outputs gcc)))
    (properties (alist-delete 'hidden? (package-properties gcc)))
    (arguments
     (substitute-keyword-arguments (package-arguments gcc)
       ((#:modules _ '())
        '((guix build gnu-build-system)
          (guix build utils)
          (ice-9 regex)
          (srfi srfi-1)
          (srfi srfi-26)))
       ((#:configure-flags flags)
        #~(cons* "--disable-bootstrap"
                 "--disable-libatomic"
                 "--disable-libgomp"
                 "--disable-libquadmath"
                 "--disable-libssp"
                 "--enable-host-shared"
                 "--enable-languages=jit"
                 (remove (cut string-match "--enable-languages.*" <>)
                         #$flags)))
       ((#:phases phases)
        #~(modify-phases #$phases
            (add-after 'install 'remove-broken-or-conflicting-files
              (lambda* (#:key outputs #:allow-other-keys)
                (for-each delete-file
                          (find-files
                           (string-append (assoc-ref outputs "out") "/bin")
                           ".*(c\\+\\+|cpp|g\\+\\+|gcov|gcc|gcc-.*)"))))))))
    (inputs (modify-inputs (package-inputs gcc)
              (delete "libstdc++")))
    (native-inputs (modify-inputs (package-native-inputs gcc)
                     (prepend gcc)))
    (synopsis "GCC library generating machine code on-the-fly at runtime")
    (description
     "This package is part of the GNU Compiler Collection and provides an
embeddable library for generating machine code on-the-fly at runtime.  This
shared library can then be dynamically-linked into bytecode interpreters and
other such programs that want to generate machine code on-the-fly at run-time.
It can also be used for ahead-of-time code generation for building standalone
compilers.  The just-in-time (jit) part of the name is now something of a
misnomer.")))

(define-public libgccjit-9 (make-libgccjit gcc-9))
(define-public libgccjit-10 (make-libgccjit gcc-10))
(define-public libgccjit-11 (make-libgccjit gcc-11))
(define-public libgccjit-12 (make-libgccjit gcc-12))

(define-public libgccjit libgccjit-10)

;; emacs.scm

(define-public emacs
  (package
    (name "emacs")
    (version "28.1.90")
    (source (origin
              (method url-fetch)
              (uri (string-append "mirror://gnu/emacs/emacs-"
                                  version ".tar.xz"))
              (sha256
               (base32
                "1qbmmmhnjhn4lvzsnyk7l5ganbi6wzbm38jc1a7hhyh3k78b7c98"))
              (patches (search-patches "emacs-exec-path.patch"
                                       "emacs-fix-scheme-indent-function.patch"
                                       "emacs-source-date-epoch.patch"))
              (modules '((guix build utils)))
              (snippet
               '(with-directory-excursion "lisp"
                  ;; Delete the bundled byte-compiled elisp files and generated
                  ;; autoloads.
                  (for-each delete-file
                            (append (find-files "." "\\.elc$")
                                    (find-files "." "loaddefs\\.el$")
                                    (find-files "eshell" "^esh-groups\\.el$")))

                  ;; Make sure Tramp looks for binaries in the right places on
                  ;; remote Guix System machines, where 'getconf PATH' returns
                  ;; something bogus.
                  (substitute* "net/tramp.el"
                    ;; Patch the line after "(defcustom tramp-remote-path".
                    (("\\(tramp-default-remote-path")
                     (format #f "(tramp-default-remote-path ~s ~s ~s ~s "
                             "~/.guix-profile/bin" "~/.guix-profile/sbin"
                             "/run/current-system/profile/bin"
                             "/run/current-system/profile/sbin")))

                  ;; Make sure Man looks for C header files in the right
                  ;; places.
                  (substitute* "man.el"
                    (("\"/usr/local/include\"" line)
                     (string-join
                      (list line
                            "\"~/.guix-profile/include\""
                            "\"/var/guix/profiles/system/profile/include\"")
                      " ")))))))
    (build-system glib-or-gtk-build-system)
    (arguments
     (list
      #:tests? #f                      ; no check target
      #:modules `((guix build glib-or-gtk-build-system)
                  (guix build utils)
                  (srfi srfi-1)
                  (ice-9 ftw))
      #:configure-flags #~(list "--with-modules"
                                "--with-cairo"
                                "--with-native-compilation"
                                "--disable-build-details")
      #:make-flags #~(list "NATIVE_FULL_AOT=1")
      #:phases
      #~(modify-phases %standard-phases
          (add-after 'set-paths 'set-libgccjit-path
            (lambda* (#:key inputs #:allow-other-keys)
              (define (first-subdirectory/absolute directory)
                (let ((files (scandir
                              directory
                              (lambda (file)
                                (and (not (member file '("." "..")))
                                     (file-is-directory? (string-append
                                                          directory "/"
                                                          file)))))))
                  (and (not (null? files))
                       (string-append directory "/" (car files)))))

              (let* ((libgccjit-libdir
                      (first-subdirectory/absolute ;; version
                       (first-subdirectory/absolute ;; host type
                        (search-input-directory inputs "lib/gcc")))))
                (setenv "LIBRARY_PATH"
                        (string-append libgccjit-libdir ":"
                                       (getenv "LIBRARY_PATH"))))))
          (add-after 'unpack 'enable-elogind
            (lambda _
              (substitute* "configure.ac"
                (("libsystemd") "libelogind"))
              (when (file-exists? "configure")
                (delete-file "configure"))))
          (add-after 'unpack 'patch-program-file-names
            (lambda* (#:key inputs #:allow-other-keys)
              (substitute* '("src/callproc.c"
                             "lisp/term.el"
                             "lisp/htmlfontify.el"
                             "lisp/textmodes/artist.el"
                             "lisp/progmodes/sh-script.el")
                (("\"/bin/sh\"")
                 (format #f "~s" (search-input-file inputs "/bin/sh"))))
              (substitute* "lisp/doc-view.el"
                (("\"(gs|dvipdf|ps2pdf|pdftotext)\"" all what)
                 (let ((replacement (false-if-exception
                                     (search-input-file
                                      inputs
                                      (string-append "/bin/" what)))))
                   (if replacement
                       (string-append "\"" replacement "\"")
                       all))))
              ;; match ".gvfs-fuse-daemon-real" and ".gvfsd-fuse-real"
              ;; respectively when looking for GVFS processes.
              (substitute* "lisp/net/tramp-gvfs.el"
                (("\\(tramp-compat-process-running-p \"(.*)\"\\)" all process)
                 (format #f "(or ~a (tramp-compat-process-running-p ~s))"
                         all (string-append "." process "-real"))))))
          (add-after 'unpack 'patch-compilation-driver
            (lambda _
              (substitute* "lisp/emacs-lisp/comp.el"
                (("\\(defcustom native-comp-driver-options nil")
                 (format
                  #f "(defcustom native-comp-driver-options '(~s ~s ~s ~s)"
                  (string-append
                   "-B" #$(this-package-input "binutils") "/bin/")
                  (string-append
                   "-B" #$(this-package-input "glibc") "/lib/")
                  (string-append
                   "-B" #$(this-package-input "libgccjit") "/lib/")
                  (string-append
                   "-B" #$(this-package-input "libgccjit") "/lib/gcc/"))))))
          (add-before 'configure 'fix-/bin/pwd
            (lambda _
              ;; Use `pwd', not `/bin/pwd'.
              (substitute* (find-files "." "^Makefile\\.in$")
                (("/bin/pwd")
                 "pwd"))))
          (add-after 'install 'install-site-start
            ;; Use 'guix-emacs' in "site-start.el", which is used autoload the
            ;; Elisp packages found in EMACSLOADPATH.
            (lambda* (#:key inputs outputs #:allow-other-keys)
              (let* ((out      (assoc-ref outputs "out"))
                     (lisp-dir (string-append out "/share/emacs/site-lisp"))
                     (emacs    (string-append out "/bin/emacs")))

                ;; This is duplicated from emacs-utils to prevent coupling.
                (define* (emacs-byte-compile-directory dir)
                  (let ((expr `(progn
                                (setq byte-compile-debug t)
                                (byte-recompile-directory
                                 (file-name-as-directory ,dir) 0 1))))
                    (invoke emacs "--quick" "--batch"
                            (format #f "--eval=~s" expr))))

                (copy-file #$(local-file
                              (search-auxiliary-file "emacs/guix-emacs.el"))
                           (string-append lisp-dir "/guix-emacs.el"))
                (with-output-to-file (string-append lisp-dir "/site-start.el")
                  (lambda ()
                    (display
                     (string-append
                      "(when (require 'guix-emacs nil t)\n"
                      "  (guix-emacs-autoload-packages)\n"
                      "  (advice-add 'package-load-all-descriptors"
                      " :after #'guix-emacs-load-package-descriptors))"))))
                ;; Remove the extraneous subdirs.el file, as it causes Emacs to
                ;; add recursively all the the sub-directories of a profile's
                ;; share/emacs/site-lisp union when added to EMACSLOADPATH,
                ;; which leads to conflicts.
                (delete-file (string-append lisp-dir "/subdirs.el"))
                ;; Byte compile the site-start files.
                (emacs-byte-compile-directory lisp-dir))))
          (add-after 'glib-or-gtk-wrap 'restore-emacs-pdmp
            ;; restore the dump file that Emacs installs somewhere in
            ;; libexec/ to its original state
            (lambda* (#:key outputs target #:allow-other-keys)
              (let* ((libexec (string-append (assoc-ref outputs "out")
                                             "/libexec"))
                     ;; each of these ought to only match a single file,
                     ;; but even if not (find-files) sorts by string<,
                     ;; so the Nth element in one maps to the Nth element of
                     ;; the other
                     (pdmp (find-files libexec "\\.pdmp$"))
                     (pdmp-real (find-files libexec "\\.pdmp-real$")))
                (for-each rename-file pdmp-real pdmp))))
          (add-after 'glib-or-gtk-wrap 'strip-double-wrap
            (lambda* (#:key outputs #:allow-other-keys)
              ;; Directly copy emacs-X.Y to emacs, so that it is not wrapped
              ;; twice.  This also fixes a minor issue, where WMs would not be
              ;; able to track emacs back to emacs.desktop.
              (with-directory-excursion (assoc-ref outputs "out")
                (copy-file
                 (car (find-files "bin" "^emacs-([0-9]+\\.)+[0-9]+$"))
                 "bin/emacs"))))
          (add-after 'strip-double-wrap 'wrap-emacs-paths
            (lambda* (#:key inputs outputs #:allow-other-keys)
              (let* ((out (assoc-ref outputs "out"))
                     (lisp-dirs (find-files (string-append out "/share/emacs")
                                            "^lisp$"
                                            #:directories? #t)))
                (for-each
                 (lambda (prog)
                   (wrap-program prog
                     ;; emacs-next and variants rely on uname being in PATH for
                     ;; Tramp.  Tramp paths can't be hardcoded, because they
                     ;; need to be portable.
                     `("PATH" suffix
                       ,(map dirname
                             (list (search-input-file inputs "/bin/gzip")
                                   ;; for coreutils
                                   (search-input-file inputs "/bin/yes"))))
                     `("EMACSLOADPATH" suffix ,lisp-dirs)))
                 (find-files (string-append out "/bin")
                             ;; Matches versioned and unversioned emacs binaries.
                             ;; We don't patch emacsclient, because it takes its
                             ;; environment variables from emacs.
                             ;; Likewise, we don't need to patch helper binaries
                             ;; like etags, ctags or ebrowse.
                             "^emacs(-[0-9]+(\\.[0-9]+)*)?$"))))))))
    (inputs
     (list gnutls
           ncurses

           ;; For native compilation
           binutils
           glibc
           libgccjit

           ;; Required for "core" functionality, such as dired and compression.
           coreutils
           gzip

           ;; Avoid Emacs's limited movemail substitute that retrieves POP3
           ;; email only via insecure channels.
           ;; This is not needed for (modern) IMAP.
           mailutils

           gpm
           libx11
           gtk+
           cairo
           pango
           harfbuzz
           libxft
           libtiff
           giflib
           lcms
           libjpeg-turbo
           libselinux
           acl
           jansson
           gmp
           ghostscript
           poppler
           elogind

           ;; When looking for libpng `configure' links with `-lpng -lz', so we
           ;; must also provide zlib as an input.
           libpng
           zlib
           (if (target-x86-64?)
               librsvg-bootstrap
               librsvg-2.40)
           libxpm
           libxml2
           libice
           libsm
           alsa-lib
           dbus

           ;; multilingualization support
           libotf
           m17n-lib))
    (native-inputs
     (list autoconf pkg-config texinfo))
    (native-search-paths
     (list (search-path-specification
            (variable "EMACSLOADPATH")
            (files '("share/emacs/site-lisp")))
           (search-path-specification
            (variable "INFOPATH")
            (files '("share/info")))))

    (home-page "https://www.gnu.org/software/emacs/")
    (synopsis "The extensible, customizable, self-documenting text editor")
    (description
     "GNU Emacs is an extensible and highly customizable text editor.  It is
based on an Emacs Lisp interpreter with extensions for text editing.  Emacs
has been extended in essentially all areas of computing, giving rise to a
vast array of packages supporting, e.g., email, IRC and XMPP messaging,
spreadsheets, remote server editing, and much more.  Emacs includes extensive
documentation on all aspects of the system, from basic editing to writing
large Lisp programs.  It has full Unicode support for nearly all human
languages.")
    (license license:gpl3+)))